diff --git a/compiler/driver.ml b/compiler/driver.ml index 0f8cd771..26f266f7 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -243,7 +243,7 @@ let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool) 0 | Cli.OCaml | Cli.Python -> Cli.debug_print "Compiling program into lambda calculus..."; - let prgm = Lcalc.Compile_with_exceptions.translate_program prgm in + let prgm = Lcalc.Compile_without_exceptions.translate_program prgm in let prgm = if optimize then begin Cli.debug_print "Optimizing lambda calculus..."; diff --git a/compiler/lcalc/compile_without_exceptions.ml b/compiler/lcalc/compile_without_exceptions.ml index 5703ae5c..a7388fe6 100644 --- a/compiler/lcalc/compile_without_exceptions.ml +++ b/compiler/lcalc/compile_without_exceptions.ml @@ -56,9 +56,9 @@ let rec translate_default (ctx : ctx) (exceptions : D.expr Pos.marked list) in exceptions -(* non-existing for the moment. *) and translate_typ (t: D.typ Pos.marked) : D.typ Pos.marked = - let _ = t in assert false + (* Hack: If the type is D.TAny, it means for the compiler to not put any type annotation.*) + Pos.same_pos_as D.TAny t and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindlib.box = @@ -74,7 +74,7 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl let pos = Pos.get_position(Bindlib.unbox e1) in let x = A.Var.make ("e1", pos) in - let tau = failwith "todo" in + let tau = (D.TAny, pos) in let e2 = let+ e1 = Bindlib.box (A.EVar (x, pos)) in @@ -89,7 +89,7 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl let pos = Pos.get_position(Bindlib.unbox e1) in let x = A.Var.make ("e1", pos) in - let tau = failwith "todo" in + let tau = (D.TAny, pos) in let e2 = let+ e1 = Bindlib.box (A.EVar (x, pos)) in @@ -102,7 +102,7 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl let pos = Pos.get_position(Bindlib.unbox e1) in let x = A.Var.make ("e1", pos) in - let tau = failwith "todo" in + let tau = (D.TAny, pos) in let e2 = let+ e1 = Bindlib.box (A.EVar (x, pos)) @@ -125,7 +125,7 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl let x = A.Var.make ("e1", pos) in (* we can say staticly what is the type of tau here. *) - let tau = failwith "todo" in + let tau = (D.TAny, pos) in let e2 = let+ e1 = Bindlib.box (A.EVar (x, pos)) @@ -136,11 +136,24 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl A.make_letopt_in x tau e1 e2 - | D.EAssert _e1 -> + | D.EAssert e1 -> (* don't know the semantic of EAssert. *) (* Bindlib.box_apply (fun e1 -> Pos.same_pos_as (A.EAssert e1) e) (translate_expr ctx e1) *) - failwith "todo" + + + let e1 = translate_expr ctx e1 in + let pos = Pos.get_position (Bindlib.unbox e1) in + let x = A.Var.make ("e1", pos) in + let tau = (D.TAny, pos) in + + let e2 = + let+ e1 = Bindlib.box (A.EVar (x, pos)) in + + same_pos @@ A.EAssert (e1, pos) + in + + A.make_letopt_in x tau e1 e2 | D.ErrorOnEmpty arg -> @@ -148,7 +161,7 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl let x = A.Var.make ("e1", pos) in let arg = translate_expr ctx arg in - let tau = failwith "todo" in + let tau = (D.TAny, pos) in let+ e2 = A.make_abs (Array.of_list [ x ]) @@ -165,7 +178,7 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl let pos = Pos.get_position(Bindlib.unbox e1) in let x = A.Var.make ("e1", pos) in - let tau = failwith "todo" in + let tau = (D.TAny, pos) in let e2 = let+ e1 = Bindlib.box (A.EVar (x, pos)) @@ -193,8 +206,6 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl | D.EDefault (exceptions, just, cons) -> translate_default ctx exceptions just cons (Pos.get_position e) - -(* no change here *) let translate_program (prgm : D.program) : A.program = { scopes = diff --git a/compiler/lcalc/to_ocaml.ml b/compiler/lcalc/to_ocaml.ml index 82c3ee3e..1696246b 100644 --- a/compiler/lcalc/to_ocaml.ml +++ b/compiler/lcalc/to_ocaml.ml @@ -327,7 +327,12 @@ let rec format_expr (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (e : exp format_exception (exc, Pos.get_position e) format_with_parens e2 - | ESome _ | ENone | EMatchopt _ -> failwith "todo" + | ESome e1 -> + Format.fprintf fmt "@[ Some@ %a@ @]" format_with_parens e1 + | ENone -> Format.fprintf fmt "None@" + | EMatchopt (e1, e2, e3) -> + let x = assert false in + Format.fprintf fmt "@[match@ %a@]@ with@\n| None ->@[@ %a@]@\n| Some %a ->@[@ %a@ %a@]" format_expr e1 format_with_parens e2 format_var x format_with_parens e3 format_var x let format_struct_embedding (fmt : Format.formatter) ((struct_name, struct_fields) : D.StructName.t * (D.StructFieldName.t * D.typ Pos.marked) list) diff --git a/default.nix b/default.nix index 2531e987..93396368 100644 --- a/default.nix +++ b/default.nix @@ -34,7 +34,7 @@ buildDunePackage rec { ]; doCheck = true; - patches = [ ./.nix/no-web.patch ]; + # patches = [ ./.nix/no-web.patch ]; meta = with lib; { homepage = "https://catala-lang.org";