diff --git a/src/CPS.ml b/src/CPS.ml index 2d26bf7..3ec1577 100644 --- a/src/CPS.ml +++ b/src/CPS.ml @@ -30,7 +30,7 @@ let rec cps_value (t: S.term) : T.value = match t with | S.Var v -> T.VVar v | S.Lit v -> T.VLit v | S.BinOp (l, op, r) -> T.VBinOp (cps_value l, op, cps_value r) -| S.Let _ | S.Lam _ | S.App _ | S.Print _ -> raise NotValue +| S.Let _ | S.Lam _ | S.App _ | S.Print _ | S.IfZero _ -> raise NotValue let cps_value_as_term (t: S.term) (cont: T.variable): T.term = T.TailCall(T.vvar cont, [cps_value t]) @@ -69,6 +69,9 @@ let rec cps_term_inner (t: S.term) (cont: T.variable) (nameHint: string option) let curCont = freshBlockVar () in letCont curCont var (cps_term_inner next cont None) @@ cps_term_inner value curCont (Some (Atom.hint var)) +| S.IfZero _ -> + (* TODO ifzero *) + assert false let cps_term (t: S.term): T.term = (** Entry point. Transforms a [Lambda] term into a [Tail] term, applying a diff --git a/src/Cook.ml b/src/Cook.ml index 89657ed..055e609 100644 --- a/src/Cook.ml +++ b/src/Cook.ml @@ -49,6 +49,8 @@ let rec cook_term env { S.place; S.value } = T.Let (f, T.Lam (T.Self f, x, t1), t2) | S.Let (S.Recursive, _, { S.place; _ }, _) -> error place "the right-hand side of 'let rec' must be a lambda-abstraction" + | S.IfZero (expr, tIf, tElse) -> + T.IfZero (cook_term env expr, cook_term env tIf, cook_term env tElse) let cook_term t = cook_term Env.empty t diff --git a/src/Defun.ml b/src/Defun.ml index e92b7e3..bb00d15 100644 --- a/src/Defun.ml +++ b/src/Defun.ml @@ -86,6 +86,9 @@ let rec walk_term fs t = T.Branch(thisTag, freeVars, nBody) in let fs = add_func fs arity thisFunc in fs, T.LetBlo (var, T.Con(thisTag, T.vvars freeVars), nNext) + | S.IfZero _ -> + (* TODO ifzero *) + assert false let apply_of_arity name args branches = diff --git a/src/Finish.ml b/src/Finish.ml index 08779b3..ecf4b17 100644 --- a/src/Finish.ml +++ b/src/Finish.ml @@ -228,6 +228,9 @@ let rec finish_term (t : S.term) : C.stmt = init_block x b1 @ [ finish_term t2 ] ) + | S.IfZero _ -> + (* TODO ifzero *) + assert false | S.Swi (v, bs) -> T.Switch ( read_tag v, diff --git a/src/Lambda.ml b/src/Lambda.ml index fdb9ecb..feb33ed 100644 --- a/src/Lambda.ml +++ b/src/Lambda.ml @@ -44,5 +44,6 @@ and term = | BinOp of term * binop * term | Print of term | Let of variable * term * term + | IfZero of term * term * term [@@deriving show { with_path = false }] diff --git a/src/RawLambda.ml b/src/RawLambda.ml index 51f33e1..f95d227 100644 --- a/src/RawLambda.ml +++ b/src/RawLambda.ml @@ -30,6 +30,7 @@ and term_ = | BinOp of term * binop * term | Print of term | Let of recursive * variable * term * term + | IfZero of term * term * term (* Every abstract syntax tree node of type [term] is annotated with a place, that is, a position in the source code. This allows us to produce a good diff --git a/src/Tail.ml b/src/Tail.ml index 44b8b6d..789023e 100644 --- a/src/Tail.ml +++ b/src/Tail.ml @@ -73,6 +73,7 @@ and term = | Print of value * term | LetVal of variable * value * term | LetBlo of variable * block * term + | IfZero of value * term * term [@@deriving show { with_path = false }] @@ -130,3 +131,6 @@ and fv_term (t : term) = union (fv_block b1) (remove x (fv_term t2)) + | IfZero _ -> + (* TODO ifzero *) + assert false diff --git a/src/Top.ml b/src/Top.ml index edbb0fb..dabc5bb 100644 --- a/src/Top.ml +++ b/src/Top.ml @@ -40,6 +40,7 @@ and term = | Print of value * term | LetVal of variable * value * term | LetBlo of variable * block * term + | IfZero of value * term * term | Swi of value * branch list (* A branch [tag xs -> t] is labeled with an integer tag [tag], and is diff --git a/src/prettify/PrettyTail.ml b/src/prettify/PrettyTail.ml index ab6d099..92ebf66 100644 --- a/src/prettify/PrettyTail.ml +++ b/src/prettify/PrettyTail.ml @@ -21,6 +21,9 @@ and fmt_term fmt (t: S.term) = match t with | S.LetBlo (var, block, next) -> Format.fprintf fmt "@[let %a = %a@] in@ %a" fmt_var var fmt_block block fmt_term next +| S.IfZero _ -> + (* TODO ifzero *) + assert false let show term = Format.asprintf "@[%a@]" fmt_term term diff --git a/src/prettify/PrettyTop.ml b/src/prettify/PrettyTop.ml index 3501637..4975e43 100644 --- a/src/prettify/PrettyTop.ml +++ b/src/prettify/PrettyTop.ml @@ -28,6 +28,9 @@ let rec fmt_term fmt (term: S.term) = match term with fmt_var name fmt_block block fmt_term next +| S.IfZero _ -> + (* TODO ifzero *) + assert false | S.Swi (value, branches) -> Format.fprintf fmt "@[switch(%a)" fmt_val value ; List.iter