Improvements with Alain during weekly meeting

compiler/driver.ml

@@ -26,9 +26,9 @@ let extensions = [ (".catala_fr", "fr"); (".catala_en", "en"); (".catala_pl", "p
 (** Entry function for the executable. Returns a negative number in case of error. Usage:
     [driver source_file debug dcalc unstyled wrap_weaved_output backend language max_prec_digits trace optimize scope_to_execute output_file]*)
 let driver (source_file : Pos.input_file) (debug : bool) (unstyled : bool)
-    (wrap_weaved_output : bool) (backend : string) (language : string option)
-    (max_prec_digits : int option) (trace : bool) (optimize : bool) (ex_scope : string option)
-    (output_file : string option) : int =
+    (wrap_weaved_output : bool) (avoid_exceptions : bool) (backend : string)
+    (language : string option) (max_prec_digits : int option) (trace : bool) (optimize : bool)
+    (ex_scope : string option) (output_file : string option) : int =
   try
     Cli.debug_flag := debug;
     Cli.style_flag := not unstyled;
@@ -243,7 +243,10 @@ 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_without_exceptions.translate_program prgm in
+            let prgm =
+              if avoid_exceptions then Lcalc.Compile_without_exceptions.translate_program prgm
+              else Lcalc.Compile_with_exceptions.translate_program prgm
+            in
             let prgm =
               if optimize then begin
                 Cli.debug_print "Optimizing lambda calculus...";

compiler/lcalc/compile_without_exceptions.ml

@@ -27,7 +27,7 @@ let translate_lit (l : D.lit) : A.expr =
   | D.LUnit -> A.ELit A.LUnit
   | D.LDate d -> A.ELit (A.LDate d)
   | D.LDuration d -> A.ELit (A.LDuration d)
-  | D.LEmptyError -> A.ERaise A.EmptyError
+  | D.LEmptyError -> A.ENone
 
 let ( let+ ) x f = Bindlib.box_apply f x
 

compiler/lcalc/to_ocaml.ml

@@ -41,7 +41,7 @@ let format_op_kind (fmt : Format.formatter) (k : Dcalc.Ast.op_kind) =
   Format.fprintf fmt "%s"
     (match k with KInt -> "!" | KRat -> "&" | KMoney -> "$" | KDate -> "@" | KDuration -> "^")
 
-let format_log_entry (fmt : Format.formatter) (entry : Dcalc.Ast.log_entry) : unit =
+let _format_log_entry (fmt : Format.formatter) (entry : Dcalc.Ast.log_entry) : unit =
   Format.fprintf fmt "%s"
     (match entry with
     | VarDef _ -> ":="
@@ -88,9 +88,10 @@ let format_unop (fmt : Format.formatter) (op : Dcalc.Ast.unop Pos.marked) : unit
   match Pos.unmark op with
   | Minus k -> Format.fprintf fmt "~-%a" format_op_kind k
   | Not -> Format.fprintf fmt "%s" "not"
-  | Log (entry, infos) ->
-      Format.fprintf fmt "@[<hov 2>log_entry@ \"%a|%a\"@]" format_log_entry entry format_uid_list
-        infos
+  | Log (_entry, _infos) ->
+      (* Errors.raise_spanned_error "Internal error: a log operator has not been caught by the
+         expression match" (Pos.get_position op) *)
+      Format.fprintf fmt "Fun.id"
   | Length -> Format.fprintf fmt "%s" "array_length"
   | IntToRat -> Format.fprintf fmt "%s" "decimal_of_integer"
   | GetDay -> Format.fprintf fmt "%s" "day_of_month_of_date"
@@ -108,7 +109,6 @@ let avoid_keywords (s : string) : string =
     | "object" | "of" | "open" | "or" | "private" | "rec" | "sig" | "struct" | "then" | "to"
     | "true" | "try" | "type" | "val" | "virtual" | "when" | "while" | "with" ->
         true
-    | "x" -> true (* i need a variable to make the translation *)
     | _ -> false
   then s ^ "_"
   else s
@@ -169,7 +169,9 @@ let rec format_typ (fmt : Format.formatter) (typ : Dcalc.Ast.typ Pos.marked) : u
   | TAny -> Format.fprintf fmt "_"
 
 let format_var (fmt : Format.formatter) (v : Var.t) : unit =
-  let lowercase_name = to_lowercase (to_ascii (Bindlib.name_of v)) in
+  let lowercase_name =
+    to_lowercase (to_ascii (Bindlib.name_of v) ^ "_" ^ string_of_int (Bindlib.uid_of v))
+  in
   let lowercase_name =
     Re.Pcre.substitute ~rex:(Re.Pcre.regexp "\\.") ~subst:(fun _ -> "_dot_") lowercase_name
   in
@@ -329,7 +331,7 @@ let rec format_expr (ctx : Dcalc.Ast.decl_ctx) (fmt : Format.formatter) (e : exp
         (exc, Pos.get_position e)
         format_with_parens e2
   | ESome e1 -> Format.fprintf fmt "@[<hov 2> Some@ %a@ @]" format_with_parens e1
-  | ENone -> Format.fprintf fmt "None@"
+  | ENone -> Format.fprintf fmt "None"
   | EMatchopt (e1, e2, e3) ->
       let x = Ast.Var.make ("x", Pos.no_pos) in
       Format.fprintf fmt

compiler/utils/cli.ml

@@ -52,6 +52,11 @@ let trace_opt =
   Arg.(
     value & flag & info [ "trace"; "t" ] ~doc:"Displays a trace of the interpreter's computation")
 
+let avoid_exceptions =
+  Arg.(
+    value & flag
+    & info [ "avoid_exceptions" ] ~doc:"Compiles the default calculus without exceptions")
+
 let wrap_weaved_output =
   Arg.(
     value & flag
@@ -92,7 +97,7 @@ let output =
 
 let catala_t f =
   Term.(
-    const f $ file $ debug $ unstyled $ wrap_weaved_output $ backend $ language
+    const f $ file $ debug $ unstyled $ wrap_weaved_output $ avoid_exceptions $ backend $ language
     $ max_prec_digits_opt $ trace_opt $ optimize $ ex_scope $ output)
 
 let version = "0.5.0"

compiler/utils/cli.mli

@@ -64,6 +64,7 @@ val catala_t :
   bool ->
   bool ->
   bool ->
+  bool ->
   string ->
   string option ->
   int option ->
@@ -74,7 +75,7 @@ val catala_t :
   'a) ->
   'a Cmdliner.Term.t
 (** Main entry point:
-    [catala_t file debug unstyled wrap_weaved_output backend language max_prec_digits_opt trace_opt optimize
+    [catala_t file debug unstyled wrap_weaved_output avoid_exceptions backend language max_prec_digits_opt trace_opt optimize
     ex_scope output] *)
 
 val version : string