Remove the "with-exceptions" backend from the compiler (#641)

Makefile

@@ -217,7 +217,7 @@ tests: test
 TEST_FLAGS_LIST = ""\
 -O \
 --lcalc \
---lcalc,--avoid-exceptions,-O
+--lcalc,--closure-conversion,-O
 
 # Does not include running dune (to avoid duplication when run among bigger rules)
 testsuite-base: .FORCE

build_system/clerk_driver.ml

@@ -75,8 +75,8 @@ module Cli = struct
              tests. Comma-separated list. A subset may also be applied to the \
              compilation of modules, as needed.\n\
              WARNING: flag shortcuts are not allowed here (i.e. don't use \
-             non-ambiguous prefixes such as $(b,--avoid-ex) for \
+             non-ambiguous prefixes such as $(b,--closure) for \
-             $(b,--avoid-exceptions))\n\
+             $(b,--closure-conversion))\n\
              NOTE: if this is set, all inline tests that are $(i,not) \
              $(b,catala test-scope) are skipped to avoid redundant testing.")
 
@@ -481,17 +481,13 @@ let base_bindings catala_exe catala_flags build_dir include_dirs test_flags =
   let catala_flags_ocaml =
     List.filter
       (function
-        | "--avoid-exceptions" | "-O" | "--optimize" | "--closure-conversion" ->
+        | "-O" | "--optimize" | "--closure-conversion" -> true | _ -> false)
-          true
-        | _ -> false)
       test_flags
   in
   let catala_flags_python =
     List.filter
       (function
-        | "--avoid-exceptions" | "-O" | "--optimize" | "--closure-conversion" ->
+        | "-O" | "--optimize" | "--closure-conversion" -> true | _ -> false)
-          true
-        | _ -> false)
       test_flags
   in
   let ocaml_flags = Lazy.force Poll.ocaml_include_flags in

build_system/clerk_report.ml

@@ -69,16 +69,68 @@ let has_command cmd =
   let check_cmd = Printf.sprintf "type %s >/dev/null 2>&1" cmd in
   Sys.command check_cmd = 0
 
-let longuest_common_prefix_length s1 s2 =
+type 'a diff = Eq of 'a | Subs of 'a * 'a | Del of 'a | Add of 'a
-  let len = min (String.length s1) (String.length s2) in
+
-  let rec aux i =
+let colordiff_str s1 s2 =
-    if i >= len then i
+  let split_re =
-    else
+    Re.(compile (alt [set "=()[]{};-,"; rep1 space; rep1 digit]))
-      let c1 = String.get_utf_8_uchar s1 i in
-      let c2 = String.get_utf_8_uchar s2 i in
-      if c1 = c2 then aux (i + Uchar.utf_decode_length c1) else i
   in
-  aux 0
+  let split s =
+    Re.Seq.split_full split_re s
+    |> Seq.map (function `Text t -> t | `Delim g -> Re.Group.get g 0)
+  in
+  let a1 = Array.of_seq (split s1) in
+  let n1 = Array.length a1 in
+  let a2 = Array.of_seq (split s2) in
+  let n2 = Array.length a2 in
+  let d = Array.make_matrix n1 n2 (0, []) in
+  let get i1 i2 =
+    if i1 < 0 then
+      ( i2 + 1,
+        Array.fold_left (fun acc c -> Add c :: acc) [] (Array.sub a2 0 (i2 + 1))
+      )
+    else if i2 < 0 then
+      ( i1 + 1,
+        Array.fold_left (fun acc c -> Del c :: acc) [] (Array.sub a1 0 (i1 + 1))
+      )
+    else d.(i1).(i2)
+  in
+  for i1 = 0 to n1 - 1 do
+    for i2 = 0 to n2 - 1 do
+      if a1.(i1) = a2.(i2) then
+        let eq, eqops = get (i1 - 1) (i2 - 1) in
+        d.(i1).(i2) <- eq, Eq a1.(i1) :: eqops
+      else
+        let del, delops = get (i1 - 1) i2 in
+        let add, addops = get i1 (i2 - 1) in
+        let subs, subsops = get (i1 - 1) (i2 - 1) in
+        if subs <= del && subs <= add then
+          d.(i1).(i2) <- subs + 1, Subs (a1.(i1), a2.(i2)) :: subsops
+        else if del <= add then d.(i1).(i2) <- del + 1, Del a1.(i1) :: delops
+        else d.(i1).(i2) <- add + 1, Add a2.(i2) :: addops
+    done
+  done;
+  let _, rops = get (n1 - 1) (n2 - 1) in
+  let ops = List.rev rops in
+  let pr_left ppf () =
+    Format.pp_print_list
+      ~pp_sep:(fun _ () -> ())
+      (fun ppf -> function
+        | Eq w -> Format.fprintf ppf "%s" w
+        | Subs (w, _) | Del w -> Format.fprintf ppf "@{<green>%s@}" w
+        | Add _ -> ())
+      ppf ops
+  in
+  let pr_right ppf () =
+    Format.pp_print_list
+      ~pp_sep:(fun _ () -> ())
+      (fun ppf -> function
+        | Eq w -> Format.fprintf ppf "%s" w
+        | Subs (_, w) | Add w -> Format.fprintf ppf "@{<red>%s@}" w
+        | Del _ -> ())
+      ppf ops
+  in
+  pr_left, pr_right
 
 let diff_command =
   let has_gnu_diff () =
@@ -139,10 +191,8 @@ let diff_command =
                        else Format.fprintf ppf "%s@{<blue>│@}@{<red>%s@}" l r
                      | '<' -> Format.fprintf ppf "%s@{<blue>│@}@{<red>-@}" l
                      | '|' ->
-                       let w = longuest_common_prefix_length (" " ^ l) r in
+                       let ppleft, ppright = colordiff_str l r in
-                       Format.fprintf ppf "%s@{<blue>│@}%s@{<red>%s@}" l
+                       Format.fprintf ppf "%a@{<blue>│@}%a" ppleft () ppright ()
-                         (String.sub r 0 w)
-                         (String.sub r w (String.length r - w))
                      | _ -> Format.pp_print_string ppf li))
                  ppf )
       | Some cmd_opt | (None as cmd_opt) ->
@@ -287,7 +337,7 @@ let print_box tcolor ppf title (pcontents : box -> unit) =
             (fun ppf ->
               Format.pp_print_tab ppf ();
               Format.fprintf ppf "%t┃@}@," tcolor)
-            ppf ("%t@<1>%s@}  " ^^ fmt) tcolor "┃");
+            ppf ("%t@<1>%s@}   " ^^ fmt) tcolor "┃");
     }
   in
   pcontents box;

compiler/catala_utils/cli.ml

@@ -334,13 +334,6 @@ module Flags = struct
         ~env:(Cmd.Env.info "CATALA_OPTIMIZE")
         ~doc:"Run compiler optimizations."
 
-  let avoid_exceptions =
-    value
-    & flag
-    & info ["avoid-exceptions"]
-        ~env:(Cmd.Env.info "CATALA_AVOID_EXCEPTIONS")
-        ~doc:"Compiles the default calculus without exceptions."
-
   let keep_special_ops =
     value
     & flag
@@ -381,9 +374,7 @@ module Flags = struct
     value
     & flag
     & info ["closure-conversion"]
-        ~doc:
+        ~doc:"Performs closure conversion on the lambda calculus."
-          "Performs closure conversion on the lambda calculus. Implies \
-           $(b,--avoid-exceptions)."
 
   let disable_counterexamples =
     value

compiler/catala_utils/cli.mli

@@ -55,7 +55,6 @@ module Flags : sig
   val ex_variable : string Term.t
   val output : raw_file option Term.t
   val optimize : bool Term.t
-  val avoid_exceptions : bool Term.t
   val closure_conversion : bool Term.t
   val keep_special_ops : bool Term.t
   val monomorphize_types : bool Term.t

compiler/catala_utils/hash.ml

@@ -36,22 +36,16 @@ module Flags : sig
   type nonrec t = private t
 
   val pass :
-    (t -> 'a) ->
+    (t -> 'a) -> closure_conversion:bool -> monomorphize_types:bool -> 'a
-    avoid_exceptions:bool ->
-    closure_conversion:bool ->
-    monomorphize_types:bool ->
-    'a
 
   val of_t : int -> t
 end = struct
   type nonrec t = t
 
-  let pass k ~avoid_exceptions ~closure_conversion ~monomorphize_types =
+  let pass k ~closure_conversion ~monomorphize_types =
-    let avoid_exceptions = avoid_exceptions || closure_conversion in
     (* Should not affect the call convention or actual interfaces: include,
        optimize, check_invariants, typed *)
-    !(avoid_exceptions : bool)
+    !(closure_conversion : bool)
-    % !(closure_conversion : bool)
     % !(monomorphize_types : bool)
     % (* The following may not affect the call convention, but we want it set in
          an homogeneous way *)

compiler/catala_utils/hash.mli

@@ -58,12 +58,7 @@ val map :
     first argument is expected to be a [Foo.Map.fold] function. The result is
     independent of the ordering of the map. *)
 
-val finalise :
+val finalise : t -> closure_conversion:bool -> monomorphize_types:bool -> full
-  t ->
-  avoid_exceptions:bool ->
-  closure_conversion:bool ->
-  monomorphize_types:bool ->
-  full
 (** Turns a raw interface hash into a full hash, ready for printing *)
 
 val to_string : full -> string

compiler/catala_utils/message.ml

@@ -111,8 +111,7 @@ let print_time_marker =
     let old_time = !time in
     time := new_time;
     let delta = (new_time -. old_time) *. 1000. in
-    if delta > 50. then
+    if delta > 50. then Format.fprintf ppf " @{<bold;black>%.0fms@}" delta
-      Format.fprintf ppf "@{<bold;black>[TIME] %.0fms@}@\n" delta
 
 let pp_marker ?extra_label target ppf =
   let open Ocolor_types in
@@ -129,10 +128,10 @@ let pp_marker ?extra_label target ppf =
     | None -> str
     | Some lbl -> Printf.sprintf "%s %s" str lbl
   in
-  if target = Debug then print_time_marker ppf ();
   Format.pp_open_stag ppf (Ocolor_format.Ocolor_styles_tag tags);
   Format.pp_print_string ppf str;
-  Format.pp_close_stag ppf ()
+  Format.pp_close_stag ppf ();
+  if target = Debug then print_time_marker ppf ()
 
 (**{2 Printers}*)
 

compiler/driver.ml

@@ -227,7 +227,6 @@ module Passes = struct
       ~optimize
       ~check_invariants
       ~(typed : ty mark)
-      ~avoid_exceptions
       ~closure_conversion
       ~monomorphize_types :
       typed Lcalc.Ast.program * Scopelang.Dependency.TVertex.t list =
@@ -235,23 +234,11 @@ module Passes = struct
       dcalc options ~includes ~optimize ~check_invariants ~typed
     in
     debug_pass_name "lcalc";
-    let avoid_exceptions = avoid_exceptions || closure_conversion in
-    (* --closure-conversion implies --avoid-exceptions *)
     let prg =
-      if avoid_exceptions && options.trace then
+      match typed with
-        Message.warning
+      | Untyped _ -> Lcalc.From_dcalc.translate_program prg
-          "It is discouraged to use option @{<yellow>--avoid-exceptions@} if \
+      | Typed _ -> Lcalc.From_dcalc.translate_program prg
-           you@ also@ need@ @{<yellow>--trace@},@ the@ resulting@ trace@ may@ \
+      | Custom _ -> invalid_arg "Driver.Passes.lcalc"
-           be@ unreliable@ at@ the@ moment.";
-      match avoid_exceptions, typed with
-      | true, Untyped _ ->
-        Lcalc.From_dcalc.translate_program_without_exceptions prg
-      | true, Typed _ ->
-        Lcalc.From_dcalc.translate_program_without_exceptions prg
-      | false, Typed _ -> Lcalc.From_dcalc.translate_program_with_exceptions prg
-      | false, Untyped _ ->
-        Lcalc.From_dcalc.translate_program_with_exceptions prg
-      | _, Custom _ -> invalid_arg "Driver.Passes.lcalc"
     in
     let prg =
       if optimize then begin
@@ -295,7 +282,6 @@ module Passes = struct
       ~includes
       ~optimize
       ~check_invariants
-      ~avoid_exceptions
       ~closure_conversion
       ~keep_special_ops
       ~dead_value_assignment
@@ -304,7 +290,7 @@ module Passes = struct
       Scalc.Ast.program * Scopelang.Dependency.TVertex.t list =
     let prg, type_ordering =
       lcalc options ~includes ~optimize ~check_invariants ~typed:Expr.typed
-        ~avoid_exceptions ~closure_conversion ~monomorphize_types
+        ~closure_conversion ~monomorphize_types
     in
     debug_pass_name "scalc";
     ( Scalc.From_lcalc.translate_program
@@ -710,10 +696,7 @@ module Commands = struct
       Passes.dcalc options ~includes ~optimize ~check_invariants ~typed
     in
     Interpreter.load_runtime_modules
-      ~hashf:
+      ~hashf:Hash.(finalise ~closure_conversion:false ~monomorphize_types:false)
-        Hash.(
-          finalise ~avoid_exceptions:false ~closure_conversion:false
-            ~monomorphize_types:false)
       prg;
     print_interpretation_results options Interpreter.interpret_program_dcalc prg
       (get_scopeopt_uid prg.decl_ctx ex_scope_opt)
@@ -725,13 +708,12 @@ module Commands = struct
       output
       optimize
       check_invariants
-      avoid_exceptions
       closure_conversion
       monomorphize_types
       ex_scope_opt =
     let prg, _ =
       Passes.lcalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion ~typed ~monomorphize_types
+        ~closure_conversion ~typed ~monomorphize_types
     in
     let _output_file, with_output = get_output_format options output in
     with_output
@@ -764,14 +746,12 @@ module Commands = struct
         $ Cli.Flags.output
         $ Cli.Flags.optimize
         $ Cli.Flags.check_invariants
-        $ Cli.Flags.avoid_exceptions
         $ Cli.Flags.closure_conversion
         $ Cli.Flags.monomorphize_types
         $ Cli.Flags.ex_scope_opt)
 
   let interpret_lcalc
       typed
-      avoid_exceptions
       closure_conversion
       monomorphize_types
       options
@@ -781,32 +761,27 @@ module Commands = struct
       ex_scope_opt =
     let prg, _ =
       Passes.lcalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion ~monomorphize_types ~typed
+        ~closure_conversion ~monomorphize_types ~typed
     in
     Interpreter.load_runtime_modules
-      ~hashf:
+      ~hashf:(Hash.finalise ~closure_conversion ~monomorphize_types)
-        (Hash.finalise ~avoid_exceptions ~closure_conversion ~monomorphize_types)
       prg;
     print_interpretation_results options Interpreter.interpret_program_lcalc prg
       (get_scopeopt_uid prg.decl_ctx ex_scope_opt)
 
   let interpret_cmd =
-    let f lcalc avoid_exceptions closure_conversion monomorphize_types no_typing
+    let f lcalc closure_conversion monomorphize_types no_typing =
-        =
       if not lcalc then
-        if avoid_exceptions || closure_conversion || monomorphize_types then
+        if closure_conversion || monomorphize_types then
           Message.error
-            "The flags @{<bold>--avoid-exceptions@}, \
+            "The flags @{<bold>--closure-conversion@} and \
-             @{<bold>--closure-conversion@} and @{<bold>--monomorphize-types@} \
+             @{<bold>--monomorphize-types@} only make sense with the \
-             only make sense with the @{<bold>--lcalc@} option"
+             @{<bold>--lcalc@} option"
         else if no_typing then interpret_dcalc Expr.untyped
         else interpret_dcalc Expr.typed
       else if no_typing then
-        interpret_lcalc Expr.untyped avoid_exceptions closure_conversion
+        interpret_lcalc Expr.untyped closure_conversion monomorphize_types
-          monomorphize_types
+      else interpret_lcalc Expr.typed closure_conversion monomorphize_types
-      else
-        interpret_lcalc Expr.typed avoid_exceptions closure_conversion
-          monomorphize_types
     in
     Cmd.v
       (Cmd.info "interpret"
@@ -817,7 +792,6 @@ module Commands = struct
       Term.(
         const f
         $ Cli.Flags.lcalc
-        $ Cli.Flags.avoid_exceptions
         $ Cli.Flags.closure_conversion
         $ Cli.Flags.monomorphize_types
         $ Cli.Flags.no_typing
@@ -833,13 +807,11 @@ module Commands = struct
       output
       optimize
       check_invariants
-      avoid_exceptions
       closure_conversion
       ex_scope_opt =
     let prg, type_ordering =
       Passes.lcalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~typed:Expr.typed ~closure_conversion
+        ~typed:Expr.typed ~closure_conversion ~monomorphize_types:false
-        ~monomorphize_types:false
     in
     let output_file, with_output =
       get_output_format options ~ext:".ml" output
@@ -850,10 +822,7 @@ module Commands = struct
     Message.debug "Writing to %s..."
       (Option.value ~default:"stdout" output_file);
     let exec_scope = Option.map (get_scope_uid prg.decl_ctx) ex_scope_opt in
-    let hashf =
+    let hashf = Hash.finalise ~closure_conversion ~monomorphize_types:false in
-      Hash.finalise ~avoid_exceptions ~closure_conversion
-        ~monomorphize_types:false
-    in
     Lcalc.To_ocaml.format_program fmt prg ?exec_scope ~hashf type_ordering
 
   let ocaml_cmd =
@@ -867,7 +836,6 @@ module Commands = struct
         $ Cli.Flags.output
         $ Cli.Flags.optimize
         $ Cli.Flags.check_invariants
-        $ Cli.Flags.avoid_exceptions
         $ Cli.Flags.closure_conversion
         $ Cli.Flags.ex_scope_opt)
 
@@ -877,7 +845,6 @@ module Commands = struct
       output
       optimize
       check_invariants
-      avoid_exceptions
       closure_conversion
       keep_special_ops
       dead_value_assignment
@@ -886,8 +853,8 @@ module Commands = struct
       ex_scope_opt =
     let prg, _ =
       Passes.scalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion ~keep_special_ops
+        ~closure_conversion ~keep_special_ops ~dead_value_assignment
-        ~dead_value_assignment ~no_struct_literals ~monomorphize_types
+        ~no_struct_literals ~monomorphize_types
     in
     let _output_file, with_output = get_output_format options output in
     with_output
@@ -919,7 +886,6 @@ module Commands = struct
         $ Cli.Flags.output
         $ Cli.Flags.optimize
         $ Cli.Flags.check_invariants
-        $ Cli.Flags.avoid_exceptions
         $ Cli.Flags.closure_conversion
         $ Cli.Flags.keep_special_ops
         $ Cli.Flags.dead_value_assignment
@@ -933,13 +899,11 @@ module Commands = struct
       output
       optimize
       check_invariants
-      avoid_exceptions
       closure_conversion =
     let prg, type_ordering =
       Passes.scalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion ~keep_special_ops:false
+        ~closure_conversion ~keep_special_ops:false ~dead_value_assignment:true
-        ~dead_value_assignment:true ~no_struct_literals:false
+        ~no_struct_literals:false ~monomorphize_types:false
-        ~monomorphize_types:false
     in
 
     let output_file, with_output =
@@ -962,15 +926,13 @@ module Commands = struct
         $ Cli.Flags.output
         $ Cli.Flags.optimize
         $ Cli.Flags.check_invariants
-        $ Cli.Flags.avoid_exceptions
         $ Cli.Flags.closure_conversion)
 
   let r options includes output optimize check_invariants closure_conversion =
     let prg, type_ordering =
       Passes.scalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions:false ~closure_conversion ~keep_special_ops:false
+        ~closure_conversion ~keep_special_ops:false ~dead_value_assignment:false
-        ~dead_value_assignment:false ~no_struct_literals:false
+        ~no_struct_literals:false ~monomorphize_types:false
-        ~monomorphize_types:false
     in
 
     let output_file, with_output = get_output_format options ~ext:".r" output in
@@ -994,7 +956,7 @@ module Commands = struct
   let c options includes output optimize check_invariants =
     let prg, type_ordering =
       Passes.scalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions:true ~closure_conversion:true ~keep_special_ops:true
+        ~closure_conversion:true ~keep_special_ops:true
         ~dead_value_assignment:false ~no_struct_literals:true
         ~monomorphize_types:true
     in

compiler/driver.mli

@@ -51,7 +51,6 @@ module Passes : sig
     optimize:bool ->
     check_invariants:bool ->
     typed:'m Shared_ast.mark ->
-    avoid_exceptions:bool ->
     closure_conversion:bool ->
     monomorphize_types:bool ->
     Shared_ast.typed Lcalc.Ast.program * Scopelang.Dependency.TVertex.t list
@@ -61,7 +60,6 @@ module Passes : sig
     includes:Global.raw_file list ->
     optimize:bool ->
     check_invariants:bool ->
-    avoid_exceptions:bool ->
     closure_conversion:bool ->
     keep_special_ops:bool ->
     dead_value_assignment:bool ->

compiler/lcalc/closure_conversion.ml

@@ -30,6 +30,10 @@ type 'm ctx = {
 let new_var ?(pfx = "") name_context =
   name_context.counter <- name_context.counter + 1;
   Var.make (pfx ^ name_context.prefix ^ string_of_int name_context.counter)
+(* TODO: Closures end up as a toplevel names. However for now we assume toplevel
+   names are unique, this is a temporary workaround to avoid name wrangling in
+   the backends. We need to have a better system for name disambiguation when
+   for instance printing to Dcalc/Lcalc/Scalc but also OCaml, Python, etc. *)
 
 let new_context prefix = { prefix; counter = 0 }
 
@@ -142,8 +146,7 @@ let rec transform_closures_expr :
   let m = Mark.get e in
   match Mark.remove e with
   | EStruct _ | EStructAccess _ | ETuple _ | ETupleAccess _ | EInj _ | EArray _
-  | ELit _ | EAssert _ | EFatalError _ | EIfThenElse _ | ERaiseEmpty
+  | ELit _ | EAssert _ | EFatalError _ | EIfThenElse _ ->
-  | ECatchEmpty _ ->
     Expr.map_gather ~acc:Var.Map.empty ~join:join_vars
       ~f:(transform_closures_expr ctx)
       e
@@ -217,7 +220,7 @@ let rec transform_closures_expr :
               EnumConstructor.Map.add cons
                 (Expr.eabs new_binder tys (Mark.get e1))
                 new_cases )
-          | _ -> failwith "should not happen")
+          | _ -> assert false)
         cases
         (free_vars, EnumConstructor.Map.empty)
     in
@@ -253,7 +256,7 @@ let rec transform_closures_expr :
     free_vars, build_closure ctx (Var.Map.bindings free_vars) body vars tys m
   | EAppOp
       {
-        op = ((HandleDefaultOpt | Fold | Map | Map2 | Filter | Reduce), _) as op;
+        op = ((HandleExceptions | Fold | Map | Map2 | Filter | Reduce), _) as op;
         tys;
         args;
       } ->
@@ -270,6 +273,9 @@ let rec transform_closures_expr :
           | EAbs { binder; tys } ->
             let vars, arg = Bindlib.unmbind binder in
             let new_free_vars, new_arg = (transform_closures_expr ctx) arg in
+            let new_free_vars =
+              Array.fold_left (fun m v -> Var.Map.remove v m) new_free_vars vars
+            in
             let new_arg =
               Expr.make_abs vars new_arg tys (Expr.mark_pos m_arg)
             in
@@ -507,7 +513,7 @@ let rec hoist_closures_expr :
               EnumConstructor.Map.add cons
                 (Expr.eabs new_binder tys (Mark.get e1))
                 new_cases )
-          | _ -> failwith "should not happen")
+          | _ -> assert false)
         cases
         (collected_closures, EnumConstructor.Map.empty)
     in
@@ -530,12 +536,7 @@ let rec hoist_closures_expr :
     in
     ( collected_closures,
       Expr.eapp ~f:(Expr.eabs new_binder tys e1_pos) ~args:new_args ~tys m )
-  | EAppOp
+  | EAppOp { op = ((Fold | Map | Filter | Reduce), _) as op; tys; args } ->
-      {
-        op = ((HandleDefaultOpt | Fold | Map | Filter | Reduce), _) as op;
-        tys;
-        args;
-      } ->
     (* Special case for some operators: its arguments closures thunks because if
        you want to extract it as a function you need these closures to preserve
        evaluation order, but backends that don't support closures will simply
@@ -562,21 +563,21 @@ let rec hoist_closures_expr :
         args ([], [])
     in
     collected_closures, Expr.eappop ~op ~args:new_args ~tys (Mark.get e)
-  | EAbs { tys; _ } ->
+  | EAbs { binder; tys } ->
     (* this is the closure we want to hoist *)
     let closure_var = new_var ~pfx:"closure_" name_context in
-    (* TODO: This will end up as a toplevel name. However for now we assume
-       toplevel names are unique, but this breaks this assertions and can lead
-       to name wrangling in the backends. We need to have a better system for
-       name disambiguation when for instance printing to Dcalc/Lcalc/Scalc but
-       also OCaml, Python, etc. *)
     let pos = Expr.mark_pos m in
     let ty = Expr.maybe_ty ~typ:(TArrow (tys, (TAny, pos))) m in
-    ( [{ name = closure_var; ty; closure = Expr.rebox e }],
+    let vars, body = Bindlib.unmbind binder in
+    let collected_closures, new_body =
+      (hoist_closures_expr name_context) body
+    in
+    let closure = Expr.make_abs vars new_body tys pos in
+    ( { name = closure_var; ty; closure } :: collected_closures,
       Expr.make_var closure_var m )
   | EApp _ | EStruct _ | EStructAccess _ | ETuple _ | ETupleAccess _ | EInj _
   | EArray _ | ELit _ | EAssert _ | EFatalError _ | EAppOp _ | EIfThenElse _
-  | ERaiseEmpty | ECatchEmpty _ | EVar _ ->
+  | EVar _ ->
     Expr.map_gather ~acc:[] ~join:( @ ) ~f:(hoist_closures_expr name_context) e
   | EExternal { name } -> [], Expr.box (EExternal { name }, m)
   | _ -> .

compiler/lcalc/compile_with_exceptions.ml

@@ -1,95 +0,0 @@
-(* This file is part of the Catala compiler, a specification language for tax
-   and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
-   Denis Merigoux <denis.merigoux@inria.fr>
-
-   Licensed under the Apache License, Version 2.0 (the "License"); you may not
-   use this file except in compliance with the License. You may obtain a copy of
-   the License at
-
-   http://www.apache.org/licenses/LICENSE-2.0
-
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-   License for the specific language governing permissions and limitations under
-   the License. *)
-
-open Catala_utils
-open Shared_ast
-module D = Dcalc.Ast
-module A = Ast
-
-let rec translate_typ (tau : typ) : typ =
-  Mark.map
-    (function
-      | TDefault t -> Mark.remove (translate_typ t)
-      | TLit l -> TLit l
-      | TTuple ts -> TTuple (List.map translate_typ ts)
-      | TStruct s -> TStruct s
-      | TEnum en -> TEnum en
-      | TOption _ ->
-        Message.error ~internal:true
-          "The types option should not appear before the dcalc -> lcalc \
-           translation step."
-      | TClosureEnv ->
-        Message.error ~internal:true
-          "The types closure_env should not appear before the dcalc -> lcalc \
-           translation step."
-      | TAny -> TAny
-      | TArray ts -> TArray (translate_typ ts)
-      | TArrow (t1, t2) -> TArrow (List.map translate_typ t1, translate_typ t2))
-    tau
-
-let translate_mark m = Expr.map_ty translate_typ m
-
-let rec translate_default
-    (exceptions : 'm D.expr list)
-    (just : 'm D.expr)
-    (cons : 'm D.expr)
-    (mark_default : 'm mark) : 'm A.expr boxed =
-  let pos = Expr.mark_pos mark_default in
-  let exceptions =
-    List.map (fun except -> Expr.thunk_term (translate_expr except)) exceptions
-  in
-  Expr.eappop
-    ~op:(Op.HandleDefault, Expr.pos cons)
-    ~tys:
-      [
-        TArray (TArrow ([TLit TUnit, pos], (TAny, pos)), pos), pos;
-        TArrow ([TLit TUnit, pos], (TLit TBool, pos)), pos;
-        TArrow ([TLit TUnit, pos], (TAny, pos)), pos;
-      ]
-    ~args:
-      [
-        Expr.earray exceptions
-          (Expr.map_ty
-             (fun ty -> TArray (TArrow ([TLit TUnit, pos], ty), pos), pos)
-             mark_default);
-        Expr.thunk_term (translate_expr just);
-        Expr.thunk_term (translate_expr cons);
-      ]
-    mark_default
-
-and translate_expr (e : 'm D.expr) : 'm A.expr boxed =
-  match e with
-  | EEmpty, m -> Expr.eraiseempty (translate_mark m)
-  | EErrorOnEmpty arg, m ->
-    let m = translate_mark m in
-    Expr.ecatchempty (translate_expr arg) (Expr.efatalerror Runtime.NoValue m) m
-  | EDefault { excepts; just; cons }, m ->
-    translate_default excepts just cons (translate_mark m)
-  | EPureDefault e, _ -> translate_expr e
-  | EAppOp { op; args; tys }, m ->
-    Expr.eappop ~op:(Operator.translate op)
-      ~args:(List.map translate_expr args)
-      ~tys:(List.map translate_typ tys)
-      (translate_mark m)
-  | ( ( ELit _ | EArray _ | EVar _ | EAbs _ | EApp _ | EExternal _
-      | EIfThenElse _ | ETuple _ | ETupleAccess _ | EInj _ | EAssert _
-      | EFatalError _ | EStruct _ | EStructAccess _ | EMatch _ ),
-      _ ) as e ->
-    Expr.map ~f:translate_expr ~typ:translate_typ e
-  | _ -> .
-
-let translate_program (prg : 'm D.program) : 'm A.program =
-  Program.map_exprs prg ~typ:translate_typ ~varf:Var.translate ~f:translate_expr

compiler/lcalc/compile_with_exceptions.mli

@@ -1,20 +0,0 @@
-(* This file is part of the Catala compiler, a specification language for tax
-   and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
-   Denis Merigoux <denis.merigoux@inria.fr>
-
-   Licensed under the Apache License, Version 2.0 (the "License"); you may not
-   use this file except in compliance with the License. You may obtain a copy of
-   the License at
-
-   http://www.apache.org/licenses/LICENSE-2.0
-
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-   License for the specific language governing permissions and limitations under
-   the License. *)
-
-(** Translation from the default calculus to the lambda calculus. This
-    translation uses exceptions to handle empty default terms. *)
-
-val translate_program : 'm Dcalc.Ast.program -> 'm Ast.program

compiler/lcalc/compile_without_exceptions.ml

@@ -1,126 +0,0 @@
-(* This file is part of the Catala compiler, a specification language for tax
-   and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
-   Alain Delaët-Tixeuil <alain.delaet--tixeuil@inria.fr>
-
-   Licensed under the Apache License, Version 2.0 (the "License"); you may not
-   use this file except in compliance with the License. You may obtain a copy of
-   the License at
-
-   http://www.apache.org/licenses/LICENSE-2.0
-
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-   License for the specific language governing permissions and limitations under
-   the License. *)
-
-open Catala_utils
-open Shared_ast
-module D = Dcalc.Ast
-module A = Ast
-
-(** We make use of the strong invriants on the structure of programs:
-    Defaultable values can only appear in certin positions. This information is
-    given by the type structure of expressions. In particular this mean we don't
-    need to use the monadic bind while computing arithmetic opertions or
-    function calls. The resulting function is not more difficult than what we
-    had when translating without exceptions.
-
-    The typing translation is to simply trnsform default type into option types. *)
-
-let rec translate_typ (tau : typ) : typ =
-  Mark.copy tau
-    begin
-      match Mark.remove tau with
-      | TDefault t -> TOption (translate_typ t)
-      | TLit l -> TLit l
-      | TTuple ts -> TTuple (List.map translate_typ ts)
-      | TStruct s -> TStruct s
-      | TEnum en -> TEnum en
-      | TOption _ ->
-        Message.error ~internal:true
-          "The types option should not appear before the dcalc -> lcalc \
-           translation step."
-      | TClosureEnv ->
-        Message.error ~internal:true
-          "The types closure_env should not appear before the dcalc -> lcalc \
-           translation step."
-      | TAny -> TAny
-      | TArray ts -> TArray (translate_typ ts)
-      | TArrow (t1, t2) -> TArrow (List.map translate_typ t1, translate_typ t2)
-    end
-
-let translate_mark m = Expr.map_ty translate_typ m
-
-let rec translate_default
-    (exceptions : 'm D.expr list)
-    (just : 'm D.expr)
-    (cons : 'm D.expr)
-    (mark_default : 'm mark) : 'm A.expr boxed =
-  (* Since the program is well typed, all exceptions have as type [option 't] *)
-  let pos = Expr.mark_pos mark_default in
-  let exceptions = List.map translate_expr exceptions in
-  let exceptions_and_cons_ty = Expr.maybe_ty mark_default in
-  Expr.eappop
-    ~op:(Op.HandleDefaultOpt, Expr.pos cons)
-    ~tys:
-      [
-        TArray exceptions_and_cons_ty, pos;
-        TArrow ([TLit TUnit, pos], (TLit TBool, pos)), pos;
-        TArrow ([TLit TUnit, pos], exceptions_and_cons_ty), pos;
-      ]
-    ~args:
-      [
-        Expr.earray exceptions
-          (Expr.map_ty (fun ty -> TArray ty, pos) mark_default);
-        (* In call-by-value programming languages, as lcalc, arguments are
-           evalulated before calling the function. Since we don't want to
-           execute the justification and conclusion while before checking every
-           exceptions, we need to thunk them. *)
-        Expr.thunk_term (translate_expr just);
-        Expr.thunk_term (translate_expr cons);
-      ]
-    mark_default
-
-and translate_expr (e : 'm D.expr) : 'm A.expr boxed =
-  match e with
-  | EEmpty, m ->
-    let m = translate_mark m in
-    let pos = Expr.mark_pos m in
-    Expr.einj
-      ~e:(Expr.elit LUnit (Expr.with_ty m (TLit TUnit, pos)))
-      ~cons:Expr.none_constr ~name:Expr.option_enum m
-  | EErrorOnEmpty arg, m ->
-    let m = translate_mark m in
-    let pos = Expr.mark_pos m in
-    let cases =
-      EnumConstructor.Map.of_list
-        [
-          ( Expr.none_constr,
-            let x = Var.make "_" in
-            Expr.make_abs [| x |] (Expr.efatalerror NoValue m) [TAny, pos] pos
-          );
-          (* | None x -> raise NoValueProvided *)
-          Expr.some_constr, Expr.fun_id ~var_name:"arg" m (* | Some x -> x *);
-        ]
-    in
-    Expr.ematch ~e:(translate_expr arg) ~name:Expr.option_enum ~cases m
-  | EDefault { excepts; just; cons }, m ->
-    translate_default excepts just cons (translate_mark m)
-  | EPureDefault e, m ->
-    Expr.einj ~e:(translate_expr e) ~cons:Expr.some_constr
-      ~name:Expr.option_enum (translate_mark m)
-  | EAppOp { op; tys; args }, m ->
-    Expr.eappop ~op:(Operator.translate op)
-      ~tys:(List.map translate_typ tys)
-      ~args:(List.map translate_expr args)
-      (translate_mark m)
-  | ( ( ELit _ | EArray _ | EVar _ | EApp _ | EAbs _ | EExternal _
-      | EIfThenElse _ | ETuple _ | ETupleAccess _ | EInj _ | EAssert _
-      | EFatalError _ | EStruct _ | EStructAccess _ | EMatch _ ),
-      _ ) as e ->
-    Expr.map ~f:translate_expr ~typ:translate_typ e
-  | _ -> .
-
-let translate_program (prg : 'm D.program) : 'm A.program =
-  Program.map_exprs prg ~typ:translate_typ ~varf:Var.translate ~f:translate_expr

compiler/lcalc/compile_without_exceptions.mli

@@ -1,22 +0,0 @@
-(* This file is part of the Catala compiler, a specification language for tax
-   and social benefits computation rules. Copyright (C) 2020-2022 Inria,
-   contributor: Alain Delaët-Tixeuil <alain.delaet--tixeuil@inria.fr>
-
-   Licensed under the Apache License, Version 2.0 (the "License"); you may not
-   use this file except in compliance with the License. You may obtain a copy of
-   the License at
-
-   http://www.apache.org/licenses/LICENSE-2.0
-
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
-   WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
-   License for the specific language governing permissions and limitations under
-   the License. *)
-
-(** Translation from the default calculus to the lambda calculus. This
-    translation uses an option monad to handle empty defaults terms. This
-    transformation is one piece to permit to compile toward legacy languages
-    that does not contains exceptions. *)
-
-val translate_program : 'm Dcalc.Ast.program -> 'm Ast.program

compiler/lcalc/from_dcalc.ml

@@ -1,6 +1,6 @@
 (* This file is part of the Catala compiler, a specification language for tax
    and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
-   Denis Merigoux <denis.merigoux@inria.fr>
+   Alain Delaët-Tixeuil <alain.delaet--tixeuil@inria.fr>
 
    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License. You may obtain a copy of
@@ -14,7 +14,130 @@
    License for the specific language governing permissions and limitations under
    the License. *)
 
+open Catala_utils
 open Shared_ast
+module D = Dcalc.Ast
+module A = Ast
+
+(** We make use of the strong invriants on the structure of programs:
+    Defaultable values can only appear in certin positions. This information is
+    given by the type structure of expressions. In particular this mean we don't
+    need to use the monadic bind while computing arithmetic opertions or
+    function calls. The resulting function is not more difficult than what we
+    had when translating without exceptions.
+
+    The typing translation is to simply trnsform default type into option types. *)
+
+let rec translate_typ (tau : typ) : typ =
+  Mark.copy tau
+    begin
+      match Mark.remove tau with
+      | TDefault t -> TOption (translate_typ t)
+      | TLit l -> TLit l
+      | TTuple ts -> TTuple (List.map translate_typ ts)
+      | TStruct s -> TStruct s
+      | TEnum en -> TEnum en
+      | TOption _ ->
+        Message.error ~internal:true
+          "The types option should not appear before the dcalc -> lcalc \
+           translation step."
+      | TClosureEnv ->
+        Message.error ~internal:true
+          "The types closure_env should not appear before the dcalc -> lcalc \
+           translation step."
+      | TAny -> TAny
+      | TArray ts -> TArray (translate_typ ts)
+      | TArrow (t1, t2) -> TArrow (List.map translate_typ t1, translate_typ t2)
+    end
+
+let translate_mark m = Expr.map_ty translate_typ m
+
+let rec translate_default
+    (exceptions : 'm D.expr list)
+    (just : 'm D.expr)
+    (cons : 'm D.expr)
+    (mark_default : 'm mark) : 'm A.expr boxed =
+  (* Since the program is well typed, all exceptions have as type [option 't] *)
+  let pos = Expr.mark_pos mark_default in
+  let exceptions = List.map translate_expr exceptions in
+  let ty_option = Expr.maybe_ty mark_default in
+  let ty_array = TArray ty_option, pos in
+  let ty_alpha =
+    match ty_option with
+    | TOption ty, _ -> ty
+    | (TAny, _) as ty -> ty
+    | _ -> assert false
+  in
+  let mark_alpha = Expr.with_ty mark_default ty_alpha in
+  Expr.ematch ~name:Expr.option_enum
+    ~e:
+      (Expr.eappop
+         ~op:(Op.HandleExceptions, Expr.pos cons)
+         ~tys:[ty_array]
+         ~args:[Expr.earray exceptions (Expr.with_ty mark_default ty_array)]
+         mark_default)
+    ~cases:
+      (EnumConstructor.Map.of_list
+         [
+           (* Some x -> Some x *)
+           ( Expr.some_constr,
+             let x = Var.make "x" in
+             Expr.make_abs [| x |]
+               (Expr.einj ~name:Expr.option_enum ~cons:Expr.some_constr
+                  ~e:(Expr.evar x mark_alpha) mark_default)
+               [ty_alpha] pos );
+           (* None -> if just then cons else None *)
+           ( Expr.none_constr,
+             Expr.thunk_term
+               (Expr.eifthenelse (translate_expr just) (translate_expr cons)
+                  (Expr.einj
+                     ~e:
+                       (Expr.elit LUnit
+                          (Expr.with_ty mark_default (TLit TUnit, pos)))
+                     ~cons:Expr.none_constr ~name:Expr.option_enum mark_default)
+                  mark_default) );
+         ])
+    mark_default
+
+and translate_expr (e : 'm D.expr) : 'm A.expr boxed =
+  match e with
+  | EEmpty, m ->
+    let m = translate_mark m in
+    let pos = Expr.mark_pos m in
+    Expr.einj
+      ~e:(Expr.elit LUnit (Expr.with_ty m (TLit TUnit, pos)))
+      ~cons:Expr.none_constr ~name:Expr.option_enum m
+  | EErrorOnEmpty arg, m ->
+    let m = translate_mark m in
+    let pos = Expr.mark_pos m in
+    let cases =
+      EnumConstructor.Map.of_list
+        [
+          ( Expr.none_constr,
+            let x = Var.make "_" in
+            Expr.make_abs [| x |] (Expr.efatalerror NoValue m) [TAny, pos] pos
+          );
+          (* | None x -> raise NoValueProvided *)
+          Expr.some_constr, Expr.fun_id ~var_name:"arg" m (* | Some x -> x *);
+        ]
+    in
+    Expr.ematch ~e:(translate_expr arg) ~name:Expr.option_enum ~cases m
+  | EDefault { excepts; just; cons }, m ->
+    translate_default excepts just cons (translate_mark m)
+  | EPureDefault e, m ->
+    Expr.einj ~e:(translate_expr e) ~cons:Expr.some_constr
+      ~name:Expr.option_enum (translate_mark m)
+  | EAppOp { op; tys; args }, m ->
+    Expr.eappop ~op:(Operator.translate op)
+      ~tys:(List.map translate_typ tys)
+      ~args:(List.map translate_expr args)
+      (translate_mark m)
+  | ( ( ELit _ | EArray _ | EVar _ | EApp _ | EAbs _ | EExternal _
+      | EIfThenElse _ | ETuple _ | ETupleAccess _ | EInj _ | EAssert _
+      | EFatalError _ | EStruct _ | EStructAccess _ | EMatch _ ),
+      _ ) as e ->
+    Expr.map ~f:translate_expr ~typ:translate_typ e
+  | _ -> .
 
 let add_option_type ctx =
   {
@@ -26,9 +149,7 @@ let add_option_type ctx =
 let add_option_type_program prg =
   { prg with decl_ctx = add_option_type prg.decl_ctx }
 
-let translate_program_with_exceptions =
+let translate_program (prg : 'm D.program) : 'm A.program =
-  Compile_with_exceptions.translate_program
+  Program.map_exprs
-
+    (add_option_type_program prg)
-let translate_program_without_exceptions prg =
+    ~typ:translate_typ ~varf:Var.translate ~f:translate_expr
-  let prg = add_option_type_program prg in
-  Compile_without_exceptions.translate_program prg

compiler/lcalc/from_dcalc.mli

@@ -1,6 +1,6 @@
 (* This file is part of the Catala compiler, a specification language for tax
-   and social benefits computation rules. Copyright (C) 2020 Inria, contributor:
+   and social benefits computation rules. Copyright (C) 2020-2022 Inria,
-   Denis Merigoux <denis.merigoux@inria.fr>
+   contributor: Alain Delaët-Tixeuil <alain.delaet--tixeuil@inria.fr>
 
    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License. You may obtain a copy of
@@ -14,13 +14,9 @@
    License for the specific language governing permissions and limitations under
    the License. *)
 
-val translate_program_with_exceptions : 'm Dcalc.Ast.program -> 'm Ast.program
-(** Translation from the default calculus to the lambda calculus. This
-    translation uses exceptions to handle empty default terms. *)
-
-val translate_program_without_exceptions :
-  'm Dcalc.Ast.program -> 'm Ast.program
 (** Translation from the default calculus to the lambda calculus. This
     translation uses an option monad to handle empty defaults terms. This
     transformation is one piece to permit to compile toward legacy languages
-    that does not contains catchable exceptions. *)
+    that does not contains exceptions. *)
+
+val translate_program : 'm Dcalc.Ast.program -> 'm Ast.program

compiler/lcalc/monomorphize.ml

@@ -78,7 +78,7 @@ let collect_monomorphized_instances (prg : typed program) :
                           args;
                       name =
                         StructName.fresh []
-                          ( "tuple_" ^ string_of_int !option_instances_counter,
+                          ( "tuple_" ^ string_of_int !tuple_instances_counter,
                             Pos.no_pos );
                     })
               acc.tuples;
@@ -90,7 +90,7 @@ let collect_monomorphized_instances (prg : typed program) :
         {
           acc with
           arrays =
-            Type.Map.update t
+            Type.Map.update typ
               (fun monomorphized_name ->
                 match monomorphized_name with
                 | Some e -> Some e
@@ -118,7 +118,7 @@ let collect_monomorphized_instances (prg : typed program) :
         {
           acc with
           options =
-            Type.Map.update t
+            Type.Map.update typ
               (fun monomorphized_name ->
                 match monomorphized_name with
                 | Some e -> Some e
@@ -173,8 +173,9 @@ let rec monomorphize_typ
     (typ : typ) : typ =
   match Mark.remove typ with
   | TStruct _ | TEnum _ | TAny | TClosureEnv | TLit _ -> typ
-  | TArray t1 ->
+  | TArray _ ->
-    TStruct (Type.Map.find t1 monomorphized_instances.arrays).name, Mark.get typ
+    ( TStruct (Type.Map.find typ monomorphized_instances.arrays).name,
+      Mark.get typ )
   | TDefault t1 ->
     TDefault (monomorphize_typ monomorphized_instances t1), Mark.get typ
   | TArrow (t1s, t2) ->
@@ -185,8 +186,8 @@ let rec monomorphize_typ
   | TTuple _ ->
     ( TStruct (Type.Map.find typ monomorphized_instances.tuples).name,
       Mark.get typ )
-  | TOption t1 ->
+  | TOption _ ->
-    TEnum (Type.Map.find t1 monomorphized_instances.options).name, Mark.get typ
+    TEnum (Type.Map.find typ monomorphized_instances.options).name, Mark.get typ
 
 let is_some c =
   EnumConstructor.equal Expr.some_constr c
@@ -233,7 +234,12 @@ let rec monomorphize_expr
         field = fst (List.nth tuple_instance.fields index);
       }
   | EMatch { name; e; cases } when EnumName.equal name Expr.option_enum ->
-    let option_instance = Type.Map.find ty0 monomorphized_instances.options in
+    let opt_ty =
+      match e0 with EMatch { e; _ }, _ -> Expr.ty e | _ -> assert false
+    in
+    let option_instance =
+      Type.Map.find opt_ty monomorphized_instances.options
+    in
     EMatch
       {
         name = option_instance.name;
@@ -247,11 +253,7 @@ let rec monomorphize_expr
             cases EnumConstructor.Map.empty;
       }
   | EInj { name; e; cons } when EnumName.equal name Expr.option_enum ->
-    let option_instance =
+    let option_instance = Type.Map.find ty0 monomorphized_instances.options in
-      Type.Map.find
-        (match Mark.remove ty0 with TOption t -> t | _ -> assert false)
-        monomorphized_instances.options
-    in
     EInj
       {
         name = option_instance.name;
@@ -264,7 +266,7 @@ let rec monomorphize_expr
     let elt_ty =
       match Mark.remove ty0 with TArray t -> t | _ -> assert false
     in
-    let array_instance = Type.Map.find elt_ty monomorphized_instances.arrays in
+    let array_instance = Type.Map.find ty0 monomorphized_instances.arrays in
     EStruct
       {
         name = array_instance.name;

compiler/lcalc/to_ocaml.ml

@@ -409,21 +409,6 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
       format_with_parens arg1
   | EAppOp { op = Log _, _; args = [arg1]; _ } ->
     Format.fprintf fmt "%a" format_with_parens arg1
-  | EAppOp
-      {
-        op = ((HandleDefault | HandleDefaultOpt) as op), _;
-        args = (EArray excs, _) :: _ as args;
-        _;
-      } ->
-    let pos = List.map Expr.pos excs in
-    Format.fprintf fmt "@[<hov 2>%s@ [|%a|]@ %a@]"
-      (Print.operator_to_string op)
-      (Format.pp_print_list
-         ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
-         format_pos)
-      pos
-      (Format.pp_print_list ~pp_sep:Format.pp_print_space format_with_parens)
-      args
   | EApp { f; args; _ } ->
     Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_with_parens f
       (Format.pp_print_list
@@ -443,6 +428,12 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
           Format.fprintf ppf "%a@ " format_pos pos
         | Div_int_int | Div_rat_rat | Div_mon_mon | Div_mon_rat | Div_dur_dur ->
           Format.fprintf ppf "%a@ " format_pos (Expr.pos (List.nth args 1))
+        | HandleExceptions ->
+          Format.fprintf ppf "[|@[<hov>%a@]|]@ "
+            (Format.pp_print_list
+               ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
+               format_pos)
+            (List.map Expr.pos args)
         | _ -> ())
       (Format.pp_print_list
          ~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
@@ -457,10 +448,6 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
   | EFatalError er ->
     Format.fprintf fmt "raise@ (Runtime_ocaml.Runtime.Error (%a, [%a]))"
       Print.runtime_error er format_pos (Expr.pos e)
-  | ERaiseEmpty -> Format.fprintf fmt "raise Empty"
-  | ECatchEmpty { body; handler } ->
-    Format.fprintf fmt "@[<hv>@[<hov 2>try@ %a@]@ with Empty ->@]@ @[%a@]"
-      format_with_parens body format_with_parens handler
   | _ -> .
 
 let format_struct_embedding

compiler/plugins/api_web.ml

@@ -471,15 +471,13 @@ let run
     output
     optimize
     check_invariants
-    avoid_exceptions
     closure_conversion
     monomorphize_types
     _options =
   let options = Global.enforce_options ~trace:true () in
   let prg, type_ordering =
     Driver.Passes.lcalc options ~includes ~optimize ~check_invariants
-      ~avoid_exceptions ~closure_conversion ~typed:Expr.typed
+      ~closure_conversion ~typed:Expr.typed ~monomorphize_types
-      ~monomorphize_types
   in
   let jsoo_output_file, with_formatter =
     Driver.Commands.get_output_format options ~ext:"_api_web.ml" output
@@ -506,7 +504,6 @@ let term =
   $ Cli.Flags.output
   $ Cli.Flags.optimize
   $ Cli.Flags.check_invariants
-  $ Cli.Flags.avoid_exceptions
   $ Cli.Flags.closure_conversion
   $ Cli.Flags.monomorphize_types
 

compiler/plugins/explain.ml

@@ -1085,8 +1085,7 @@ let expr_to_dot_label0 :
           | Reduce -> xlang () ~en:"reduce" ~fr:"réunion"
           | Filter -> xlang () ~en:"filter" ~fr:"filtre"
           | Fold -> xlang () ~en:"fold" ~fr:"pliage"
-          | HandleDefault -> ""
+          | HandleExceptions -> ""
-          | HandleDefaultOpt -> ""
           | ToClosureEnv -> ""
           | FromClosureEnv -> ""
         in
@@ -1382,9 +1381,7 @@ let run includes optimize ex_scope explain_options global_options =
       ~check_invariants:false ~typed:Expr.typed
   in
   Interpreter.load_runtime_modules prg
-    ~hashf:
+    ~hashf:(Hash.finalise ~closure_conversion:false ~monomorphize_types:false);
-      (Hash.finalise ~avoid_exceptions:false ~closure_conversion:false
-         ~monomorphize_types:false);
   let scope = Driver.Commands.get_scope_uid prg.decl_ctx ex_scope in
   (* let result_expr, env = interpret_program prg scope in *)
   let g, base_vars, env = program_to_graph explain_options prg scope in

compiler/plugins/json_schema.ml

@@ -210,15 +210,13 @@ let run
     output
     optimize
     check_invariants
-    avoid_exceptions
     closure_conversion
     monomorphize_types
     ex_scope
     options =
   let prg, _ =
     Driver.Passes.lcalc options ~includes ~optimize ~check_invariants
-      ~avoid_exceptions ~closure_conversion ~typed:Expr.typed
+      ~closure_conversion ~typed:Expr.typed ~monomorphize_types
-      ~monomorphize_types
   in
   let output_file, with_output =
     Driver.Commands.get_output_format options ~ext:"_schema.json" output
@@ -239,7 +237,6 @@ let term =
   $ Cli.Flags.output
   $ Cli.Flags.optimize
   $ Cli.Flags.check_invariants
-  $ Cli.Flags.avoid_exceptions
   $ Cli.Flags.closure_conversion
   $ Cli.Flags.monomorphize_types
   $ Cli.Flags.ex_scope

compiler/plugins/lazy_interp.ml

@@ -272,9 +272,7 @@ let run includes optimize check_invariants ex_scope options =
       ~typed:Expr.typed
   in
   Interpreter.load_runtime_modules prg
-    ~hashf:
+    ~hashf:(Hash.finalise ~closure_conversion:false ~monomorphize_types:false);
-      (Hash.finalise ~avoid_exceptions:false ~closure_conversion:false
-         ~monomorphize_types:false);
   let scope = Driver.Commands.get_scope_uid prg.decl_ctx ex_scope in
   let result_expr, _env = interpret_program prg scope in
   let fmt = Format.std_formatter in

compiler/plugins/python.ml

@@ -22,20 +22,12 @@
 
 open Catala_utils
 
-let run
+let run includes output optimize check_invariants closure_conversion options =
-    includes
-    output
-    optimize
-    check_invariants
-    avoid_exceptions
-    closure_conversion
-    options =
   let open Driver.Commands in
   let prg, type_ordering =
     Driver.Passes.scalc options ~includes ~optimize ~check_invariants
-      ~avoid_exceptions ~closure_conversion ~keep_special_ops:false
+      ~closure_conversion ~keep_special_ops:false ~dead_value_assignment:true
-      ~dead_value_assignment:true ~no_struct_literals:false
+      ~no_struct_literals:false ~monomorphize_types:false
-      ~monomorphize_types:false
   in
 
   let output_file, with_output = get_output_format options ~ext:".py" output in
@@ -50,7 +42,6 @@ let term =
   $ Cli.Flags.output
   $ Cli.Flags.optimize
   $ Cli.Flags.check_invariants
-  $ Cli.Flags.avoid_exceptions
   $ Cli.Flags.closure_conversion
 
 let () =

compiler/scalc/ast.ml

@@ -33,10 +33,6 @@ module VarName =
     end)
     ()
 
-let dead_value = VarName.fresh ("dead_value", Pos.no_pos)
-let handle_default = FuncName.fresh ("handle_default", Pos.no_pos)
-let handle_default_opt = FuncName.fresh ("handle_default_opt", Pos.no_pos)
-
 type operator = Shared_ast.lcalc Shared_ast.operator
 
 type expr = naked_expr Mark.pos

compiler/scalc/from_lcalc.ml

@@ -35,13 +35,6 @@ type 'm ctxt = {
   program_ctx : A.ctx;
 }
 
-let unthunk e =
-  match Mark.remove e with
-  | EAbs { binder; tys = [(TLit TUnit, _)] } ->
-    let _, e = Bindlib.unmbind binder in
-    e
-  | _ -> failwith "should not happen"
-
 (* Expressions can spill out side effect, hence this function also returns a
    list of statements to be prepended before the expression is evaluated *)
 
@@ -138,15 +131,6 @@ and translate_expr (ctxt : 'm ctxt) (expr : 'm L.expr) : RevBlock.t * A.expr =
     | ETupleAccess { e = e1; index; _ } ->
       let e1_stmts, new_e1 = translate_expr ctxt e1 in
       e1_stmts, (A.ETupleAccess { e1 = new_e1; index }, Expr.pos expr)
-    | EAppOp
-        {
-          op = Op.HandleDefaultOpt, _;
-          args = [_exceptions; _just; _cons];
-          tys = _;
-        }
-      when ctxt.config.keep_special_ops ->
-      (* This should be translated as a statement *)
-      raise (NotAnExpr { needs_a_local_decl = true })
     | EAppOp { op; args; tys = _ } ->
       let args_stmts, new_args = translate_expr_list ctxt args in
       (* FIXME: what happens if [arg] is not a tuple but reduces to one ? *)
@@ -227,8 +211,7 @@ and translate_expr (ctxt : 'm ctxt) (expr : 'm L.expr) : RevBlock.t * A.expr =
           Expr.pos expr )
       in
       RevBlock.empty, (EExternal { modname; name }, Expr.pos expr)
-    | ECatchEmpty _ | EAbs _ | EIfThenElse _ | EMatch _ | EAssert _
+    | EAbs _ | EIfThenElse _ | EMatch _ | EAssert _ | EFatalError _ ->
-    | EFatalError _ | ERaiseEmpty ->
       raise (NotAnExpr { needs_a_local_decl = true })
     | _ -> .
   with NotAnExpr { needs_a_local_decl } ->
@@ -274,60 +257,60 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
       ~tail:[A.SAssert (Mark.remove new_e), Expr.pos block_expr]
       e_stmts
   | EFatalError err -> [SFatalError err, Expr.pos block_expr]
-  | EAppOp
+  (* | EAppOp
-      { op = Op.HandleDefaultOpt, _; tys = _; args = [exceptions; just; cons] }
+   *     { op = Op.HandleDefaultOpt, _; tys = _; args = [exceptions; just; cons] }
-    when ctxt.config.keep_special_ops ->
+   *   when ctxt.config.keep_special_ops ->
-    let exceptions =
+   *   let exceptions =
-      match Mark.remove exceptions with
+   *     match Mark.remove exceptions with
-      | EStruct { fields; _ } -> (
+   *     | EStruct { fields; _ } -> (
-        let _, exceptions =
+   *       let _, exceptions =
-          List.find
+   *         List.find
-            (fun (field, _) ->
+   *           (fun (field, _) ->
-              String.equal (Mark.remove (StructField.get_info field)) "content")
+   *             String.equal (Mark.remove (StructField.get_info field)) "content")
-            (StructField.Map.bindings fields)
+   *           (StructField.Map.bindings fields)
-        in
+   *       in
-        match Mark.remove exceptions with
+   *       match Mark.remove exceptions with
-        | EArray exceptions -> exceptions
+   *       | EArray exceptions -> exceptions
-        | _ -> failwith "should not happen")
+   *       | _ -> failwith "should not happen")
-      | _ -> failwith "should not happen"
+   *     | _ -> failwith "should not happen"
-    in
+   *   in
-    let just = unthunk just in
+   *   let just = unthunk just in
-    let cons = unthunk cons in
+   *   let cons = unthunk cons in
-    let exceptions_stmts, new_exceptions =
+   *   let exceptions_stmts, new_exceptions =
-      translate_expr_list ctxt exceptions
+   *     translate_expr_list ctxt exceptions
-    in
+   *   in
-    let just_stmts, new_just = translate_expr ctxt just in
+   *   let just_stmts, new_just = translate_expr ctxt just in
-    let cons_stmts, new_cons = translate_expr ctxt cons in
+   *   let cons_stmts, new_cons = translate_expr ctxt cons in
-    RevBlock.rebuild exceptions_stmts
+   *   RevBlock.rebuild exceptions_stmts
-      ~tail:
+   *     ~tail:
-        (RevBlock.rebuild just_stmts
+   *       (RevBlock.rebuild just_stmts
-           ~tail:
+   *          ~tail:
-             [
+   *            [
-               ( A.SSpecialOp
+   *              ( A.SSpecialOp
-                   (OHandleDefaultOpt
+   *                  (OHandleDefaultOpt
-                      {
+   *                     {
-                        exceptions = new_exceptions;
+   *                       exceptions = new_exceptions;
-                        just = new_just;
+   *                       just = new_just;
-                        cons =
+   *                       cons =
-                          RevBlock.rebuild cons_stmts
+   *                         RevBlock.rebuild cons_stmts
-                            ~tail:
+   *                           ~tail:
-                              [
+   *                             [
-                                ( (match ctxt.inside_definition_of with
+   *                               ( (match ctxt.inside_definition_of with
-                                  | None -> A.SReturn (Mark.remove new_cons)
+   *                                 | None -> A.SReturn (Mark.remove new_cons)
-                                  | Some x ->
+   *                                 | Some x ->
-                                    A.SLocalDef
+   *                                   A.SLocalDef
-                                      {
+   *                                     {
-                                        name = Mark.copy new_cons x;
+   *                                       name = Mark.copy new_cons x;
-                                        expr = new_cons;
+   *                                       expr = new_cons;
-                                        typ =
+   *                                       typ =
-                                          Expr.maybe_ty (Mark.get block_expr);
+   *                                         Expr.maybe_ty (Mark.get block_expr);
-                                      }),
+   *                                     }),
-                                  Expr.pos block_expr );
+   *                                 Expr.pos block_expr );
-                              ];
+   *                             ];
-                        return_typ = Expr.maybe_ty (Mark.get block_expr);
+   *                       return_typ = Expr.maybe_ty (Mark.get block_expr);
-                      }),
+   *                     }),
-                 Expr.pos block_expr );
+   *                Expr.pos block_expr );
-             ])
+   *            ]) *)
   | EApp { f = EAbs { binder; tys }, binder_mark; args; _ } ->
     (* This defines multiple local variables at the time *)
     let binder_pos = Expr.mark_pos binder_mark in
@@ -483,29 +466,6 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
               },
             Expr.pos block_expr );
         ]
-  | ECatchEmpty { body; handler } ->
-    let s_e_try = translate_statements ctxt body in
-    let s_e_catch = translate_statements ctxt handler in
-    [
-      ( A.STryWEmpty { try_block = s_e_try; with_block = s_e_catch },
-        Expr.pos block_expr );
-    ]
-  | ERaiseEmpty ->
-    (* Before raising the exception, we still give a dummy definition to the
-       current variable so that tools like mypy don't complain. *)
-    (match ctxt.inside_definition_of with
-    | Some x when ctxt.config.dead_value_assignment ->
-      [
-        ( A.SLocalDef
-            {
-              name = x, Expr.pos block_expr;
-              expr = Ast.EVar Ast.dead_value, Expr.pos block_expr;
-              typ = Expr.maybe_ty (Mark.get block_expr);
-            },
-          Expr.pos block_expr );
-      ]
-    | _ -> [])
-    @ [A.SRaiseEmpty, Expr.pos block_expr]
   | EInj { e = e1; cons; name } when ctxt.config.no_struct_literals ->
     let e1_stmts, new_e1 = translate_expr ctxt e1 in
     let tmp_struct_var_name =

compiler/scalc/print.ml

@@ -53,7 +53,7 @@ let rec format_expr
       (StructField.Map.bindings es)
       Print.punctuation "}"
   | ETuple es ->
-    Format.fprintf fmt "@[<hov 2>%a%a%a@]" Print.punctuation "()"
+    Format.fprintf fmt "@[<hov 2>%a%a%a@]" Print.punctuation "("
       (Format.pp_print_list
          ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
          (fun fmt e -> Format.fprintf fmt "%a" format_expr e))
@@ -233,21 +233,11 @@ let format_item decl_ctx ?debug ppf def =
   Format.pp_print_cut ppf ()
 
 let format_program ?debug ppf prg =
-  let decl_ctx =
-    (* TODO: this is redundant with From_dcalc.add_option_type (which is already
-       applied in avoid_exceptions mode) *)
-    {
-      prg.ctx.decl_ctx with
-      ctx_enums =
-        EnumName.Map.add Expr.option_enum Expr.option_enum_config
-          prg.ctx.decl_ctx.ctx_enums;
-    }
-  in
   Format.pp_open_vbox ppf 0;
   ModuleName.Map.iter
     (fun m var ->
       Format.fprintf ppf "%a %a = %a@," Print.keyword "module" format_var_name
         var ModuleName.format m)
     prg.ctx.modules;
-  Format.pp_print_list (format_item decl_ctx ?debug) ppf prg.code_items;
+  Format.pp_print_list (format_item prg.ctx.decl_ctx ?debug) ppf prg.code_items;
   Format.pp_close_box ppf ()

compiler/scalc/to_c.ml

@@ -313,9 +313,8 @@ let format_op (fmt : Format.formatter) (op : operator Mark.pos) : unit =
   | Reduce -> Format.pp_print_string fmt "catala_list_reduce"
   | Filter -> Format.pp_print_string fmt "catala_list_filter"
   | Fold -> Format.pp_print_string fmt "catala_list_fold_left"
-  | HandleDefault -> Format.pp_print_string fmt "catala_handle_default"
+  | HandleExceptions -> Format.pp_print_string fmt "catala_handle_exceptions"
-  | HandleDefaultOpt | FromClosureEnv | ToClosureEnv | Map2 ->
+  | FromClosureEnv | ToClosureEnv | Map2 -> failwith "unimplemented"
-    failwith "unimplemented"
 
 let _format_string_list (fmt : Format.formatter) (uids : string list) : unit =
   let sanitize_quotes = Re.compile (Re.char '"') in
@@ -368,8 +367,6 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
     Format.fprintf fmt "%a %a" format_op op (format_expression ctx) arg1
   | EAppOp { op; args = [arg1] } ->
     Format.fprintf fmt "%a(%a)" format_op op (format_expression ctx) arg1
-  | EAppOp { op = (HandleDefaultOpt | HandleDefault), _; args = _ } ->
-    failwith "should not happen because of keep_special_ops"
   | EApp { f; args } ->
     Format.fprintf fmt "%a(@[<hov 0>%a)@]" (format_expression ctx) f
       (Format.pp_print_list

compiler/scalc/to_python.ml

@@ -88,8 +88,7 @@ let format_op (fmt : Format.formatter) (op : operator Mark.pos) : unit =
   | Reduce -> Format.pp_print_string fmt "list_reduce"
   | Filter -> Format.pp_print_string fmt "list_filter"
   | Fold -> Format.pp_print_string fmt "list_fold_left"
-  | HandleDefault -> Format.pp_print_string fmt "handle_default"
+  | HandleExceptions -> Format.pp_print_string fmt "handle_exceptions"
-  | HandleDefaultOpt -> Format.pp_print_string fmt "handle_default_opt"
   | FromClosureEnv | ToClosureEnv -> failwith "unimplemented"
 
 let format_uid_list (fmt : Format.formatter) (uids : Uid.MarkedString.info list)
@@ -347,41 +346,27 @@ let rec format_expression ctx (fmt : Format.formatter) (e : expr) : unit =
         args = [arg1];
       } ->
     Format.fprintf fmt "%a %a" format_op op (format_expression ctx) arg1
+  | EAppOp { op = (HandleExceptions, _) as op; args = [(EArray el, _)] as args }
+    ->
+    Format.fprintf fmt "@[<hv 4>%a(@,[%a],@ %a@;<0 -4>)@]" format_op op
+      (Format.pp_print_list
+         ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
+         format_position)
+      (List.map Mark.get el)
+      (Format.pp_print_list
+         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
+         (format_expression ctx))
+      args
   | EAppOp { op; args = [arg1] } ->
     Format.fprintf fmt "%a(%a)" format_op op (format_expression ctx) arg1
-  | EAppOp { op = ((HandleDefault | HandleDefaultOpt), _) as op; args } ->
-    let pos = Mark.get e in
-    Format.fprintf fmt
-      "%a(@[<hov 0>SourcePosition(filename=\"%s\",@ start_line=%d,@ \
-       start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)@]"
-      format_op op (Pos.get_file pos) (Pos.get_start_line pos)
-      (Pos.get_start_column pos) (Pos.get_end_line pos) (Pos.get_end_column pos)
-      format_string_list (Pos.get_law_info pos)
-      (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
-         (format_expression ctx))
-      args
-  | EApp { f = EFunc x, pos; args }
-    when Ast.FuncName.compare x Ast.handle_default = 0
-         || Ast.FuncName.compare x Ast.handle_default_opt = 0 ->
-    Format.fprintf fmt
-      "%a(@[<hov 0>SourcePosition(filename=\"%s\",@ start_line=%d,@ \
-       start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)@]"
-      format_func_name x (Pos.get_file pos) (Pos.get_start_line pos)
-      (Pos.get_start_column pos) (Pos.get_end_line pos) (Pos.get_end_column pos)
-      format_string_list (Pos.get_law_info pos)
-      (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
-         (format_expression ctx))
-      args
   | EApp { f; args } ->
-    Format.fprintf fmt "%a(@[<hov 0>%a)@]" (format_expression ctx) f
+    Format.fprintf fmt "%a(@[<hv 0>%a)@]" (format_expression ctx) f
       (Format.pp_print_list
          ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
          (format_expression ctx))
       args
   | EAppOp { op; args } ->
-    Format.fprintf fmt "%a(@[<hov 0>%a)@]" format_op op
+    Format.fprintf fmt "%a(@[<hv 0>%a)@]" format_op op
       (Format.pp_print_list
          ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
          (format_expression ctx))
@@ -402,10 +387,10 @@ let rec format_statement ctx (fmt : Format.formatter) (s : stmt Mark.pos) : unit
     =
   match Mark.remove s with
   | SInnerFuncDef { name; func = { func_params; func_body; _ } } ->
-    Format.fprintf fmt "@[<hov 4>def %a(%a):@\n%a@]" format_var
+    Format.fprintf fmt "@[<v 4>def %a(@[<hov>%a@]):@ %a@]" format_var
       (Mark.remove name)
       (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
+         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
          (fun fmt (var, typ) ->
            Format.fprintf fmt "%a:%a" format_var (Mark.remove var)
              (format_typ ctx) typ))
@@ -414,16 +399,16 @@ let rec format_statement ctx (fmt : Format.formatter) (s : stmt Mark.pos) : unit
     assert false (* We don't need to declare variables in Python *)
   | SLocalDef { name = v; expr = e; _ } | SLocalInit { name = v; expr = e; _ }
     ->
-    Format.fprintf fmt "@[<hov 4>%a = %a@]" format_var (Mark.remove v)
+    Format.fprintf fmt "@[<hv 4>%a = %a@]" format_var (Mark.remove v)
       (format_expression ctx) e
   | STryWEmpty { try_block = try_b; with_block = catch_b } ->
-    Format.fprintf fmt "@[<v 4>try:@,%a@]@\n@[<v 4>except Empty:@,%a@]"
+    Format.fprintf fmt "@[<v 4>try:@ %a@]@,@[<v 4>except Empty:@ %a@]"
       (format_block ctx) try_b (format_block ctx) catch_b
   | SRaiseEmpty -> Format.fprintf fmt "raise Empty"
   | SFatalError err ->
     Format.fprintf fmt "@[<hov 4>raise %a@]" format_error (err, Mark.get s)
   | SIfThenElse { if_expr = cond; then_block = b1; else_block = b2 } ->
-    Format.fprintf fmt "@[<hov 4>if %a:@\n%a@]@\n@[<hov 4>else:@\n%a@]"
+    Format.fprintf fmt "@[<v 4>if %a:@ %a@]@,@[<v 4>else:@ %a@]"
       (format_expression ctx) cond (format_block ctx) b1 (format_block ctx) b2
   | SSwitch
       {
@@ -439,11 +424,11 @@ let rec format_statement ctx (fmt : Format.formatter) (s : stmt Mark.pos) : unit
     when EnumName.equal e_name Expr.option_enum ->
     (* We translate the option type with an overloading by Python's [None] *)
     let tmp_var = VarName.fresh ("perhaps_none_arg", Pos.no_pos) in
-    Format.fprintf fmt "%a = %a@\n" format_var tmp_var (format_expression ctx)
+    Format.fprintf fmt "@[<hv 4>%a = %a@]@," format_var tmp_var
-      e1;
+      (format_expression ctx) e1;
-    Format.fprintf fmt "@[<v 4>if %a is None:@\n%a@]@\n" format_var tmp_var
+    Format.fprintf fmt "@[<v 4>if %a is None:@ %a@]@," format_var tmp_var
       (format_block ctx) case_none;
-    Format.fprintf fmt "@[<v 4>else:@\n%a = %a@\n%a@]" format_var case_some_var
+    Format.fprintf fmt "@[<v 4>else:@ %a = %a@,%a@]" format_var case_some_var
       format_var tmp_var (format_block ctx) case_some
   | SSwitch { switch_expr = e1; enum_name = e_name; switch_cases = cases; _ } ->
     let cons_map = EnumName.Map.find e_name ctx.decl_ctx.ctx_enums in
@@ -470,10 +455,10 @@ let rec format_statement ctx (fmt : Format.formatter) (s : stmt Mark.pos) : unit
   | SAssert e1 ->
     let pos = Mark.get s in
     Format.fprintf fmt
-      "@[<hov 4>if not (%a):@\n\
+      "@[<hv 4>if not (%a):@,\
-       raise AssertionFailure(@[<hov 0>SourcePosition(@[<hov \
+       raise AssertionFailure(@[<hov>SourcePosition(@[<hov 0>filename=\"%s\",@ \
-       0>filename=\"%s\",@ start_line=%d,@ start_column=%d,@ end_line=%d,@ \
+       start_line=%d,@ start_column=%d,@ end_line=%d,@ end_column=%d,@ \
-       end_column=%d,@ law_headings=@[<hv>%a@])@])@]@]"
+       law_headings=@[<hv>%a@])@])@]@]"
       (format_expression ctx)
       (e1, Mark.get s)
       (Pos.get_file pos) (Pos.get_start_line pos) (Pos.get_start_column pos)
@@ -482,12 +467,14 @@ let rec format_statement ctx (fmt : Format.formatter) (s : stmt Mark.pos) : unit
   | SSpecialOp _ -> failwith "should not happen"
 
 and format_block ctx (fmt : Format.formatter) (b : block) : unit =
+  Format.pp_open_vbox fmt 0;
   Format.pp_print_list
-    ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
+    ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,")
     (format_statement ctx) fmt
     (List.filter
        (fun s -> match Mark.remove s with SLocalDecl _ -> false | _ -> true)
-       b)
+       b);
+  Format.pp_close_box fmt ()
 
 let format_ctx
     (type_ordering : Scopelang.Dependency.TVertex.t list)
@@ -496,20 +483,20 @@ let format_ctx
   let format_struct_decl fmt (struct_name, struct_fields) =
     let fields = StructField.Map.bindings struct_fields in
     Format.fprintf fmt
-      "class %a:@\n\
+      "class %a:@,\
-      \    def __init__(self, %a) -> None:@\n\
+      \    def __init__(self, %a) -> None:@,\
-       %a@\n\
+       %a@,\
-       @\n\
+       @,\
-      \    def __eq__(self, other: object) -> bool:@\n\
+      \    def __eq__(self, other: object) -> bool:@,\
-      \        if isinstance(other, %a):@\n\
+      \        if isinstance(other, %a):@,\
-      \            return @[<hov>(%a)@]@\n\
+      \            return @[<hov>(%a)@]@,\
-      \        else:@\n\
+      \        else:@,\
-      \            return False@\n\
+      \            return False@,\
-       @\n\
+       @,\
-      \    def __ne__(self, other: object) -> bool:@\n\
+      \    def __ne__(self, other: object) -> bool:@,\
-      \        return not (self == other)@\n\
+      \        return not (self == other)@,\
-       @\n\
+       @,\
-      \    def __str__(self) -> str:@\n\
+      \    def __str__(self) -> str:@,\
       \        @[<hov 4>return \"%a(%a)\".format(%a)@]" (format_struct_name ctx)
       struct_name
       (Format.pp_print_list
@@ -521,9 +508,7 @@ let format_ctx
       (if StructField.Map.is_empty struct_fields then fun fmt _ ->
          Format.fprintf fmt "        pass"
        else
-         Format.pp_print_list
+         Format.pp_print_list (fun fmt (struct_field, _) ->
-           ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
-           (fun fmt (struct_field, _) ->
              Format.fprintf fmt "        self.%a = %a" format_struct_field_name
                struct_field format_struct_field_name struct_field))
       fields (format_struct_name ctx) struct_name
@@ -551,32 +536,30 @@ let format_ctx
       failwith "no constructors in the enum"
     else
       Format.fprintf fmt
-        "@[<hov 4>class %a_Code(Enum):@\n\
+        "@[<v 4>class %a_Code(Enum):@,\
-         %a@]@\n\
+         %a@]@,\
-         @\n\
+         @,\
-         class %a:@\n\
+         class %a:@,\
-        \    def __init__(self, code: %a_Code, value: Any) -> None:@\n\
+        \    def __init__(self, code: %a_Code, value: Any) -> None:@,\
-        \        self.code = code@\n\
+        \        self.code = code@,\
-        \        self.value = value@\n\
+        \        self.value = value@,\
-         @\n\
+         @,\
-         @\n\
+         @,\
-        \    def __eq__(self, other: object) -> bool:@\n\
+        \    def __eq__(self, other: object) -> bool:@,\
-        \        if isinstance(other, %a):@\n\
+        \        if isinstance(other, %a):@,\
         \            return self.code == other.code and self.value == \
-         other.value@\n\
+         other.value@,\
-        \        else:@\n\
+        \        else:@,\
-        \            return False@\n\
+        \            return False@,\
-         @\n\
+         @,\
-         @\n\
+         @,\
-        \    def __ne__(self, other: object) -> bool:@\n\
+        \    def __ne__(self, other: object) -> bool:@,\
-        \        return not (self == other)@\n\
+        \        return not (self == other)@,\
-         @\n\
+         @,\
-        \    def __str__(self) -> str:@\n\
+        \    def __str__(self) -> str:@,\
         \        @[<hov 4>return \"{}({})\".format(self.code, self.value)@]"
         (format_enum_name ctx) enum_name
-        (Format.pp_print_list
+        (Format.pp_print_list (fun fmt (i, enum_cons, _enum_cons_type) ->
-           ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
-           (fun fmt (i, enum_cons, _enum_cons_type) ->
              Format.fprintf fmt "%a = %d" format_enum_cons_name enum_cons i))
         (List.mapi
            (fun i (x, y) -> i, x, y)
@@ -606,11 +589,11 @@ let format_ctx
       match struct_or_enum with
       | Scopelang.Dependency.TVertex.Struct s ->
         if StructName.path s = [] then
-          Format.fprintf fmt "%a@\n@\n" format_struct_decl
+          Format.fprintf fmt "%a@,@," format_struct_decl
             (s, StructName.Map.find s ctx.decl_ctx.ctx_structs)
       | Scopelang.Dependency.TVertex.Enum e ->
         if EnumName.path e = [] then
-          Format.fprintf fmt "%a@\n@\n" format_enum_decl
+          Format.fprintf fmt "%a@,@," format_enum_decl
             (e, EnumName.Map.find e ctx.decl_ctx.ctx_enums))
     (type_ordering @ scope_structs)
 
@@ -626,14 +609,15 @@ let reserve_func_name = function
 
 let format_code_item ctx fmt = function
   | SVar { var; expr; typ = _ } ->
-    Format.fprintf fmt "@[<hv 4>%a = (@,%a@,@])@," format_var var
+    Format.fprintf fmt "@[<hv 4>%a = (@,%a@;<0 -4>)@]@," format_var var
       (format_expression ctx) expr
   | SFunc { var; func }
   | SScope { scope_body_var = var; scope_body_func = func; _ } ->
     let { Ast.func_params; Ast.func_body; _ } = func in
-    Format.fprintf fmt "@[<hv 4>def %a(%a):@\n%a@]@," format_func_name var
+    Format.fprintf fmt "@[<v 4>@[<hov 2>def %a(@,%a@;<0 -2>):@]@ %a@]@,"
+      format_func_name var
       (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
+         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
          (fun fmt (var, typ) ->
            Format.fprintf fmt "%a:%a" format_var (Mark.remove var)
              (format_typ ctx) typ))

compiler/scalc/to_r.ml

@@ -103,8 +103,7 @@ let format_op (fmt : Format.formatter) (op : operator Mark.pos) : unit =
   | Reduce -> Format.pp_print_string fmt "catala_list_reduce"
   | Filter -> Format.pp_print_string fmt "catala_list_filter"
   | Fold -> Format.pp_print_string fmt "catala_list_fold_left"
-  | HandleDefault -> Format.pp_print_string fmt "catala_handle_default"
+  | HandleExceptions | FromClosureEnv | ToClosureEnv -> failwith "unimplemented"
-  | HandleDefaultOpt | FromClosureEnv | ToClosureEnv -> failwith "unimplemented"
 
 let format_string_list (fmt : Format.formatter) (uids : string list) : unit =
   let sanitize_quotes = Re.compile (Re.char '"') in
@@ -319,36 +318,20 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
         args = [arg1];
       } ->
     Format.fprintf fmt "%a %a" format_op op (format_expression ctx) arg1
+  | EAppOp { op = HandleExceptions, _ as op; args = [EArray el, _] as args } ->
+    Format.fprintf fmt
+      "%a(%a, %a)@]"
+      format_op op
+      (Format.pp_print_list
+         ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
+         format_position)
+      (List.map Mark.get el)
+      (Format.pp_print_list
+         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
+         (format_expression ctx))
+      args
   | EAppOp { op; args = [arg1] } ->
     Format.fprintf fmt "%a(%a)" format_op op (format_expression ctx) arg1
-  | EAppOp { op = HandleDefaultOpt, _; _ } ->
-    Message.error ~internal:true
-      "R compilation does not currently support the avoiding of exceptions"
-  | EAppOp { op = (HandleDefault as op), _; args; _ } ->
-    let pos = Mark.get e in
-    Format.fprintf fmt
-      "%a(@[<hov 0>catala_position(filename=\"%s\",@ start_line=%d,@ \
-       start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)@]"
-      format_op (op, pos) (Pos.get_file pos) (Pos.get_start_line pos)
-      (Pos.get_start_column pos) (Pos.get_end_line pos) (Pos.get_end_column pos)
-      format_string_list (Pos.get_law_info pos)
-      (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
-         (format_expression ctx))
-      args
-  | EApp { f = EFunc x, pos; args }
-    when Ast.FuncName.compare x Ast.handle_default = 0
-         || Ast.FuncName.compare x Ast.handle_default_opt = 0 ->
-    Format.fprintf fmt
-      "%a(@[<hov 0>catala_position(filename=\"%s\",@ start_line=%d,@ \
-       start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)@]"
-      format_func_name x (Pos.get_file pos) (Pos.get_start_line pos)
-      (Pos.get_start_column pos) (Pos.get_end_line pos) (Pos.get_end_column pos)
-      format_string_list (Pos.get_law_info pos)
-      (Format.pp_print_list
-         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
-         (format_expression ctx))
-      args
   | EApp { f; args } ->
     Format.fprintf fmt "%a(@[<hov 0>%a)@]" (format_expression ctx) f
       (Format.pp_print_list

compiler/shared_ast/boundList.ml

@@ -20,6 +20,13 @@ type ('e, 'elt, 'last) t = ('e, 'elt, 'last) bound_list =
   | Last of 'last
   | Cons of 'elt * ('e, ('e, 'elt, 'last) t) binder
 
+let rec to_seq = function
+  | Last () -> Seq.empty
+  | Cons (item, next_bind) ->
+    fun () ->
+      let v, next = Bindlib.unbind next_bind in
+      Seq.Cons ((v, item), to_seq next)
+
 let rec last = function
   | Last e -> e
   | Cons (_, bnd) ->

compiler/shared_ast/boundList.mli

@@ -30,6 +30,7 @@ type ('e, 'elt, 'last) t = ('e, 'elt, 'last) bound_list =
   | Last of 'last
   | Cons of 'elt * ('e, ('e, 'elt, 'last) t) binder
 
+val to_seq : (((_, _) gexpr as 'e), 'elt, unit) t -> ('e Var.t * 'elt) Seq.t
 val last : (_, _, 'a) t -> 'a
 val iter : f:('e Var.t -> 'elt -> unit) -> ('e, 'elt, 'last) t -> 'last
 val find : f:('elt -> 'a option) -> (_, 'elt, _) t -> 'a

compiler/shared_ast/definitions.ml

@@ -138,7 +138,6 @@ type desugared =
   ; explicitScopes : yes
   ; assertions : no
   ; defaultTerms : yes
-  ; exceptions : no
   ; custom : no >
 (* Technically, desugared before name resolution has [syntacticNames: yes;
    resolvedNames: no], and after name resolution has the opposite; but the
@@ -159,7 +158,6 @@ type scopelang =
   ; explicitScopes : yes
   ; assertions : no
   ; defaultTerms : yes
-  ; exceptions : no
   ; custom : no >
 
 type dcalc =
@@ -173,7 +171,6 @@ type dcalc =
   ; explicitScopes : no
   ; assertions : yes
   ; defaultTerms : yes
-  ; exceptions : no
   ; custom : no >
 
 type lcalc =
@@ -187,7 +184,6 @@ type lcalc =
   ; explicitScopes : no
   ; assertions : yes
   ; defaultTerms : no
-  ; exceptions : yes
   ; custom : no >
 
 type 'a any = < .. > as 'a
@@ -206,12 +202,11 @@ type dcalc_lcalc_features =
   ; assertions : yes >
 (** Features that are common to Dcalc and Lcalc *)
 
-type ('a, 'b) dcalc_lcalc =
+type 'd dcalc_lcalc = < dcalc_lcalc_features ; defaultTerms : 'd ; custom : no >
-  < dcalc_lcalc_features ; defaultTerms : 'a ; exceptions : 'b ; custom : no >
 (** This type regroups Dcalc and Lcalc ASTs. *)
 
-type ('a, 'b, 'c) interpr_kind =
+type ('d, 'c) interpr_kind =
-  < dcalc_lcalc_features ; defaultTerms : 'a ; exceptions : 'b ; custom : 'c >
+  < dcalc_lcalc_features ; defaultTerms : 'd ; custom : 'c >
 (** This type corresponds to the types handled by the interpreter: it regroups
     Dcalc and Lcalc ASTs and may have custom terms *)
 
@@ -372,8 +367,7 @@ module Op = struct
     (* * polymorphic *)
     | Reduce : < polymorphic ; .. > t
     | Fold : < polymorphic ; .. > t
-    | HandleDefault : < polymorphic ; .. > t
+    | HandleExceptions : < polymorphic ; .. > t
-    | HandleDefaultOpt : < polymorphic ; .. > t
 end
 
 type 'a operator = 'a Op.t
@@ -563,13 +557,6 @@ and ('a, 'b, 'm) base_gexpr =
   | EErrorOnEmpty :
       ('a, 'm) gexpr
       -> ('a, < defaultTerms : yes ; .. >, 'm) base_gexpr
-  (* Lambda calculus with exceptions *)
-  | ERaiseEmpty : ('a, < exceptions : yes ; .. >, 'm) base_gexpr
-  | ECatchEmpty : {
-      body : ('a, 'm) gexpr;
-      handler : ('a, 'm) gexpr;
-    }
-      -> ('a, < exceptions : yes ; .. >, 'm) base_gexpr
   (* Only used during evaluation *)
   | ECustom : {
       obj : Obj.t;

compiler/shared_ast/expr.ml

@@ -145,10 +145,6 @@ let eifthenelse cond etrue efalse =
 
 let eerroronempty e1 = Box.app1 e1 @@ fun e1 -> EErrorOnEmpty e1
 let eempty mark = Mark.add mark (Bindlib.box EEmpty)
-let eraiseempty mark = Mark.add mark (Bindlib.box ERaiseEmpty)
-
-let ecatchempty body handler =
-  Box.app2 body handler @@ fun body handler -> ECatchEmpty { body; handler }
 
 let ecustom obj targs tret mark =
   Mark.add mark (Bindlib.box (ECustom { obj; targs; tret }))
@@ -333,8 +329,6 @@ let map
   | EPureDefault e1 -> epuredefault (f e1) m
   | EEmpty -> eempty m
   | EErrorOnEmpty e1 -> eerroronempty (f e1) m
-  | ECatchEmpty { body; handler } -> ecatchempty (f body) (f handler) m
-  | ERaiseEmpty -> eraiseempty m
   | ELocation loc -> elocation loc m
   | EStruct { name; fields } ->
     let fields = StructField.Map.map f fields in
@@ -365,9 +359,7 @@ let shallow_fold
     (acc : 'acc) : 'acc =
   let lfold x acc = List.fold_left (fun acc x -> f x acc) acc x in
   match Mark.remove e with
-  | ELit _ | EVar _ | EFatalError _ | EExternal _ | ERaiseEmpty | ELocation _
+  | ELit _ | EVar _ | EFatalError _ | EExternal _ | ELocation _ | EEmpty -> acc
-  | EEmpty ->
-    acc
   | EApp { f = e; args; _ } -> acc |> f e |> lfold args
   | EAppOp { args; _ } -> acc |> lfold args
   | EArray args -> acc |> lfold args
@@ -382,7 +374,6 @@ let shallow_fold
   | EDefault { excepts; just; cons } -> acc |> lfold excepts |> f just |> f cons
   | EPureDefault e -> acc |> f e
   | EErrorOnEmpty e -> acc |> f e
-  | ECatchEmpty { body; handler } -> acc |> f body |> f handler
   | EStruct { fields; _ } -> acc |> StructField.Map.fold (fun _ -> f) fields
   | EDStructAmend { e; fields; _ } ->
     acc |> f e |> Ident.Map.fold (fun _ -> f) fields
@@ -460,11 +451,6 @@ let map_gather
   | EErrorOnEmpty e ->
     let acc, e = f e in
     acc, eerroronempty e m
-  | ECatchEmpty { body; handler } ->
-    let acc1, body = f body in
-    let acc2, handler = f handler in
-    join acc1 acc2, ecatchempty body handler m
-  | ERaiseEmpty -> acc, eraiseempty m
   | ELocation loc -> acc, elocation loc m
   | EStruct { name; fields } ->
     let acc, fields =
@@ -532,7 +518,7 @@ let untype e = map_marks ~f:(fun m -> Untyped { pos = mark_pos m }) e
 
 let is_value (type a) (e : (a, _) gexpr) =
   match Mark.remove e with
-  | ELit _ | EAbs _ | ERaiseEmpty | ECustom _ | EExternal _ -> true
+  | ELit _ | EAbs _ | ECustom _ | EExternal _ -> true
   | _ -> false
 
 let equal_lit (l1 : lit) (l2 : lit) =
@@ -664,10 +650,6 @@ and equal : type a. (a, 't) gexpr -> (a, 't) gexpr -> bool =
     equal if1 if2 && equal then1 then2 && equal else1 else2
   | EEmpty, EEmpty -> true
   | EErrorOnEmpty e1, EErrorOnEmpty e2 -> equal e1 e2
-  | ERaiseEmpty, ERaiseEmpty -> true
-  | ( ECatchEmpty { body = etry1; handler = ewith1 },
-      ECatchEmpty { body = etry2; handler = ewith2 } ) ->
-    equal etry1 etry2 && equal ewith1 ewith2
   | ELocation l1, ELocation l2 ->
     equal_location (Mark.add Pos.no_pos l1) (Mark.add Pos.no_pos l2)
   | ( EStruct { name = s1; fields = fields1 },
@@ -700,10 +682,9 @@ and equal : type a. (a, 't) gexpr -> (a, 't) gexpr -> bool =
     Type.equal_list targs1 targs2 && Type.equal tret1 tret2 && obj1 == obj2
   | ( ( EVar _ | EExternal _ | ETuple _ | ETupleAccess _ | EArray _ | ELit _
       | EAbs _ | EApp _ | EAppOp _ | EAssert _ | EFatalError _ | EDefault _
-      | EPureDefault _ | EIfThenElse _ | EEmpty | EErrorOnEmpty _ | ERaiseEmpty
+      | EPureDefault _ | EIfThenElse _ | EEmpty | EErrorOnEmpty _ | ELocation _
-      | ECatchEmpty _ | ELocation _ | EStruct _ | EDStructAmend _
+      | EStruct _ | EDStructAmend _ | EDStructAccess _ | EStructAccess _
-      | EDStructAccess _ | EStructAccess _ | EInj _ | EMatch _ | EScopeCall _
+      | EInj _ | EMatch _ | EScopeCall _ | ECustom _ ),
-      | ECustom _ ),
       _ ) ->
     false
 
@@ -796,11 +777,6 @@ let rec compare : type a. (a, _) gexpr -> (a, _) gexpr -> int =
   | EEmpty, EEmpty -> 0
   | EErrorOnEmpty e1, EErrorOnEmpty e2 ->
     compare e1 e2
-  | ERaiseEmpty, ERaiseEmpty -> 0
-  | ECatchEmpty {body=etry1; handler=ewith1},
-    ECatchEmpty {body=etry2; handler=ewith2} ->
-    compare etry1 etry2 @@< fun () ->
-    compare ewith1 ewith2
   | ECustom _, _ | _, ECustom _ ->
     (* fixme: ideally this would be forbidden by typing *)
     invalid_arg "Custom block comparison"
@@ -827,9 +803,7 @@ let rec compare : type a. (a, _) gexpr -> (a, _) gexpr -> int =
   | EDefault _, _ -> -1 | _, EDefault _ -> 1
   | EPureDefault _, _ -> -1 | _, EPureDefault _ -> 1
   | EEmpty , _ -> -1 | _, EEmpty  -> 1
-  | EErrorOnEmpty _, _ -> -1 | _, EErrorOnEmpty _ -> 1
+  | EErrorOnEmpty _, _ -> . | _, EErrorOnEmpty _ -> .
-  | ERaiseEmpty, _ -> -1 | _, ERaiseEmpty -> 1
-  | ECatchEmpty _, _ -> . | _, ECatchEmpty _ -> .
 
 let rec free_vars : ('a, 't) gexpr -> ('a, 't) gexpr Var.Set.t = function
   | EVar v, _ -> Var.Set.singleton v
@@ -960,8 +934,6 @@ let rec size : type a. (a, 't) gexpr -> int =
       (fun acc except -> acc + size except)
       (1 + size just + size cons)
       excepts
-  | ERaiseEmpty -> 1
-  | ECatchEmpty { body; handler } -> 1 + size body + size handler
   | ELocation _ -> 1
   | EStruct { fields; _ } ->
     StructField.Map.fold (fun _ e acc -> acc + 1 + size e) fields 0

compiler/shared_ast/expr.mli

@@ -117,13 +117,6 @@ val eerroronempty :
   'm mark ->
   ((< defaultTerms : yes ; .. > as 'a), 'm) boxed_gexpr
 
-val ecatchempty :
-  ('a, 'm) boxed_gexpr ->
-  ('a, 'm) boxed_gexpr ->
-  'm mark ->
-  ((< exceptions : yes ; .. > as 'a), 'm) boxed_gexpr
-
-val eraiseempty : 'm mark -> (< exceptions : yes ; .. >, 'm) boxed_gexpr
 val elocation : 'a glocation -> 'm mark -> ((< .. > as 'a), 'm) boxed_gexpr
 
 val estruct :

compiler/shared_ast/interpreter.ml

@@ -422,36 +422,7 @@ let rec evaluate_operator
     ELit (LBool (o_eq_dat_dat x y))
   | Eq_dur_dur, [(ELit (LDuration x), _); (ELit (LDuration y), _)] ->
     ELit (LBool (o_eq_dur_dur (rpos ()) x y))
-  | HandleDefault, [(EArray excepts, _); just; cons] -> (
+  | HandleExceptions, [(EArray exps, _)] -> (
-    (* This case is for lcalc with exceptions: we rely OCaml exception handling
-       here *)
-    match
-      List.filter_map
-        (fun e ->
-          try Some (evaluate_expr (Expr.unthunk_term_nobox e))
-          with Runtime.Empty -> None)
-        excepts
-    with
-    | [] -> (
-      let just = evaluate_expr (Expr.unthunk_term_nobox just) in
-      match Mark.remove just with
-      | ELit (LBool true) ->
-        Mark.remove (evaluate_expr (Expr.unthunk_term_nobox cons))
-      | ELit (LBool false) -> raise Runtime.Empty
-      | _ ->
-        Message.error ~pos
-          "Default justification has not been reduced to a boolean at@ \
-           evaluation@ (should not happen if the term was well-typed@\n\
-           %a@."
-          Expr.format just)
-    | [e] -> Mark.remove e
-    | es ->
-      raise
-        Runtime.(
-          Error
-            (Conflict, List.map (fun e -> Expr.pos_to_runtime (Expr.pos e)) es))
-    )
-  | HandleDefaultOpt, [(EArray exps, _); justification; conclusion] -> (
     let valid_exceptions =
       ListLabels.filter exps ~f:(function
         | EInj { name; cons; _ }, _ when EnumName.equal name Expr.option_enum ->
@@ -459,28 +430,9 @@ let rec evaluate_operator
         | _ -> err ())
     in
     match valid_exceptions with
-    | [] -> (
+    | [] ->
-      let e = evaluate_expr (Expr.unthunk_term_nobox justification) in
+      EInj
-      match Mark.remove e with
+        { name = Expr.option_enum; cons = Expr.none_constr; e = ELit LUnit, m }
-      | ELit (LBool true) ->
-        Mark.remove (evaluate_expr (Expr.unthunk_term_nobox conclusion))
-      | ELit (LBool false) ->
-        EInj
-          {
-            name = Expr.option_enum;
-            cons = Expr.none_constr;
-            e = Mark.copy justification (ELit LUnit);
-          }
-      | EInj { name; cons; e }
-        when EnumName.equal name Expr.option_enum
-             && EnumConstructor.equal cons Expr.none_constr ->
-        EInj
-          {
-            name = Expr.option_enum;
-            cons = Expr.none_constr;
-            e = Mark.copy e (ELit LUnit);
-          }
-      | _ -> err ())
     | [((EInj { cons; name; _ } as e), _)]
       when EnumName.equal name Expr.option_enum
            && EnumConstructor.equal cons Expr.some_constr ->
@@ -501,23 +453,22 @@ let rec evaluate_operator
       | Lte_mon_mon | Lte_dat_dat | Lte_dur_dur | Gt_int_int | Gt_rat_rat
       | Gt_mon_mon | Gt_dat_dat | Gt_dur_dur | Gte_int_int | Gte_rat_rat
       | Gte_mon_mon | Gte_dat_dat | Gte_dur_dur | Eq_int_int | Eq_rat_rat
-      | Eq_mon_mon | Eq_dat_dat | Eq_dur_dur | HandleDefault | HandleDefaultOpt
+      | Eq_mon_mon | Eq_dat_dat | Eq_dur_dur | HandleExceptions ),
-        ),
       _ ) ->
     err ()
 
 (* /S\ dark magic here. This relies both on internals of [Lcalc.to_ocaml] *and*
    of the OCaml runtime *)
 let rec runtime_to_val :
-    type d e.
+    type d.
     (decl_ctx ->
-    ((d, e, _) interpr_kind, 'm) gexpr ->
+    ((d, _) interpr_kind, 'm) gexpr ->
-    ((d, e, _) interpr_kind, 'm) gexpr) ->
+    ((d, _) interpr_kind, 'm) gexpr) ->
     decl_ctx ->
     'm mark ->
     typ ->
     Obj.t ->
-    (((d, e, yes) interpr_kind as 'a), 'm) gexpr =
+    (((d, yes) interpr_kind as 'a), 'm) gexpr =
  fun eval_expr ctx m ty o ->
   let m = Expr.map_ty (fun _ -> ty) m in
   match Mark.remove ty with
@@ -578,21 +529,26 @@ let rec runtime_to_val :
            (Array.to_list (Obj.obj o))),
       m )
   | TArrow (targs, tret) -> ECustom { obj = o; targs; tret }, m
-  | TDefault ty -> runtime_to_val eval_expr ctx m ty o
+  | TDefault ty -> (
+    (* This case is only valid for ASTs including default terms; but the typer
+       isn't aware so we need some additional dark arts. *)
+    match (Obj.obj o : 'a Runtime.Eoption.t) with
+    | Runtime.Eoption.ENone () -> Obj.magic EEmpty, m
+    | Runtime.Eoption.ESome o -> Obj.magic (runtime_to_val eval_expr ctx m ty o)
+    )
   | TAny -> assert false
 
 and val_to_runtime :
-    type d e.
+    type d.
     (decl_ctx ->
-    ((d, e, _) interpr_kind, 'm) gexpr ->
+    ((d, _) interpr_kind, 'm) gexpr ->
-    ((d, e, _) interpr_kind, 'm) gexpr) ->
+    ((d, _) interpr_kind, 'm) gexpr) ->
     decl_ctx ->
     typ ->
-    ((d, e, _) interpr_kind, 'm) gexpr ->
+    ((d, _) interpr_kind, 'm) gexpr ->
     Obj.t =
  fun eval_expr ctx ty v ->
   match Mark.remove ty, Mark.remove v with
-  | _, EEmpty -> raise Runtime.Empty
   | TLit TBool, ELit (LBool b) -> Obj.repr b
   | TLit TUnit, ELit LUnit -> Obj.repr ()
   | TLit TInt, ELit (LInt i) -> Obj.repr i
@@ -659,7 +615,11 @@ and val_to_runtime :
             curry (runtime_to_val eval_expr ctx m targ x :: acc) targs)
     in
     curry [] targs
-  | TDefault ty, _ -> val_to_runtime eval_expr ctx ty v
+  | TDefault ty, _ -> (
+    match v with
+    | EEmpty, _ -> Obj.repr (Runtime.Eoption.ENone ())
+    | EPureDefault e, _ | e ->
+      Obj.repr (Runtime.Eoption.ESome (val_to_runtime eval_expr ctx ty e)))
   | TClosureEnv, v ->
     (* By construction, a closure environment can only be consumed from the same
        scope where it was built (compiled or not) ; for this reason, we can
@@ -671,11 +631,11 @@ and val_to_runtime :
       Expr.format v
 
 let rec evaluate_expr :
-    type d e.
+    type d.
     decl_ctx ->
     Global.backend_lang ->
-    ((d, e, yes) interpr_kind, 't) gexpr ->
+    ((d, yes) interpr_kind, 't) gexpr ->
-    ((d, e, yes) interpr_kind, 't) gexpr =
+    ((d, yes) interpr_kind, 't) gexpr =
  fun ctx lang e ->
   let m = Mark.get e in
   let pos = Expr.mark_pos m in
@@ -875,18 +835,14 @@ let rec evaluate_expr :
       in
       raise Runtime.(Error (Conflict, poslist)))
   | EPureDefault e -> evaluate_expr ctx lang e
-  | ERaiseEmpty -> raise Runtime.Empty
-  | ECatchEmpty { body; handler } -> (
-    try evaluate_expr ctx lang body
-    with Runtime.Empty -> evaluate_expr ctx lang handler)
   | _ -> .
 
 and partially_evaluate_expr_for_assertion_failure_message :
-    type d e.
+    type d.
     decl_ctx ->
     Global.backend_lang ->
-    ((d, e, yes) interpr_kind, 't) gexpr ->
+    ((d, yes) interpr_kind, 't) gexpr ->
-    ((d, e, yes) interpr_kind, 't) gexpr =
+    ((d, yes) interpr_kind, 't) gexpr =
  fun ctx lang e ->
   (* Here we want to print an expression that explains why an assertion has
      failed. Since assertions have type [bool] and are usually constructed with
@@ -921,11 +877,11 @@ and partially_evaluate_expr_for_assertion_failure_message :
   | _ -> evaluate_expr ctx lang e
 
 let evaluate_expr_trace :
-    type d e.
+    type d.
     decl_ctx ->
     Global.backend_lang ->
-    ((d, e, yes) interpr_kind, 't) gexpr ->
+    ((d, yes) interpr_kind, 't) gexpr ->
-    ((d, e, yes) interpr_kind, 't) gexpr =
+    ((d, yes) interpr_kind, 't) gexpr =
  fun ctx lang e ->
   Fun.protect
     (fun () -> evaluate_expr ctx lang e)
@@ -937,11 +893,11 @@ let evaluate_expr_trace :
            (Runtime.EventParser.parse_raw_events trace)] fais here, check why *))
 
 let evaluate_expr_safe :
-    type d e.
+    type d.
     decl_ctx ->
     Global.backend_lang ->
-    ((d, e, yes) interpr_kind, 't) gexpr ->
+    ((d, yes) interpr_kind, 't) gexpr ->
-    ((d, e, yes) interpr_kind, 't) gexpr =
+    ((d, yes) interpr_kind, 't) gexpr =
  fun ctx lang e ->
   try evaluate_expr_trace ctx lang e
   with Runtime.Error (err, rpos) ->
@@ -953,9 +909,9 @@ let evaluate_expr_safe :
 (* Typing shenanigan to add custom terms to the AST type. *)
 let addcustom e =
   let rec f :
-      type c d e.
+      type c d.
-      ((d, e, c) interpr_kind, 't) gexpr ->
+      ((d, c) interpr_kind, 't) gexpr -> ((d, yes) interpr_kind, 't) gexpr boxed
-      ((d, e, yes) interpr_kind, 't) gexpr boxed = function
+      = function
     | (ECustom _, _) as e -> Expr.map ~f e
     | EAppOp { op; tys; args }, m ->
       Expr.eappop ~tys ~args:(List.map f args) ~op:(Operator.translate op) m
@@ -963,8 +919,6 @@ let addcustom e =
     | (EPureDefault _, _) as e -> Expr.map ~f e
     | (EEmpty, _) as e -> Expr.map ~f e
     | (EErrorOnEmpty _, _) as e -> Expr.map ~f e
-    | (ECatchEmpty _, _) as e -> Expr.map ~f e
-    | (ERaiseEmpty, _) as e -> Expr.map ~f e
     | ( ( EAssert _ | EFatalError _ | ELit _ | EApp _ | EArray _ | EVar _
         | EExternal _ | EAbs _ | EIfThenElse _ | ETuple _ | ETupleAccess _
         | EInj _ | EStruct _ | EStructAccess _ | EMatch _ ),
@@ -974,8 +928,8 @@ let addcustom e =
   in
   let open struct
     external id :
-      (('d, 'e, 'c) interpr_kind, 't) gexpr ->
+      (('d, 'c) interpr_kind, 't) gexpr -> (('d, yes) interpr_kind, 't) gexpr
-      (('d, 'e, yes) interpr_kind, 't) gexpr = "%identity"
+      = "%identity"
   end in
   if false then Expr.unbox (f e)
     (* We keep the implementation as a typing proof, but bypass the AST
@@ -985,9 +939,9 @@ let addcustom e =
 
 let delcustom e =
   let rec f :
-      type c d e.
+      type c d.
-      ((d, e, c) interpr_kind, 't) gexpr ->
+      ((d, c) interpr_kind, 't) gexpr -> ((d, no) interpr_kind, 't) gexpr boxed
-      ((d, e, no) interpr_kind, 't) gexpr boxed = function
+      = function
     | ECustom _, _ -> invalid_arg "Custom term remaining in evaluated term"
     | EAppOp { op; args; tys }, m ->
       Expr.eappop ~tys ~args:(List.map f args) ~op:(Operator.translate op) m
@@ -995,8 +949,6 @@ let delcustom e =
     | (EPureDefault _, _) as e -> Expr.map ~f e
     | (EEmpty, _) as e -> Expr.map ~f e
     | (EErrorOnEmpty _, _) as e -> Expr.map ~f e
-    | (ECatchEmpty _, _) as e -> Expr.map ~f e
-    | (ERaiseEmpty, _) as e -> Expr.map ~f e
     | ( ( EAssert _ | EFatalError _ | ELit _ | EApp _ | EArray _ | EVar _
         | EExternal _ | EAbs _ | EIfThenElse _ | ETuple _ | ETupleAccess _
         | EInj _ | EStruct _ | EStructAccess _ | EMatch _ ),
@@ -1027,22 +979,13 @@ let interpret_program_lcalc p s : (Uid.MarkedString.info * ('a, 'm) gexpr) list
         (fun ty ->
           match Mark.remove ty with
           | TArrow (ty_in, (TOption _, _)) ->
-            (* Context args may return an option if avoid_exceptions is on *)
+            (* Context args should return an option *)
             Expr.make_abs
               (Array.of_list @@ List.map (fun _ -> Var.make "_") ty_in)
               (Expr.einj ~e:(Expr.elit LUnit mark_e) ~cons:Expr.none_constr
                  ~name:Expr.option_enum mark_e
                 : (_, _) boxed_gexpr)
               ty_in pos
-          | TArrow (ty_in, ty_out) ->
-            (* Or a default term (translated into a plain one if it is off) *)
-            (* Note: this might catch non-context args, but since the
-               compilation to lcalc strips the default around [ty_out] we can't
-               tell with just this info. *)
-            Expr.make_abs
-              (Array.of_list @@ List.map (fun _ -> Var.make "_") ty_in)
-              (Expr.eraiseempty (Expr.with_ty mark_e ty_out))
-              ty_in (Expr.mark_pos mark_e)
           | TTuple ((TArrow (ty_in, (TOption _, _)), _) :: _) ->
             (* ... or a closure if closure conversion is enabled *)
             Expr.make_tuple

compiler/shared_ast/interpreter.mli

@@ -21,7 +21,7 @@ open Catala_utils
 open Definitions
 
 val evaluate_operator :
-  ((((_, _, _) interpr_kind as 'a), 'm) gexpr -> ('a, 'm) gexpr) ->
+  ((((_, _) interpr_kind as 'a), 'm) gexpr -> ('a, 'm) gexpr) ->
   'a operator Mark.pos ->
   'm mark ->
   Global.backend_lang ->
@@ -35,14 +35,14 @@ val evaluate_operator :
 val evaluate_expr :
   decl_ctx ->
   Global.backend_lang ->
-  (('a, 'b, _) interpr_kind, 'm) gexpr ->
+  (('a, _) interpr_kind, 'm) gexpr ->
-  (('a, 'b, yes) interpr_kind, 'm) gexpr
+  (('a, yes) interpr_kind, 'm) gexpr
 (** Evaluates an expression according to the semantics of the default calculus. *)
 
 val interpret_program_dcalc :
   (dcalc, 'm) gexpr program ->
   ScopeName.t ->
-  (Uid.MarkedString.info * ((yes, no, yes) interpr_kind, 'm) gexpr) list
+  (Uid.MarkedString.info * ((yes, yes) interpr_kind, 'm) gexpr) list
 (** Interprets a program. This function expects an expression typed as a
     function whose argument are all thunked. The function is executed by
     providing for each argument a thunked empty default. Returns a list of all
@@ -51,14 +51,14 @@ val interpret_program_dcalc :
 val interpret_program_lcalc :
   (lcalc, 'm) gexpr program ->
   ScopeName.t ->
-  (Uid.MarkedString.info * ((no, yes, yes) interpr_kind, 'm) gexpr) list
+  (Uid.MarkedString.info * ((no, yes) interpr_kind, 'm) gexpr) list
 (** Interprets a program. This function expects an expression typed as a
     function whose argument are all thunked. The function is executed by
     providing for each argument a thunked empty default. Returns a list of all
     the computed values for the scope variables of the executed scope. *)
 
 val delcustom :
-  (('a, 'b, 'c) interpr_kind, 'm) gexpr -> (('a, 'b, no) interpr_kind, 'm) gexpr
+  (('a, 'b) interpr_kind, 'm) gexpr -> (('a, no) interpr_kind, 'm) gexpr
 (** Runtime check that the term contains no custom terms (raises
     [Invalid_argument] if that is the case *)
 

compiler/shared_ast/operator.ml

@@ -108,8 +108,7 @@ let name : type a. a t -> string = function
   | Eq_dur_dur -> "o_eq_dur_dur"
   | Eq_dat_dat -> "o_eq_dat_dat"
   | Fold -> "o_fold"
-  | HandleDefault -> "o_handledefault"
+  | HandleExceptions -> "handle_exceptions"
-  | HandleDefaultOpt -> "o_handledefaultopt"
   | ToClosureEnv -> "o_toclosureenv"
   | FromClosureEnv -> "o_fromclosureenv"
 
@@ -232,8 +231,7 @@ let compare (type a1 a2) (t1 : a1 t) (t2 : a2 t) =
   | Eq_dat_dat, Eq_dat_dat
   | Eq_dur_dur, Eq_dur_dur
   | Fold, Fold
-  | HandleDefault, HandleDefault
+  | HandleExceptions, HandleExceptions
-  | HandleDefaultOpt, HandleDefaultOpt
   | FromClosureEnv, FromClosureEnv | ToClosureEnv, ToClosureEnv -> 0
   | Not, _ -> -1 | _, Not -> 1
   | Length, _ -> -1 | _, Length -> 1
@@ -318,8 +316,7 @@ let compare (type a1 a2) (t1 : a1 t) (t2 : a2 t) =
   | Eq_mon_mon, _ -> -1 | _, Eq_mon_mon -> 1
   | Eq_dat_dat, _ -> -1 | _, Eq_dat_dat -> 1
   | Eq_dur_dur, _ -> -1 | _, Eq_dur_dur -> 1
-  | HandleDefault, _ -> -1 | _, HandleDefault -> 1
+  | HandleExceptions, _ -> -1 | _, HandleExceptions -> 1
-  | HandleDefaultOpt, _ -> -1 | _, HandleDefaultOpt -> 1
   | FromClosureEnv, _ -> -1 | _, FromClosureEnv -> 1
   | ToClosureEnv, _ -> -1 | _, ToClosureEnv -> 1
   | Fold, _  | _, Fold -> .
@@ -344,7 +341,7 @@ let kind_dispatch :
       _ ) as op ->
     monomorphic op
   | ( ( Log _ | Length | Eq | Map | Map2 | Concat | Filter | Reduce | Fold
-      | HandleDefault | HandleDefaultOpt | FromClosureEnv | ToClosureEnv ),
+      | HandleExceptions | FromClosureEnv | ToClosureEnv ),
       _ ) as op ->
     polymorphic op
   | ( ( Minus | ToRat | ToMoney | Round | Add | Sub | Mult | Div | Lt | Lte | Gt
@@ -377,19 +374,19 @@ type 'a no_overloads =
 let translate (t : 'a no_overloads t Mark.pos) : 'b no_overloads t Mark.pos =
   match t with
   | ( ( Not | GetDay | GetMonth | GetYear | FirstDayOfMonth | LastDayOfMonth
-      | And | Or | Xor | HandleDefault | HandleDefaultOpt | Log _ | Length | Eq
+      | And | Or | Xor | HandleExceptions | Log _ | Length | Eq | Map | Map2
-      | Map | Map2 | Concat | Filter | Reduce | Fold | Minus_int | Minus_rat
+      | Concat | Filter | Reduce | Fold | Minus_int | Minus_rat | Minus_mon
-      | Minus_mon | Minus_dur | ToRat_int | ToRat_mon | ToMoney_rat | Round_rat
+      | Minus_dur | ToRat_int | ToRat_mon | ToMoney_rat | Round_rat | Round_mon
-      | Round_mon | Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur _
+      | Add_int_int | Add_rat_rat | Add_mon_mon | Add_dat_dur _ | Add_dur_dur
-      | Add_dur_dur | Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat
+      | Sub_int_int | Sub_rat_rat | Sub_mon_mon | Sub_dat_dat | Sub_dat_dur
-      | Sub_dat_dur | Sub_dur_dur | Mult_int_int | Mult_rat_rat | Mult_mon_rat
+      | Sub_dur_dur | Mult_int_int | Mult_rat_rat | Mult_mon_rat | Mult_dur_int
-      | Mult_dur_int | Div_int_int | Div_rat_rat | Div_mon_mon | Div_mon_rat
+      | Div_int_int | Div_rat_rat | Div_mon_mon | Div_mon_rat | Div_dur_dur
-      | Div_dur_dur | Lt_int_int | Lt_rat_rat | Lt_mon_mon | Lt_dat_dat
+      | Lt_int_int | Lt_rat_rat | Lt_mon_mon | Lt_dat_dat | Lt_dur_dur
-      | Lt_dur_dur | Lte_int_int | Lte_rat_rat | Lte_mon_mon | Lte_dat_dat
+      | Lte_int_int | Lte_rat_rat | Lte_mon_mon | Lte_dat_dat | Lte_dur_dur
-      | Lte_dur_dur | Gt_int_int | Gt_rat_rat | Gt_mon_mon | Gt_dat_dat
+      | Gt_int_int | Gt_rat_rat | Gt_mon_mon | Gt_dat_dat | Gt_dur_dur
-      | Gt_dur_dur | Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dat_dat
+      | Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dat_dat | Gte_dur_dur
-      | Gte_dur_dur | Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dat_dat
+      | Eq_int_int | Eq_rat_rat | Eq_mon_mon | Eq_dat_dat | Eq_dur_dur
-      | Eq_dur_dur | FromClosureEnv | ToClosureEnv ),
+      | FromClosureEnv | ToClosureEnv ),
       _ ) as op ->
     op
 

compiler/shared_ast/optimizations.ml

@@ -58,14 +58,14 @@ let all_match_cases_map_to_same_constructor cases n =
 
 let binder_vars_used_at_most_once
     (binder :
-      ( (('a, 'b) dcalc_lcalc, ('a, 'b) dcalc_lcalc, 'm) base_gexpr,
+      ( ('a dcalc_lcalc, 'a dcalc_lcalc, 'm) base_gexpr,
-        (('a, 'b) dcalc_lcalc, 'm) gexpr )
+        ('a dcalc_lcalc, 'm) gexpr )
       Bindlib.mbinder) : bool =
   (* fast path: variables not used at all *)
   (not (Array.exists Fun.id (Bindlib.mbinder_occurs binder)))
   ||
   let vars, body = Bindlib.unmbind binder in
-  let rec vars_count (e : (('a, 'b) dcalc_lcalc, 'm) gexpr) : int array =
+  let rec vars_count (e : ('a dcalc_lcalc, 'm) gexpr) : int array =
     match e with
     | EVar v, _ ->
       Array.map
@@ -82,8 +82,8 @@ let binder_vars_used_at_most_once
 let rec optimize_expr :
     type a b.
     (a, b, 'm) optimizations_ctx ->
-    ((a, b) dcalc_lcalc, 'm) gexpr ->
+    (a dcalc_lcalc, 'm) gexpr ->
-    ((a, b) dcalc_lcalc, 'm) boxed_gexpr =
+    (a dcalc_lcalc, 'm) boxed_gexpr =
  fun ctx e ->
   (* We proceed bottom-up, first apply on the subterms *)
   let e = Expr.map ~f:(optimize_expr ctx) ~op:Fun.id e in
@@ -92,7 +92,7 @@ let rec optimize_expr :
      able to keep the inner position (see the division_by_zero test) *)
   (* Then reduce the parent node (this is applied through Box.apply, therefore
      delayed to unbinding time: no need to be concerned about reboxing) *)
-  let reduce (e : ((a, b) dcalc_lcalc, 'm) gexpr) =
+  let reduce (e : (a dcalc_lcalc, 'm) gexpr) =
     (* Todo: improve the handling of eapp(log,elit) cases here, it obfuscates
        the matches and the log calls are not preserved, which would be a good
        property *)
@@ -365,22 +365,15 @@ let rec optimize_expr :
                 el) ->
       (* identity tuple reconstruction *)
       Mark.remove e
-    | ECatchEmpty { body; handler } -> (
-      (* peephole exception catching reductions *)
-      match Mark.remove body, Mark.remove handler with
-      | ERaiseEmpty, _ -> Mark.remove handler
-      | _, ERaiseEmpty -> Mark.remove body
-      | _ -> ECatchEmpty { body; handler })
     | e -> e
   in
   Expr.Box.app1 e reduce mark
 
 let optimize_expr :
       'm.
-      decl_ctx ->
+      decl_ctx -> ('a dcalc_lcalc, 'm) gexpr -> ('a dcalc_lcalc, 'm) boxed_gexpr
-      (('a, 'b) dcalc_lcalc, 'm) gexpr ->
+    =
-      (('a, 'b) dcalc_lcalc, 'm) boxed_gexpr =
+ fun (decl_ctx : decl_ctx) (e : ('a dcalc_lcalc, 'm) gexpr) ->
- fun (decl_ctx : decl_ctx) (e : (('a, 'b) dcalc_lcalc, 'm) gexpr) ->
   optimize_expr { decl_ctx } e
 
 let optimize_program (p : 'm program) : 'm program =

compiler/shared_ast/optimizations.mli

@@ -21,13 +21,10 @@
 open Definitions
 
 val optimize_expr :
-  decl_ctx ->
+  decl_ctx -> ('a dcalc_lcalc, 'm) gexpr -> ('a dcalc_lcalc, 'm) boxed_gexpr
-  (('a, 'b) dcalc_lcalc, 'm) gexpr ->
-  (('a, 'b) dcalc_lcalc, 'm) boxed_gexpr
 
 val optimize_program :
-  (('a, 'b) dcalc_lcalc, 'm) gexpr program ->
+  ('a dcalc_lcalc, 'm) gexpr program -> ('a dcalc_lcalc, 'm) gexpr program
-  (('a, 'b) dcalc_lcalc, 'm) gexpr program
 
 (** {1 Tests}*)
 

compiler/shared_ast/print.ml

@@ -142,7 +142,7 @@ let rec typ_gen
                mty))
         def punctuation "]")
   | TOption t ->
-    Format.fprintf fmt "@[<hov 2>%a@ %a@]" base_type "eoption" (typ ~colors) t
+    Format.fprintf fmt "@[<hov 2>%a@ %a@]" base_type "option" (typ ~colors) t
   | TArrow ([t1], t2) ->
     Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@]" (typ_with_parens ~colors) t1
       op_style "→" (typ ~colors) t2
@@ -280,8 +280,7 @@ let operator_to_string : type a. a Op.t -> string =
   | Eq_dur_dur -> "=^"
   | Eq_dat_dat -> "=@"
   | Fold -> "fold"
-  | HandleDefault -> "handle_default"
+  | HandleExceptions -> "handle_exceptions"
-  | HandleDefaultOpt -> "handle_default_opt"
   | ToClosureEnv -> "to_closure_env"
   | FromClosureEnv -> "from_closure_env"
 
@@ -325,8 +324,7 @@ let operator_to_shorter_string : type a. a Op.t -> string =
   | Gte_int_int | Gte_rat_rat | Gte_mon_mon | Gte_dur_dur | Gte_dat_dat | Gte ->
     ">="
   | Fold -> "fold"
-  | HandleDefault -> "handle_default"
+  | HandleExceptions -> "handle_exceptions"
-  | HandleDefaultOpt -> "handle_default_opt"
   | ToClosureEnv -> "to_closure_env"
   | FromClosureEnv -> "from_closure_env"
 
@@ -402,8 +400,8 @@ module Precedence = struct
       | Div | Div_int_int | Div_rat_rat | Div_mon_rat | Div_mon_mon
       | Div_dur_dur ->
         Op Div
-      | HandleDefault | HandleDefaultOpt | Map | Map2 | Concat | Filter | Reduce
+      | HandleExceptions | Map | Map2 | Concat | Filter | Reduce | Fold
-      | Fold | ToClosureEnv | FromClosureEnv ->
+      | ToClosureEnv | FromClosureEnv ->
         App)
     | EApp _ -> App
     | EArray _ -> Contained
@@ -426,8 +424,6 @@ module Precedence = struct
     | EPureDefault _ -> Contained
     | EEmpty -> Contained
     | EErrorOnEmpty _ -> App
-    | ERaiseEmpty -> App
-    | ECatchEmpty _ -> App
     | ECustom _ -> Contained
 
   let needs_parens ~context ?(rhs = false) e =
@@ -671,12 +667,6 @@ module ExprGen (C : EXPR_PARAM) = struct
       | EFatalError err ->
         Format.fprintf fmt "@[<hov 2>%a@ @{<red>%s@}@]" keyword "error"
           (Runtime.error_to_string err)
-      | ECatchEmpty { body; handler } ->
-        Format.fprintf fmt
-          "@[<hv 0>@[<hov 2>%a@ %a@]@ @[<hov 2>%a@ %a ->@ %a@]@]" keyword "try"
-          expr body keyword "with" op_style "Empty" (rhs exprc) handler
-      | ERaiseEmpty ->
-        Format.fprintf fmt "@[<hov 2>%a@ %a@]" keyword "raise" op_style "Empty"
       | ELocation loc -> location fmt loc
       | EDStructAccess { e; field; _ } ->
         Format.fprintf fmt "@[<hv 2>%a%a@,%a%a%a@]" (lhs exprc) e punctuation
@@ -712,7 +702,6 @@ module ExprGen (C : EXPR_PARAM) = struct
         Format.fprintf fmt "@[<v 0>@[<hv 2>%a@ %a@;<1 -2>%a@]@ %a@]" keyword
           "match" (lhs exprc) e keyword "with"
           (EnumConstructor.Map.format_bindings
-             ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
              (fun fmt pp_cons_name case_expr ->
                match case_expr with
                | EAbs { binder; tys; _ }, _ ->
@@ -868,13 +857,12 @@ let enum
     fmt
     (pp_name : Format.formatter -> unit)
     (c : typ EnumConstructor.Map.t) =
-  Format.fprintf fmt "@[<h 0>%a %t %a@ %a@]" keyword "type" pp_name punctuation
+  Format.fprintf fmt "@[<h 0>%a %t %a@ %a@]@," keyword "type" pp_name
-    "="
+    punctuation "="
-    (EnumConstructor.Map.format_bindings
+    (EnumConstructor.Map.format_bindings ~pp_sep:Format.pp_print_space
-       ~pp_sep:(fun _ _ -> ())
        (fun fmt pp_n ty ->
-         Format.fprintf fmt "@[<hov2> %a %t %a %a@]@;" punctuation "|" pp_n
+         Format.fprintf fmt "@[<hov2>%a %t %a %a@]" punctuation "|" pp_n keyword
-           keyword "of"
+           "of"
            (if debug then typ_debug else typ decl_ctx)
            ty))
     c
@@ -897,14 +885,10 @@ let struct_
 let decl_ctx ?(debug = false) decl_ctx (fmt : Format.formatter) (ctx : decl_ctx)
     : unit =
   let { ctx_enums; ctx_structs; _ } = ctx in
-  Format.fprintf fmt "%a@.%a@.@."
+  Format.fprintf fmt "@[<v>%a@,%a@,@,@]"
-    (EnumName.Map.format_bindings
+    (EnumName.Map.format_bindings (enum ~debug decl_ctx))
-       ~pp_sep:(fun fmt () -> Format.fprintf fmt "@.")
-       (enum ~debug decl_ctx))
     ctx_enums
-    (StructName.Map.format_bindings
+    (StructName.Map.format_bindings (struct_ ~debug decl_ctx))
-       ~pp_sep:(fun fmt () -> Format.fprintf fmt "@.")
-       (struct_ ~debug decl_ctx))
     ctx_structs
 
 let scope
@@ -936,11 +920,15 @@ let code_item ?(debug = false) ?name decl_ctx fmt c =
       "=" (expr ~debug ()) e
 
 let code_item_list ?(debug = false) decl_ctx fmt c =
-  BoundList.iter c ~f:(fun x item ->
+  Format.pp_open_vbox fmt 0;
+  Format.pp_print_seq
+    (fun fmt (x, item) ->
       code_item ~debug
         ~name:(Format.asprintf "%a" var_debug x)
         decl_ctx fmt item;
-      Format.pp_print_newline fmt ())
+      Format.pp_print_cut fmt ())
+    fmt (BoundList.to_seq c);
+  Format.pp_close_box fmt ()
 
 let program ?(debug = false) fmt p =
   decl_ctx ~debug p.decl_ctx fmt p.decl_ctx;
@@ -1136,8 +1124,8 @@ module UserFacing = struct
     | EExternal _ -> Format.pp_print_string ppf "<external>"
     | EApp _ | EAppOp _ | EVar _ | EIfThenElse _ | EMatch _ | ETupleAccess _
     | EStructAccess _ | EAssert _ | EFatalError _ | EDefault _ | EPureDefault _
-    | EErrorOnEmpty _ | ERaiseEmpty | ECatchEmpty _ | ELocation _ | EScopeCall _
+    | EErrorOnEmpty _ | ELocation _ | EScopeCall _ | EDStructAmend _
-    | EDStructAmend _ | EDStructAccess _ | ECustom _ ->
+    | EDStructAccess _ | ECustom _ ->
       fallback ppf e
 
   let expr :

compiler/shared_ast/typing.ml

@@ -294,7 +294,6 @@ let polymorphic_op_type (op : Operator.polymorphic A.operator Mark.pos) :
   let any2 = lazy (UnionFind.make (TAny (Any.fresh ()), pos)) in
   let any3 = lazy (UnionFind.make (TAny (Any.fresh ()), pos)) in
   let bt = lazy (UnionFind.make (TLit TBool, pos)) in
-  let ut = lazy (UnionFind.make (TLit TUnit, pos)) in
   let it = lazy (UnionFind.make (TLit TInt, pos)) in
   let cet = lazy (UnionFind.make (TClosureEnv, pos)) in
   let array a = lazy (UnionFind.make (TArray (Lazy.force a), pos)) in
@@ -314,9 +313,7 @@ let polymorphic_op_type (op : Operator.polymorphic A.operator Mark.pos) :
     | Log (PosRecordIfTrueBool, _) -> [bt] @-> bt
     | Log _ -> [any] @-> any
     | Length -> [array any] @-> it
-    | HandleDefault -> [array ([ut] @-> any); [ut] @-> bt; [ut] @-> any] @-> any
+    | HandleExceptions -> [array (option any)] @-> option any
-    | HandleDefaultOpt ->
-      [array (option any); [ut] @-> bt; [ut] @-> option any] @-> option any
     | ToClosureEnv -> [any] @-> cet
     | FromClosureEnv -> [cet] @-> any
   in
@@ -348,7 +345,7 @@ let polymorphic_op_return_type
   | Log (PosRecordIfTrueBool, _), _ -> uf (TLit TBool)
   | Log _, [tau] -> tau
   | Length, _ -> uf (TLit TInt)
-  | (HandleDefault | HandleDefaultOpt), [_; _; tf] -> return_type tf 1
+  | HandleExceptions, [_] -> any ()
   | ToClosureEnv, _ -> uf TClosureEnv
   | FromClosureEnv, _ -> any ()
   | _ -> Message.error ~pos "Mismatched operator arguments"
@@ -760,11 +757,6 @@ and typecheck_expr_top_down :
         args
     in
     Expr.escopecall ~scope ~args:args' mark
-  | A.ERaiseEmpty -> Expr.eraiseempty context_mark
-  | A.ECatchEmpty { body; handler } ->
-    let body' = typecheck_expr_top_down ctx env tau body in
-    let handler' = typecheck_expr_top_down ctx env tau handler in
-    Expr.ecatchempty body' handler' context_mark
   | A.EVar v ->
     let tau' =
       match Env.get env v with
@@ -895,15 +887,17 @@ and typecheck_expr_top_down :
     let args =
       Operator.kind_dispatch (Mark.set pos_e op)
         ~polymorphic:(fun op ->
-          (* Type the operator first, then right-to-left: polymorphic operators
+          if env.flags.assume_op_types then (
-             are required to allow the resolution of all type variables this
+            unify ctx e (polymorphic_op_return_type ctx e op t_args) tau;
-             way *)
+            List.rev_map (typecheck_expr_bottom_up ctx env) (List.rev args))
-          if not env.flags.assume_op_types then
+          else (
-            unify ctx e (polymorphic_op_type op) t_func
+            (* Type the operator first, then right-to-left: polymorphic
-          else unify ctx e (polymorphic_op_return_type ctx e op t_args) tau;
+               operators are required to allow the resolution of all type
-          List.rev_map2
+               variables this way *)
-            (typecheck_expr_top_down ctx env)
+            unify ctx e (polymorphic_op_type op) t_func;
-            (List.rev t_args) (List.rev args))
+            List.rev_map2
+              (typecheck_expr_top_down ctx env)
+              (List.rev t_args) (List.rev args)))
         ~overloaded:(fun op ->
           (* Typing the arguments first is required to resolve the operator *)
           let args' = List.map2 (typecheck_expr_top_down ctx env) t_args args in

runtimes/ocaml/runtime.ml

@@ -716,32 +716,9 @@ module EventParser = struct
     ctx.events
 end
 
-let handle_default :
+let handle_exceptions
-      'a.
-      source_position array ->
-      (unit -> 'a) array ->
-      (unit -> bool) ->
-      (unit -> 'a) ->
-      'a =
- fun pos exceptions just cons ->
-  let len = Array.length exceptions in
-  let rec filt_except i =
-    if i < len then
-      match exceptions.(i) () with
-      | new_val -> (new_val, i) :: filt_except (i + 1)
-      | exception Empty -> filt_except (i + 1)
-    else []
-  in
-  match filt_except 0 with
-  | [] -> if just () then cons () else raise Empty
-  | [(res, _)] -> res
-  | res -> error Conflict (List.map (fun (_, i) -> pos.(i)) res)
-
-let handle_default_opt
     (pos : source_position array)
-    (exceptions : 'a Eoption.t array)
+    (exceptions : 'a Eoption.t array) : 'a Eoption.t =
-    (just : unit -> bool)
-    (cons : unit -> 'a Eoption.t) : 'a Eoption.t =
   let len = Array.length exceptions in
   let rec filt_except i =
     if i < len then
@@ -751,7 +728,7 @@ let handle_default_opt
     else []
   in
   match filt_except 0 with
-  | [] -> if just () then cons () else Eoption.ENone ()
+  | [] -> Eoption.ENone ()
   | [(res, _)] -> res
   | res -> error Conflict (List.map (fun (_, i) -> pos.(i)) res)
 

runtimes/ocaml/runtime.mli

@@ -335,21 +335,8 @@ val duration_to_string : duration -> string
 
 (**{1 Defaults} *)
 
-val handle_default :
+val handle_exceptions :
-  source_position array ->
+  source_position array -> 'a Eoption.t array -> 'a Eoption.t
-  (unit -> 'a) array ->
-  (unit -> bool) ->
-  (unit -> 'a) ->
-  'a
-(** @raise Empty
-    @raise Error Conflict *)
-
-val handle_default_opt :
-  source_position array ->
-  'a Eoption.t array ->
-  (unit -> bool) ->
-  (unit -> 'a Eoption.t) ->
-  'a Eoption.t
 (** @raise Error Conflict *)
 
 (**{1 Operators} *)

runtimes/python/src/catala/runtime.py

@@ -383,9 +383,9 @@ class NoValue(CatalaError):
                          source_position)
 
 class Conflict(CatalaError):
-    def __init__(self, source_position: SourcePosition) -> None:
+    def __init__(self, pos1: SourcePosition, pos2: SourcePosition) -> None:
-        super().__init__("two or more concurring valid computations",
+        super().__init__("two or more concurring valid computations:\nAt {}".format(pos2),
-                         source_position)
+                         pos1)
 
 class DivisionByZero(CatalaError):
     def __init__(self, source_position: SourcePosition) -> None:
@@ -606,56 +606,20 @@ def list_length(l: List[Alpha]) -> Integer:
 # ========
 
 
-def handle_default(
+def handle_exceptions(
-    pos: SourcePosition,
+    pos: List[SourcePosition],
-    exceptions: List[Callable[[Unit], Alpha]],
+    exceptions: List[Optional[Alpha]]) -> Optional[Alpha]:
-    just: Callable[[Unit], Alpha],
-    cons: Callable[[Unit], Alpha]
-) -> Alpha:
     acc: Optional[Alpha] = None
-    for exception in exceptions:
+    acc_pos: Optional[pos] = None
-        new_val: Optional[Alpha]
+    for exception, pos in zip(exceptions, pos):
-        try:
+        if exception is None:
-            new_val = exception(Unit())
-        except Empty:
-            new_val = None
-        if acc is None:
-            acc = new_val
-        elif not (acc is None) and new_val is None:
             pass  # acc stays the same
-        elif not (acc is None) and not (new_val is None):
+        elif acc is None:
-            raise Conflict(pos)
-    if acc is None:
-        if just(Unit()):
-            return cons(Unit())
-        else:
-            raise Empty
-    else:
-        return acc
-
-
-def handle_default_opt(
-    pos: SourcePosition,
-    exceptions: List[Optional[Any]],
-    just: Callable[[Unit], bool],
-    cons: Callable[[Unit], Optional[Alpha]]
-) -> Optional[Alpha]:
-    acc: Optional[Alpha] = None
-    for exception in exceptions:
-        if acc is None:
             acc = exception
-        elif not (acc is None) and exception is None:
+            acc_pos = pos
-            pass  # acc stays the same
-        elif not (acc is None) and not (exception is None):
-            raise Conflict(pos)
-    if acc is None:
-        b = just(Unit())
-        if b:
-            return cons(Unit())
         else:
-            return None
+            raise Conflict(acc_pos,pos)
-    else:
+    return acc
-        return acc
 
 
 def no_input() -> Callable[[Unit], Alpha]:

runtimes/r/NAMESPACE

@@ -16,7 +16,6 @@ export(catala_decimal_to_numeric)
 export(catala_duration_from_ymd)
 export(catala_duration_to_ymd)
 export(catala_empty_error)
-export(catala_handle_default)
 export(catala_integer_from_numeric)
 export(catala_integer_from_string)
 export(catala_integer_to_numeric)

runtimes/r/R/runtime.R

@@ -363,36 +363,6 @@ catala_assertion_failure <- function(pos) {
 
 ################ Defaults #################
 
-#' @export
-catala_handle_default <- function(pos, exceptions, just, cons) {
-  acc <- Reduce(function(acc, exception) {
-    new_val <- tryCatch(
-      exception(new("catala_unit", v = 0)),
-      catala_empty_error = function(e) {
-        NULL
-      }
-    )
-    if (is.null(acc)) {
-      new_val
-    } else {
-      if (is.null(new_val)) {
-        acc
-      } else {
-        stop(catala_conflict_error(pos))
-      }
-    }
-  }, exceptions, NULL)
-  if (is.null(acc)) {
-    if (just(new("catala_unit", v = 0))) {
-      cons(new("catala_unit", v = 0))
-    } else {
-      stop(catala_empty_error())
-    }
-  } else {
-    acc
-  }
-}
-
 # This value is used for the R code generation to trump R and forcing
 # it to accept dead code. Indeed, when raising an exception during a variable
 # definition, R could complains that the later dead code will not know what

tests/backends/output/simple.c

@@ -86,114 +86,116 @@ typedef struct array_1_struct {
   int length_field;
 } array_1_struct;
 
-typedef struct tuple_0_struct {
+typedef struct tuple_1_struct {
   option_1_enum (*elt_0_field)(void * /* closure_env */ arg_0_typ, void* /* unit */ arg_1_typ);
   void * /* closure_env */ elt_1_field;
-} tuple_0_struct;
+} tuple_1_struct;
 
 typedef struct baz_in_struct {
-  tuple_0_struct a_in_field;
+  tuple_1_struct a_in_field;
 } baz_in_struct;
 
 
 baz_struct baz_func(baz_in_struct baz_in) {
-  tuple_0_struct a;
+  tuple_1_struct a;
   a = baz_in.a_in_field;
   bar_enum temp_a;
   option_1_enum temp_a_1;
-  tuple_0_struct code_and_env;
+  tuple_1_struct code_and_env;
   code_and_env = a;
   option_1_enum (*code)(void * /* closure_env */ arg_0_typ, void* /* unit */ arg_1_typ);
   void * /* closure_env */ env;
   code = code_and_env.elt_0_field;
   env = code_and_env.elt_1_field;
-  option_1_enum exception_acc = {option_1_enum_none_1_cons,
+  array_1_struct temp_a_2;
-    {none_1_cons: NULL}};
+  temp_a_2.content_field = catala_malloc(sizeof(array_1_struct));
-  option_1_enum exception_current;
+  temp_a_2.content_field[0] = code(env, NULL);
-  char exception_conflict = 0;
+  option_1_enum match_arg = catala_handle_exceptions(temp_a_2);
-  exception_current = code(env, NULL);
+  switch (match_arg.code) {
-  if (exception_current.code == option_1_enum_some_1_cons) {
+    case option_1_enum_none_1_cons:
-    if (exception_acc.code == option_1_enum_some_1_cons) {
-      exception_conflict = 1;
-    } else {
-      exception_acc = exception_current;
-    }
-  }
-  if (exception_conflict) {
-    catala_raise_fatal_error(catala_conflict,
-      "tests/backends/simple.catala_en", 11, 11, 11, 12);
-  }
-  if (exception_acc.code == option_1_enum_some_1_cons) {
-    temp_a_1 = exception_acc;
-  } else {
-    if (1 /* TRUE */) {
-      bar_enum temp_a_2;
-      option_1_enum temp_a_3;
-      option_1_enum temp_a_4;
       if (1 /* TRUE */) {
-        bar_enum temp_a_5 = {bar_enum_no_cons, {no_cons: NULL}};
+        bar_enum temp_a_3;
-        option_1_enum temp_a_6 = {option_1_enum_some_1_cons,
+        option_1_enum temp_a_4;
-          {some_1_cons: temp_a_5}};
+        option_1_enum temp_a_5;
-        temp_a_4 = temp_a_6;
+        array_1_struct temp_a_6;
-      } else {
+        temp_a_6.content_field = catala_malloc(sizeof(array_1_struct));
-        temp_a_4.code = option_1_enum_none_1_cons;
+        
-        temp_a_4.payload.none_1_cons = NULL;
+        option_1_enum match_arg_1 = catala_handle_exceptions(temp_a_6);
-      }
+        switch (match_arg_1.code) {
-      option_1_enum exception_acc_1 = {option_1_enum_none_1_cons,
+          case option_1_enum_none_1_cons:
-        {none_1_cons: NULL}};
+            if (1 /* TRUE */) {
-      option_1_enum exception_current_1;
+              bar_enum temp_a_7 = {bar_enum_no_cons, {no_cons: NULL}};
-      char exception_conflict_1 = 0;
+              option_1_enum temp_a_5 = {option_1_enum_some_1_cons,
-      exception_current_1 = temp_a_4;
+                {some_1_cons: temp_a_7}};
-      if (exception_current_1.code == option_1_enum_some_1_cons) {
+              
-        if (exception_acc_1.code == option_1_enum_some_1_cons) {
+            } else {
-          exception_conflict_1 = 1;
+              option_1_enum temp_a_5 = {option_1_enum_none_1_cons,
-        } else {
+                {none_1_cons: NULL}};
-          exception_acc_1 = exception_current_1;
+              
+            }
+            break;
+          case option_1_enum_some_1_cons:
+            bar_enum x = match_arg_1.payload.some_1_cons;
+            option_1_enum temp_a_5 = {option_1_enum_some_1_cons,
+              {some_1_cons: x}};
+            break;
         }
-      }
+        array_1_struct temp_a_8;
-      if (exception_conflict_1) {
+        temp_a_8.content_field = catala_malloc(sizeof(array_1_struct));
-        catala_raise_fatal_error(catala_conflict,
+        temp_a_8.content_field[0] = temp_a_5;
-          "tests/backends/simple.catala_en", 11, 11, 11, 12);
+        option_1_enum match_arg_2 = catala_handle_exceptions(temp_a_8);
-      }
+        switch (match_arg_2.code) {
-      if (exception_acc_1.code == option_1_enum_some_1_cons) {
+          case option_1_enum_none_1_cons:
-        temp_a_3 = exception_acc_1;
+            if (0 /* FALSE */) {
-      } else {
+              option_1_enum temp_a_4 = {option_1_enum_none_1_cons,
-        if (0 /* FALSE */) {
+                {none_1_cons: NULL}};
-          option_1_enum temp_a_7 = {option_1_enum_none_1_cons,
+              
-            {none_1_cons: NULL}};
+            } else {
-          temp_a_3 = temp_a_7;
+              option_1_enum temp_a_4 = {option_1_enum_none_1_cons,
-        } else {
+                {none_1_cons: NULL}};
-          temp_a_3.code = option_1_enum_none_1_cons;
+              
-          temp_a_3.payload.none_1_cons = NULL;
+            }
+            break;
+          case option_1_enum_some_1_cons:
+            bar_enum x_1 = match_arg_2.payload.some_1_cons;
+            option_1_enum temp_a_4 = {option_1_enum_some_1_cons,
+              {some_1_cons: x_1}};
+            break;
         }
+        option_1_enum match_arg_3 = temp_a_4;
+        switch (match_arg_3.code) {
+          case option_1_enum_none_1_cons:
+            catala_raise_fatal_error (catala_no_value,
+              "tests/backends/simple.catala_en", 11, 11, 11, 12);
+            break;
+          case option_1_enum_some_1_cons:
+            bar_enum arg = match_arg_3.payload.some_1_cons;
+            temp_a_3 = arg;
+            break;
+        }
+        option_1_enum temp_a_1 = {option_1_enum_some_1_cons,
+          {some_1_cons: temp_a_3}};
+        
+      } else {
+        option_1_enum temp_a_1 = {option_1_enum_none_1_cons,
+          {none_1_cons: NULL}};
+        
       }
-      option_1_enum match_arg = temp_a_3;
+      break;
-      switch (match_arg.code) {
+    case option_1_enum_some_1_cons:
-        case option_1_enum_none_1_cons:
+      bar_enum x_2 = match_arg.payload.some_1_cons;
-          catala_raise_fatal_error (catala_no_value,
+      option_1_enum temp_a_1 = {option_1_enum_some_1_cons,
-            "tests/backends/simple.catala_en", 11, 11, 11, 12);
+        {some_1_cons: x_2}};
-          break;
+      break;
-        case option_1_enum_some_1_cons:
-          bar_enum arg = match_arg.payload.some_1_cons;
-          temp_a_2 = arg;
-          break;
-      }
-      option_1_enum temp_a_8 = {option_1_enum_some_1_cons,
-        {some_1_cons: temp_a_2}};
-      temp_a_1 = temp_a_8;
-    } else {
-      temp_a_1.code = option_1_enum_none_1_cons;
-      temp_a_1.payload.none_1_cons = NULL;
-    }
   }
-  option_1_enum match_arg_1 = temp_a_1;
+  option_1_enum match_arg_4 = temp_a_1;
-  switch (match_arg_1.code) {
+  switch (match_arg_4.code) {
     case option_1_enum_none_1_cons:
       catala_raise_fatal_error (catala_no_value,
         "tests/backends/simple.catala_en", 11, 11, 11, 12);
       break;
     case option_1_enum_some_1_cons:
-      bar_enum arg_1 = match_arg_1.payload.some_1_cons;
+      bar_enum arg_1 = match_arg_4.payload.some_1_cons;
       temp_a = arg_1;
       break;
   }
@@ -203,133 +205,143 @@ baz_struct baz_func(baz_in_struct baz_in) {
   option_2_enum temp_b_1;
   option_2_enum temp_b_2;
   option_2_enum temp_b_3;
-  char /* bool */ temp_b_4;
+  array_2_struct temp_b_4;
-  bar_enum match_arg_2 = a_1;
+  temp_b_4.content_field = catala_malloc(sizeof(array_2_struct));
-  switch (match_arg_2.code) {
+  
-    case bar_enum_no_cons: temp_b_4 = 1 /* TRUE */; break;
+  option_2_enum match_arg_5 = catala_handle_exceptions(temp_b_4);
-    case bar_enum_yes_cons:
+  switch (match_arg_5.code) {
-      foo_struct dummy_var = match_arg_2.payload.yes_cons;
+    case option_2_enum_none_2_cons:
-      temp_b_4 = 0 /* FALSE */;
+      char /* bool */ temp_b_5;
+      bar_enum match_arg_6 = a_1;
+      switch (match_arg_6.code) {
+        case bar_enum_no_cons: temp_b_5 = 1 /* TRUE */; break;
+        case bar_enum_yes_cons:
+          foo_struct dummy_var = match_arg_6.payload.yes_cons;
+          temp_b_5 = 0 /* FALSE */;
+          break;
+      }
+      if (temp_b_5) {
+        option_2_enum temp_b_3 = {option_2_enum_some_2_cons,
+          {some_2_cons: 42.}};
+        
+      } else {
+        option_2_enum temp_b_3 = {option_2_enum_none_2_cons,
+          {none_2_cons: NULL}};
+        
+      }
+      break;
+    case option_2_enum_some_2_cons:
+      double x_3 = match_arg_5.payload.some_2_cons;
+      option_2_enum temp_b_3 = {option_2_enum_some_2_cons,
+        {some_2_cons: x_3}};
       break;
   }
-  if (temp_b_4) {
+  array_2_struct temp_b_6;
-    option_2_enum temp_b_5 = {option_2_enum_some_2_cons, {some_2_cons: 42.}};
+  temp_b_6.content_field = catala_malloc(sizeof(array_2_struct));
-    temp_b_3 = temp_b_5;
+  temp_b_6.content_field[0] = temp_b_3;
-  } else {
+  option_2_enum match_arg_7 = catala_handle_exceptions(temp_b_6);
-    temp_b_3.code = option_2_enum_none_2_cons;
+  switch (match_arg_7.code) {
-    temp_b_3.payload.none_2_cons = NULL;
+    case option_2_enum_none_2_cons:
+      if (0 /* FALSE */) {
+        option_2_enum temp_b_2 = {option_2_enum_none_2_cons,
+          {none_2_cons: NULL}};
+        
+      } else {
+        option_2_enum temp_b_2 = {option_2_enum_none_2_cons,
+          {none_2_cons: NULL}};
+        
+      }
+      break;
+    case option_2_enum_some_2_cons:
+      double x_4 = match_arg_7.payload.some_2_cons;
+      option_2_enum temp_b_2 = {option_2_enum_some_2_cons,
+        {some_2_cons: x_4}};
+      break;
   }
-  option_2_enum exception_acc_2 = {option_2_enum_none_2_cons,
+  array_2_struct temp_b_7;
-    {none_2_cons: NULL}};
+  temp_b_7.content_field = catala_malloc(sizeof(array_2_struct));
-  option_2_enum exception_current_2;
+  temp_b_7.content_field[0] = temp_b_2;
-  char exception_conflict_2 = 0;
+  option_2_enum match_arg_8 = catala_handle_exceptions(temp_b_7);
-  exception_current_2 = temp_b_3;
+  switch (match_arg_8.code) {
-  if (exception_current_2.code == option_2_enum_some_2_cons) {
+    case option_2_enum_none_2_cons:
-    if (exception_acc_2.code == option_2_enum_some_2_cons) {
-      exception_conflict_2 = 1;
-    } else {
-      exception_acc_2 = exception_current_2;
-    }
-  }
-  if (exception_conflict_2) {
-    catala_raise_fatal_error(catala_conflict,
-      "tests/backends/simple.catala_en", 12, 10, 12, 11);
-  }
-  if (exception_acc_2.code == option_2_enum_some_2_cons) {
-    temp_b_2 = exception_acc_2;
-  } else {
-    if (0 /* FALSE */) {
-      option_2_enum temp_b_6 = {option_2_enum_none_2_cons,
-        {none_2_cons: NULL}};
-      temp_b_2 = temp_b_6;
-    } else {
-      temp_b_2.code = option_2_enum_none_2_cons;
-      temp_b_2.payload.none_2_cons = NULL;
-    }
-  }
-  option_2_enum exception_acc_3 = {option_2_enum_none_2_cons,
-    {none_2_cons: NULL}};
-  option_2_enum exception_current_3;
-  char exception_conflict_3 = 0;
-  exception_current_3 = temp_b_2;
-  if (exception_current_3.code == option_2_enum_some_2_cons) {
-    if (exception_acc_3.code == option_2_enum_some_2_cons) {
-      exception_conflict_3 = 1;
-    } else {
-      exception_acc_3 = exception_current_3;
-    }
-  }
-  if (exception_conflict_3) {
-    catala_raise_fatal_error(catala_conflict,
-      "tests/backends/simple.catala_en", 12, 10, 12, 11);
-  }
-  if (exception_acc_3.code == option_2_enum_some_2_cons) {
-    temp_b_1 = exception_acc_3;
-  } else {
-    if (1 /* TRUE */) {
-      option_2_enum temp_b_7;
-      option_2_enum temp_b_8;
       if (1 /* TRUE */) {
-        double temp_b_9;
+        option_2_enum temp_b_8;
-        bar_enum match_arg_3 = a_1;
+        array_2_struct temp_b_9;
-        switch (match_arg_3.code) {
+        temp_b_9.content_field = catala_malloc(sizeof(array_2_struct));
-          case bar_enum_no_cons: temp_b_9 = 0.; break;
+        
-          case bar_enum_yes_cons:
+        option_2_enum match_arg_9 = catala_handle_exceptions(temp_b_9);
-            foo_struct foo = match_arg_3.payload.yes_cons;
+        switch (match_arg_9.code) {
-            double temp_b_10;
+          case option_2_enum_none_2_cons:
-            if (foo.x_field) {temp_b_10 = 1.; } else {temp_b_10 = 0.; }
+            if (1 /* TRUE */) {
-            temp_b_9 = (foo.y_field + temp_b_10);
+              double temp_b_10;
+              bar_enum match_arg_10 = a_1;
+              switch (match_arg_10.code) {
+                case bar_enum_no_cons: temp_b_10 = 0.; break;
+                case bar_enum_yes_cons:
+                  foo_struct foo = match_arg_10.payload.yes_cons;
+                  double temp_b_11;
+                  if (foo.x_field) {temp_b_11 = 1.; } else {temp_b_11 = 0.; }
+                  temp_b_10 = (foo.y_field + temp_b_11);
+                  break;
+              }
+              option_2_enum temp_b_8 = {option_2_enum_some_2_cons,
+                {some_2_cons: temp_b_10}};
+              
+            } else {
+              option_2_enum temp_b_8 = {option_2_enum_none_2_cons,
+                {none_2_cons: NULL}};
+              
+            }
+            break;
+          case option_2_enum_some_2_cons:
+            double x_5 = match_arg_9.payload.some_2_cons;
+            option_2_enum temp_b_8 = {option_2_enum_some_2_cons,
+              {some_2_cons: x_5}};
             break;
         }
-        option_2_enum temp_b_11 = {option_2_enum_some_2_cons,
+        array_2_struct temp_b_12;
-          {some_2_cons: temp_b_9}};
+        temp_b_12.content_field = catala_malloc(sizeof(array_2_struct));
-        temp_b_8 = temp_b_11;
+        temp_b_12.content_field[0] = temp_b_8;
-      } else {
+        option_2_enum match_arg_11 = catala_handle_exceptions(temp_b_12);
-        temp_b_8.code = option_2_enum_none_2_cons;
+        switch (match_arg_11.code) {
-        temp_b_8.payload.none_2_cons = NULL;
+          case option_2_enum_none_2_cons:
-      }
+            if (0 /* FALSE */) {
-      option_2_enum exception_acc_4 = {option_2_enum_none_2_cons,
+              option_2_enum temp_b_1 = {option_2_enum_none_2_cons,
-        {none_2_cons: NULL}};
+                {none_2_cons: NULL}};
-      option_2_enum exception_current_4;
+              
-      char exception_conflict_4 = 0;
+            } else {
-      exception_current_4 = temp_b_8;
+              option_2_enum temp_b_1 = {option_2_enum_none_2_cons,
-      if (exception_current_4.code == option_2_enum_some_2_cons) {
+                {none_2_cons: NULL}};
-        if (exception_acc_4.code == option_2_enum_some_2_cons) {
+              
-          exception_conflict_4 = 1;
+            }
-        } else {
+            break;
-          exception_acc_4 = exception_current_4;
+          case option_2_enum_some_2_cons:
+            double x_6 = match_arg_11.payload.some_2_cons;
+            option_2_enum temp_b_1 = {option_2_enum_some_2_cons,
+              {some_2_cons: x_6}};
+            break;
         }
-      }
+        
-      if (exception_conflict_4) {
-        catala_raise_fatal_error(catala_conflict,
-          "tests/backends/simple.catala_en", 12, 10, 12, 11);
-      }
-      if (exception_acc_4.code == option_2_enum_some_2_cons) {
-        temp_b_7 = exception_acc_4;
       } else {
-        if (0 /* FALSE */) {
+        option_2_enum temp_b_1 = {option_2_enum_none_2_cons,
-          option_2_enum temp_b_12 = {option_2_enum_none_2_cons,
+          {none_2_cons: NULL}};
-            {none_2_cons: NULL}};
+        
-          temp_b_7 = temp_b_12;
-        } else {
-          temp_b_7.code = option_2_enum_none_2_cons;
-          temp_b_7.payload.none_2_cons = NULL;
-        }
       }
-      temp_b_1 = temp_b_7;
+      break;
-    } else {
+    case option_2_enum_some_2_cons:
-      temp_b_1.code = option_2_enum_none_2_cons;
+      double x_7 = match_arg_8.payload.some_2_cons;
-      temp_b_1.payload.none_2_cons = NULL;
+      option_2_enum temp_b_1 = {option_2_enum_some_2_cons,
-    }
+        {some_2_cons: x_7}};
+      break;
   }
-  option_2_enum match_arg_4 = temp_b_1;
+  option_2_enum match_arg_12 = temp_b_1;
-  switch (match_arg_4.code) {
+  switch (match_arg_12.code) {
     case option_2_enum_none_2_cons:
       catala_raise_fatal_error (catala_no_value,
         "tests/backends/simple.catala_en", 12, 10, 12, 11);
       break;
     case option_2_enum_some_2_cons:
-      double arg_2 = match_arg_4.payload.some_2_cons;
+      double arg_2 = match_arg_12.payload.some_2_cons;
       temp_b = arg_2;
       break;
   }
@@ -338,54 +350,62 @@ baz_struct baz_func(baz_in_struct baz_in) {
   array_3_struct temp_c;
   option_3_enum temp_c_1;
   option_3_enum temp_c_2;
-  if (1 /* TRUE */) {
+  array_4_struct temp_c_3;
-    array_3_struct temp_c_3;
+  temp_c_3.content_field = catala_malloc(sizeof(array_4_struct));
-    temp_c_3.content_field = catala_malloc(sizeof(array_3_struct));
+  
-    temp_c_3.content_field[0] = b;
+  option_3_enum match_arg_13 = catala_handle_exceptions(temp_c_3);
-    temp_c_3.content_field[1] = b;
+  switch (match_arg_13.code) {
-    option_3_enum temp_c_4 = {option_3_enum_some_3_cons,
+    case option_3_enum_none_3_cons:
-      {some_3_cons: temp_c_3}};
+      if (1 /* TRUE */) {
-    temp_c_2 = temp_c_4;
+        array_3_struct temp_c_4;
-  } else {
+        temp_c_4.content_field = catala_malloc(sizeof(array_3_struct));
-    temp_c_2.code = option_3_enum_none_3_cons;
+        temp_c_4.content_field[0] = b;
-    temp_c_2.payload.none_3_cons = NULL;
+        temp_c_4.content_field[1] = b;
+        option_3_enum temp_c_2 = {option_3_enum_some_3_cons,
+          {some_3_cons: temp_c_4}};
+        
+      } else {
+        option_3_enum temp_c_2 = {option_3_enum_none_3_cons,
+          {none_3_cons: NULL}};
+        
+      }
+      break;
+    case option_3_enum_some_3_cons:
+      array_3_struct x_8 = match_arg_13.payload.some_3_cons;
+      option_3_enum temp_c_2 = {option_3_enum_some_3_cons,
+        {some_3_cons: x_8}};
+      break;
   }
-  option_3_enum exception_acc_5 = {option_3_enum_none_3_cons,
+  array_4_struct temp_c_5;
-    {none_3_cons: NULL}};
+  temp_c_5.content_field = catala_malloc(sizeof(array_4_struct));
-  option_3_enum exception_current_5;
+  temp_c_5.content_field[0] = temp_c_2;
-  char exception_conflict_5 = 0;
+  option_3_enum match_arg_14 = catala_handle_exceptions(temp_c_5);
-  exception_current_5 = temp_c_2;
+  switch (match_arg_14.code) {
-  if (exception_current_5.code == option_3_enum_some_3_cons) {
+    case option_3_enum_none_3_cons:
-    if (exception_acc_5.code == option_3_enum_some_3_cons) {
+      if (0 /* FALSE */) {
-      exception_conflict_5 = 1;
+        option_3_enum temp_c_1 = {option_3_enum_none_3_cons,
-    } else {
+          {none_3_cons: NULL}};
-      exception_acc_5 = exception_current_5;
+        
-    }
+      } else {
+        option_3_enum temp_c_1 = {option_3_enum_none_3_cons,
+          {none_3_cons: NULL}};
+        
+      }
+      break;
+    case option_3_enum_some_3_cons:
+      array_3_struct x_9 = match_arg_14.payload.some_3_cons;
+      option_3_enum temp_c_1 = {option_3_enum_some_3_cons,
+        {some_3_cons: x_9}};
+      break;
   }
-  if (exception_conflict_5) {
+  option_3_enum match_arg_15 = temp_c_1;
-    catala_raise_fatal_error(catala_conflict,
+  switch (match_arg_15.code) {
-      "tests/backends/simple.catala_en", 13, 10, 13, 11);
-  }
-  if (exception_acc_5.code == option_3_enum_some_3_cons) {
-    temp_c_1 = exception_acc_5;
-  } else {
-    if (0 /* FALSE */) {
-      option_3_enum temp_c_5 = {option_3_enum_none_3_cons,
-        {none_3_cons: NULL}};
-      temp_c_1 = temp_c_5;
-    } else {
-      temp_c_1.code = option_3_enum_none_3_cons;
-      temp_c_1.payload.none_3_cons = NULL;
-    }
-  }
-  option_3_enum match_arg_5 = temp_c_1;
-  switch (match_arg_5.code) {
     case option_3_enum_none_3_cons:
       catala_raise_fatal_error (catala_no_value,
         "tests/backends/simple.catala_en", 13, 10, 13, 11);
       break;
     case option_3_enum_some_3_cons:
-      array_3_struct arg_3 = match_arg_5.payload.some_3_cons;
+      array_3_struct arg_3 = match_arg_15.payload.some_3_cons;
       temp_c = arg_3;
       break;
   }

tests/backends/python_name_clash.catala_en

@@ -91,60 +91,79 @@ class BIn:
 
 def some_name(some_name_in:SomeNameIn):
     i = some_name_in.i_in
-    try:
+    perhaps_none_arg = handle_exceptions([], [])
-        def temp_o(_:Unit):
+    if perhaps_none_arg is None:
-            def temp_o_1(_:Unit):
+        if True:
-                return True
+            temp_o = (i + integer_of_string("1"))
-            def temp_o_2(_:Unit):
+        else:
-                return (i + integer_of_string("1"))
+            temp_o = None
-            return handle_default(SourcePosition(filename="tests/backends/python_name_clash.catala_en",
+    else:
+        x = perhaps_none_arg
+        temp_o = x
+    perhaps_none_arg_1 = handle_exceptions(
+                             [SourcePosition(
+                                  filename="tests/backends/python_name_clash.catala_en",
                                   start_line=10, start_column=23,
-                                  end_line=10, end_column=28,
+                                  end_line=10, end_column=28, law_headings=[]
-                                  law_headings=[]), [], temp_o_1, temp_o_2)
+                              )],
-        def temp_o_3(_:Unit):
+                             [temp_o]
-            return False
+                         )
-        def temp_o_4(_:Unit):
+    if perhaps_none_arg_1 is None:
-            raise Empty
+        if False:
-        temp_o_5 = handle_default(SourcePosition(filename="tests/backends/python_name_clash.catala_en",
+            temp_o_1 = None
-                                  start_line=7, start_column=10,
+        else:
-                                  end_line=7, end_column=11,
+            temp_o_1 = None
-                                  law_headings=[]), [temp_o], temp_o_3,
+    else:
-                                  temp_o_4)
+        x_1 = perhaps_none_arg_1
-    except Empty:
+        temp_o_1 = x_1
+    perhaps_none_arg_2 = temp_o_1
+    if perhaps_none_arg_2 is None:
         raise NoValue(SourcePosition(
                           filename="tests/backends/python_name_clash.catala_en",
                           start_line=7, start_column=10,
                           end_line=7, end_column=11, law_headings=[]))
-    o = temp_o_5
+    else:
+        arg = perhaps_none_arg_2
+        temp_o_2 = arg
+    o = temp_o_2
     return SomeName(o = o)
 
 def b(b_in:BIn):
-    try:
+    perhaps_none_arg_3 = handle_exceptions([], [])
-        def temp_result(_:Unit):
+    if perhaps_none_arg_3 is None:
-            def temp_result_1(_:Unit):
+        if True:
-                return True
+            temp_result = integer_of_string("1")
-            def temp_result_2(_:Unit):
+        else:
-                return integer_of_string("1")
+            temp_result = None
-            return handle_default(SourcePosition(filename="tests/backends/python_name_clash.catala_en",
+    else:
+        x_2 = perhaps_none_arg_3
+        temp_result = x_2
+    perhaps_none_arg_4 = handle_exceptions(
+                             [SourcePosition(
+                                  filename="tests/backends/python_name_clash.catala_en",
                                   start_line=16, start_column=33,
-                                  end_line=16, end_column=34,
+                                  end_line=16, end_column=34, law_headings=[]
-                                  law_headings=[]), [], temp_result_1,
+                              )],
-                                  temp_result_2)
+                             [temp_result]
-        def temp_result_3(_:Unit):
+                         )
-            return False
+    if perhaps_none_arg_4 is None:
-        def temp_result_4(_:Unit):
+        if False:
-            raise Empty
+            temp_result_1 = None
-        temp_result_5 = handle_default(SourcePosition(filename="tests/backends/python_name_clash.catala_en",
+        else:
-                                       start_line=16, start_column=14,
+            temp_result_1 = None
-                                       end_line=16, end_column=25,
+    else:
-                                       law_headings=[]), [temp_result],
+        x_3 = perhaps_none_arg_4
-                                       temp_result_3, temp_result_4)
+        temp_result_1 = x_3
-    except Empty:
+    perhaps_none_arg_5 = temp_result_1
+    if perhaps_none_arg_5 is None:
         raise NoValue(SourcePosition(
                           filename="tests/backends/python_name_clash.catala_en",
                           start_line=16, start_column=14,
                           end_line=16, end_column=25, law_headings=[]))
-    result = some_name(SomeNameIn(i_in = temp_result_5))
+    else:
+        arg_1 = perhaps_none_arg_5
+        temp_result_2 = arg_1
+    result = some_name(SomeNameIn(i_in = temp_result_2))
     result_1 = SomeName(o = result.o)
     if True:
         temp_some_name = result_1

tests/func/good/closure_conversion.catala_en

@@ -24,14 +24,16 @@ $ catala Typecheck --check-invariants
 ```
 
 ```catala-test-inline
-$ catala Lcalc --avoid-exceptions -O --closure-conversion
+$ catala Lcalc -O --closure-conversion
-type Eoption =  | ENone of unit  | ESome of any 
+type Eoption = | ENone of unit | ESome of any
+
 type S_in = { x_in: bool; }
 type S = { z: integer; }
 
 let topval closure_f1 : (closure_env, integer) → integer =
   λ (env: closure_env) (y: integer) →
   if (from_closure_env env).0 then y else - y
+
 let scope S (S_in: S_in {x_in: bool}): S {z: integer} =
   let get x : bool = S_in.x_in in
   let set f : ((closure_env, integer) → integer, closure_env) =
@@ -65,7 +67,7 @@ scope S2Use:
 ```
 
 ```catala-test-inline
-$ catala Lcalc --avoid-exceptions -O --closure-conversion -s S2Use
+$ catala Lcalc -O --closure-conversion -s S2Use
 let scope S2Use
   (S2Use_in: S2Use_in)
   : S2Use {

tests/func/good/closure_conversion_reduce.catala_en

@@ -24,7 +24,7 @@ $ catala Typecheck --check-invariants
 ```
 
 ```catala-test-inline
-$ catala Lcalc -s S --avoid-exceptions -O --closure-conversion
+$ catala Lcalc -s S -O --closure-conversion
 let scope S (S_in: S_in {x_in: list of integer}): S {y: integer} =
   let get x : list of integer = S_in.x_in in
   let set y : integer =
@@ -38,12 +38,12 @@ let scope S (S_in: S_in {x_in: list of integer}): S {y: integer} =
 ```
 
 The next test of closure conversion should give the same results, it checks that
-`--avoid-exceptions` and `-O` are correctly implied by `--closure-conversion`
+`-O` is correctly implied by `--closure-conversion`
 The detection of closures that should not be converted because they are arguments
 to reduce or other special operators relies on pattern matching the special
 operator and its EAbs argument. However without exceptions on, because the
---avoid-exceptions pass is not optimized and produces more options than needed,
+lcalc translation pass is not optimized and produces more options than needed,
-the closures that are arguments to special operators are let-binded with an
+the closures that are arguments to special operators are let-bound with an
 option. This let-binding is reduced by partial evaluation, which is why the test
 with optimizations on passes.
 
@@ -53,31 +53,34 @@ let scope S (S_in: S_in {x_in: list of integer}): S {y: integer} =
   let get x : list of integer = S_in.x_in in
   let set y : integer =
     match
-      (handle_default_opt
+      (match
-         [
+         (handle_exceptions
-           handle_default_opt
+            [
-             []
+              match (handle_exceptions []) with
-             (λ () → true)
+              | ENone →
-             (λ () →
+                if true then
-              ESome
+                  ESome
-                (let weights : list of (integer, integer) =
+                    (let weights : list of (integer, integer) =
-                   map (λ (potential_max: integer) →
+                       map (λ (potential_max: integer) →
-                        (potential_max,
+                            (potential_max,
-                          let potential_max1 : integer = potential_max in
+                              let potential_max1 : integer = potential_max in
-                          potential_max1))
+                              potential_max1))
-                     x
+                         x
-                 in
+                     in
-                 reduce
+                     reduce
-                   (λ (x1: (integer, integer)) (x2: (integer, integer)) →
+                       (λ (x1: (integer, integer)) (x2: (integer, integer)) →
-                    if x1.1 < x2.1 then x1 else x2)
+                        if x1.1 < x2.1 then x1 else x2)
-                   let potential_max : integer = -1 in
+                       let potential_max : integer = -1 in
-                   (potential_max,
+                       (potential_max,
-                     let potential_max1 : integer = potential_max in
+                         let potential_max1 : integer = potential_max in
-                     potential_max1)
+                         potential_max1)
-                   weights).0)
+                       weights).0
-         ]
+                else ENone ()
-         (λ () → false)
+              | ESome x → ESome x
-         (λ () → ENone ()))
+            ])
+       with
+       | ENone → if false then ENone () else ENone ()
+       | ESome x → ESome x)
     with
     | ENone → error NoValue
     | ESome arg → arg

tests/func/good/closure_return.catala_en

@@ -22,14 +22,16 @@ $ catala Typecheck --check-invariants
 ```
 
 ```catala-test-inline
-$ catala Lcalc --avoid-exceptions -O --closure-conversion
+$ catala Lcalc -O --closure-conversion
-type Eoption =  | ENone of unit  | ESome of any 
+type Eoption = | ENone of unit | ESome of any
+
 type S_in = { x_in: bool; }
 type S = { f: ((closure_env, integer) → integer, closure_env); }
 
 let topval closure_f1 : (closure_env, integer) → integer =
   λ (env: closure_env) (y: integer) →
   if (from_closure_env env).0 then y else - y
+
 let scope S
   (S_in: S_in {x_in: bool})
   : S {f: ((closure_env, integer) → integer, closure_env)}

tests/func/good/closure_through_scope.catala_en

@@ -30,7 +30,7 @@ $ catala Typecheck --check-invariants
 ```
 
 ```catala-test-inline
-$ catala Lcalc -s T --avoid-exceptions -O --closure-conversion
+$ catala Lcalc -s T -O --closure-conversion
 let scope T (T_in: T_in): T {y: integer} =
   let set s : S {f: ((closure_env, integer) → integer, closure_env)} =
     { S f = (closure_s1, to_closure_env ()); }
@@ -45,7 +45,7 @@ let scope T (T_in: T_in): T {y: integer} =
 ```
 
 ```catala-test-inline
-$ catala Interpret --lcalc -s T --avoid-exceptions -O --closure-conversion
+$ catala Interpret --lcalc -s T -O --closure-conversion
 ┌─[RESULT]─
 │ y = -2
 └─

tests/func/good/scope_call_func_struct_closure.catala_en

@@ -53,8 +53,9 @@ $ catala Typecheck --check-invariants
 ```
 
 ```catala-test-inline
-$ catala Lcalc --avoid-exceptions -O --closure-conversion 
+$ catala Lcalc -O --closure-conversion 
-type Eoption =  | ENone of unit  | ESome of any 
+type Eoption = | ENone of unit | ESome of any
+
 type Result = {
   r: ((closure_env, integer) → integer, closure_env);
   q: integer;
@@ -69,12 +70,13 @@ type SubFoo2 = {
   x1: integer;
   y: ((closure_env, integer) → integer, closure_env);
 }
-type Foo_in = { b_in: ((closure_env, unit) → eoption bool, closure_env); }
+type Foo_in = { b_in: ((closure_env, unit) → option bool, closure_env); }
 type Foo = { z: integer; }
 
 let topval closure_y1 : (closure_env, integer) → integer =
   λ (env: closure_env) (z: integer) →
   (from_closure_env env).0 + z
+
 let scope SubFoo1
   (SubFoo1_in: SubFoo1_in {x_in: integer})
   : SubFoo1 {
@@ -87,10 +89,12 @@ let scope SubFoo1
     (closure_y1, to_closure_env (x))
   in
   return { SubFoo1 x = x; y = y; }
+
 let topval closure_y1 : (closure_env, integer) → integer =
   λ (env: closure_env) (z: integer) →
   let env1 : (integer, integer) = from_closure_env env in
   ((env1.1 + env1.0 + z))
+
 let scope SubFoo2
   (SubFoo2_in: SubFoo2_in {x1_in: integer; x2_in: integer})
   : SubFoo2 {
@@ -104,29 +108,33 @@ let scope SubFoo2
     (closure_y1, to_closure_env (x2, x1))
   in
   return { SubFoo2 x1 = x1; y = y; }
+
 let topval closure_r2 : (closure_env, integer) → integer =
   λ (env: closure_env) (param0: integer) →
   let code_and_env : ((closure_env, integer) → integer, closure_env) =
     (from_closure_env env).0.y
   in
   code_and_env.0 code_and_env.1 param0
+
 let topval closure_r1 : (closure_env, integer) → integer =
   λ (env: closure_env) (param0: integer) →
   let code_and_env : ((closure_env, integer) → integer, closure_env) =
     (from_closure_env env).0.y
   in
   code_and_env.0 code_and_env.1 param0
+
 let scope Foo
-  (Foo_in:
+  (Foo_in: Foo_in {b_in: ((closure_env, unit) → option bool, closure_env)})
-     Foo_in {b_in: ((closure_env, unit) → eoption bool, closure_env)})
   : Foo {z: integer}
   =
-  let get b : ((closure_env, unit) → eoption bool, closure_env) =
+  let get b : ((closure_env, unit) → option bool, closure_env) =
     Foo_in.b_in
   in
   let set b : bool =
     match
-      (handle_default_opt [b.0 b.1 ()] (λ () → true) (λ () → ESome true))
+      (match (handle_exceptions [b.0 b.1 ()]) with
+       | ENone → ESome true
+       | ESome x → ESome x)
     with
     | ENone → error NoValue
     | ESome arg → arg
@@ -165,7 +173,7 @@ let scope Foo
 ```
 
 ```catala-test-inline
-$ catala Interpret --lcalc -s Foo --avoid-exceptions -O --closure-conversion
+$ catala Interpret --lcalc -s Foo -O --closure-conversion
 ┌─[RESULT]─
 │ z = 11
 └─

tests/modules/good/output/mod_def.ml

@@ -27,39 +27,66 @@ end
 
 let s (s_in: S_in.t) : S.t =
   let sr_: money =
-    try
+    match
-      (handle_default
+      (match
-         [|{filename="tests/modules/good/mod_def.catala_en";
+         (handle_exceptions
-            start_line=29; start_column=24; end_line=29; end_column=30;
+            [|{filename="tests/modules/good/mod_def.catala_en";
-            law_headings=["Test modules + inclusions 1"]}|]
+               start_line=16; start_column=10; end_line=16; end_column=12;
-         ([|(fun (_: unit) ->
+               law_headings=["Test modules + inclusions 1"]}|]
-               handle_default [||] ([||]) (fun (_: unit) -> true)
+            ([|(match
-                 (fun (_: unit) -> money_of_cents_string "100000"))|])
+                  (handle_exceptions
-         (fun (_: unit) -> false) (fun (_: unit) -> raise Empty))
+                     [|{filename="tests/modules/good/mod_def.catala_en";
-    with Empty ->
+                        start_line=29; start_column=24;
-    (raise
+                        end_line=29; end_column=30;
-    (Runtime_ocaml.Runtime.Error (NoValue, [{filename="tests/modules/good/mod_def.catala_en";
+                        law_headings=["Test modules + inclusions 1"]}|]
-                                             start_line=16; start_column=10;
+                     ([||]))
-                                             end_line=16; end_column=12;
+                with
-                                             law_headings=["Test modules + inclusions 1"]}])))
+                | Eoption.ENone _ ->
-    in
+                    ( if true then
+                       (Eoption.ESome (money_of_cents_string "100000")) else
+                       (Eoption.ENone ()))
+                | Eoption.ESome x_ -> (Eoption.ESome x_))|]))
+       with
+       | Eoption.ENone _ ->
+           ( if false then (Eoption.ENone ()) else (Eoption.ENone ()))
+       | Eoption.ESome x_ -> (Eoption.ESome x_))
+    with
+    | Eoption.ENone _ -> (raise
+        (Runtime_ocaml.Runtime.Error (NoValue, [{filename="tests/modules/good/mod_def.catala_en";
+                                                 start_line=16; start_column=10;
+                                                 end_line=16; end_column=12;
+                                                 law_headings=["Test modules + inclusions 1"]}])))
+    | Eoption.ESome arg_ -> arg_ in
   let e1_: Enum1.t =
-    try
+    match
-      (handle_default
+      (match
-         [|{filename="tests/modules/good/mod_def.catala_en";
+         (handle_exceptions
-            start_line=30; start_column=24; end_line=30; end_column=29;
+            [|{filename="tests/modules/good/mod_def.catala_en";
-            law_headings=["Test modules + inclusions 1"]}|]
+               start_line=17; start_column=10; end_line=17; end_column=12;
-         ([|(fun (_: unit) ->
+               law_headings=["Test modules + inclusions 1"]}|]
-               handle_default [||] ([||]) (fun (_: unit) -> true)
+            ([|(match
-                 (fun (_: unit) -> Enum1.Maybe ()))|])
+                  (handle_exceptions
-         (fun (_: unit) -> false) (fun (_: unit) -> raise Empty))
+                     [|{filename="tests/modules/good/mod_def.catala_en";
-    with Empty ->
+                        start_line=30; start_column=24;
-    (raise
+                        end_line=30; end_column=29;
-    (Runtime_ocaml.Runtime.Error (NoValue, [{filename="tests/modules/good/mod_def.catala_en";
+                        law_headings=["Test modules + inclusions 1"]}|]
-                                             start_line=17; start_column=10;
+                     ([||]))
-                                             end_line=17; end_column=12;
+                with
-                                             law_headings=["Test modules + inclusions 1"]}])))
+                | Eoption.ENone _ ->
-    in
+                    ( if true then (Eoption.ESome (Enum1.Maybe ())) else
+                       (Eoption.ENone ()))
+                | Eoption.ESome x_ -> (Eoption.ESome x_))|]))
+       with
+       | Eoption.ENone _ ->
+           ( if false then (Eoption.ENone ()) else (Eoption.ENone ()))
+       | Eoption.ESome x_ -> (Eoption.ESome x_))
+    with
+    | Eoption.ENone _ -> (raise
+        (Runtime_ocaml.Runtime.Error (NoValue, [{filename="tests/modules/good/mod_def.catala_en";
+                                                 start_line=17; start_column=10;
+                                                 end_line=17; end_column=12;
+                                                 law_headings=["Test modules + inclusions 1"]}])))
+    | Eoption.ESome arg_ -> arg_ in
   {S.sr = sr_; S.e1 = e1_}
 
 let half_ : integer -> decimal =

tests/monomorphisation/context_var.catala_en

@@ -0,0 +1,111 @@
+## Testing monomorphisation on context variables
+
+```catala
+declaration scope TestXor:
+  context output t content boolean
+
+scope TestXor:
+  definition t equals true
+```
+
+```catala-test-inline
+$ catala lcalc --monomorphize-types
+type option_1 = | None_1 of unit | Some_1 of bool
+
+type TestXor_in = { t_in: unit → option_1[None_1: unit | Some_1: bool]; }
+type TestXor = { t: bool; }
+type array_1 = {
+  content: list of option_1[None_1: unit | Some_1: bool];
+  length: integer;
+}
+
+let scope TestXor
+  (TestXor_in:
+     TestXor_in {t_in: unit → option_1[None_1: unit | Some_1: bool]})
+  : TestXor {t: bool}
+  =
+  let get t : unit → option_1[None_1: unit | Some_1: bool] =
+    TestXor_in.t_in
+  in
+  let set t : bool =
+    match
+      (match
+         (handle_exceptions { array_1 content = [t ()]; length = 1; })
+       with
+       | None_1 →
+         if true then
+           Some_1
+             (match
+                (match
+                   (handle_exceptions
+                      { array_1
+                        content =
+                          [
+                            match
+                              (handle_exceptions
+                                 { array_1 content = []; length = 0; })
+                            with
+                            | None_1 →
+                              if true then Some_1 true else None_1 ()
+                            | Some_1 x → Some_1 x
+                          ];
+                        length = 1;
+                      })
+                 with
+                 | None_1 → if false then None_1 () else None_1 ()
+                 | Some_1 x → Some_1 x)
+              with
+              | None_1 → error NoValue
+              | Some_1 arg → arg)
+         else None_1 ()
+       | Some_1 x → Some_1 x)
+    with
+    | None_1 → error NoValue
+    | Some_1 arg → arg
+  in
+  return { TestXor t = t; }
+
+```
+
+```catala
+declaration scope TestXor2:
+  t scope TestXor
+  output o content boolean
+
+scope TestXor2:
+  definition o equals t.t
+```
+
+```catala-test-inline
+$ catala lcalc --monomorphize-types -s TestXor2
+let scope TestXor2 (TestXor2_in: TestXor2_in): TestXor2 {o: bool} =
+  let set t : TestXor {t: bool} =
+    let result : TestXor = TestXor { TestXor_in t_in = λ () → None_1 (); } in
+    let result1 : TestXor = { TestXor t = result.t; } in
+    if true then result1 else result1
+  in
+  let set o : bool =
+    match
+      (match
+         (handle_exceptions
+            { array_1
+              content =
+                [
+                  match
+                    (handle_exceptions { array_1 content = []; length = 0; })
+                  with
+                  | None_1 → if true then Some_1 t.t else None_1 ()
+                  | Some_1 x → Some_1 x
+                ];
+              length = 1;
+            })
+       with
+       | None_1 → if false then None_1 () else None_1 ()
+       | Some_1 x → Some_1 x)
+    with
+    | None_1 → error NoValue
+    | Some_1 arg → arg
+  in
+  return { TestXor2 o = o; }
+```
+

tests/name_resolution/good/let_in2.catala_en

@@ -47,44 +47,66 @@ module S = struct
 end
 
 module S_in = struct
-  type t = {a_in: unit -> bool}
+  type t = {a_in: unit -> (bool) Eoption.t}
 end
 
 
 let s (s_in: S_in.t) : S.t =
-  let a_: unit -> bool = s_in.S_in.a_in in
+  let a_: unit -> (bool) Eoption.t = s_in.S_in.a_in in
   let a_: bool =
-    try
+    match
-      (handle_default
+      (match
-         [|{filename="tests/name_resolution/good/let_in2.catala_en";
+         (handle_exceptions
-            start_line=7; start_column=18; end_line=7; end_column=19;
+            [|{filename="tests/name_resolution/good/let_in2.catala_en";
-            law_headings=["Article"]}|] ([|(fun (_: unit) -> a_ ())|])
+               start_line=7; start_column=18; end_line=7; end_column=19;
-         (fun (_: unit) -> true)
+               law_headings=["Article"]}|] ([|(a_ ())|]))
-         (fun (_: unit) ->
+       with
-            try
+       | Eoption.ENone _ ->
-              (handle_default
+           ( if true then
-                 [|{filename="tests/name_resolution/good/let_in2.catala_en";
+              (Eoption.ESome
-                    start_line=11; start_column=5; end_line=13; end_column=6;
+                 (match
-                    law_headings=["Article"]}|]
+                    (match
-                 ([|(fun (_: unit) ->
+                       (handle_exceptions
-                       handle_default [||] ([||]) (fun (_: unit) -> true)
+                          [|{filename="tests/name_resolution/good/let_in2.catala_en";
-                         (fun (_: unit) -> (let a_ : bool = false
+                             start_line=7; start_column=18;
-                            in
+                             end_line=7; end_column=19;
-                            (let a_ : bool = (o_or a_ true) in
+                             law_headings=["Article"]}|]
-                            a_))))|]) (fun (_: unit) -> false)
+                          ([|(match
-                 (fun (_: unit) -> raise Empty))
+                                (handle_exceptions
-            with Empty ->
+                                   [|{filename="tests/name_resolution/good/let_in2.catala_en";
-            (raise
+                                      start_line=11; start_column=5;
-            (Runtime_ocaml.Runtime.Error (NoValue, [{filename="tests/name_resolution/good/let_in2.catala_en";
+                                      end_line=13; end_column=6;
-                                                     start_line=7; start_column=18;
+                                      law_headings=["Article"]}|] ([||]))
-                                                     end_line=7; end_column=19;
+                              with
-                                                     law_headings=["Article"]}])))))
+                              | Eoption.ENone _ ->
-    with Empty ->
+                                  ( if true then
-    (raise
+                                     (Eoption.ESome (let a_ : bool = false
-    (Runtime_ocaml.Runtime.Error (NoValue, [{filename="tests/name_resolution/good/let_in2.catala_en";
+                                        in
-                                             start_line=7; start_column=18;
+                                        (let a_ : bool = (o_or a_ true)
-                                             end_line=7; end_column=19;
+                                        in
-                                             law_headings=["Article"]}]))) in
+                                        a_))) else (Eoption.ENone ()))
+                              | Eoption.ESome x_ -> (Eoption.ESome x_))|]))
+                     with
+                     | Eoption.ENone _ ->
+                         ( if false then (Eoption.ENone ()) else
+                            (Eoption.ENone ()))
+                     | Eoption.ESome x_ -> (Eoption.ESome x_))
+                  with
+                  | Eoption.ENone _ -> (raise
+                      (Runtime_ocaml.Runtime.Error (NoValue, [{filename="tests/name_resolution/good/let_in2.catala_en";
+                                                               start_line=7; start_column=18;
+                                                               end_line=7; end_column=19;
+                                                               law_headings=
+                                                               ["Article"]}])))
+                  | Eoption.ESome arg_ -> arg_)) else (Eoption.ENone ()))
+       | Eoption.ESome x_ -> (Eoption.ESome x_))
+    with
+    | Eoption.ENone _ -> (raise
+        (Runtime_ocaml.Runtime.Error (NoValue, [{filename="tests/name_resolution/good/let_in2.catala_en";
+                                                 start_line=7; start_column=18;
+                                                 end_line=7; end_column=19;
+                                                 law_headings=["Article"]}])))
+    | Eoption.ESome arg_ -> arg_ in
   {S.a = a_}
 
 let () =

tests/name_resolution/good/toplevel_defs.catala_en

@@ -107,144 +107,164 @@ $ catala test-scope S4
 
 ```catala-test-inline
 $ catala scalc
-let glob1_2 = 44.12
+let glob1_1 = 44.12
 
-let glob3_3 (x_3: money) = return to_rat x_3 + 10.
+let glob3_1 (x_2: money) = return to_rat x_2 + 10.
 
-let glob4_4 (x_4: money) (y_5: decimal) = return to_rat x_4 * y_5 + 10.
+let glob4_2 (x_3: money) (y_4: decimal) = return to_rat x_3 * y_4 + 10.
 
-let glob5_aux_5 =
+let glob5_aux_3 =
-  decl x_7 : decimal;
+  decl x_6 : decimal;
-  x_7 = to_rat 2 * 3.;
+  x_6 = to_rat 2 * 3.;
-  decl y_8 : decimal;
+  decl y_7 : decimal;
-  y_8 = 1000.;
+  y_7 = 1000.;
-  return x_7 * y_8
+  return x_6 * y_7
 
-let glob5_6 = glob5_aux_5 ()
+let glob5_5 = glob5_aux_3 ()
 
-let glob2_9 = A {"y": glob1_2 >= 30., "z": 123. * 17.}
+let glob2_8 = A {"y": glob1_1 >= 30., "z": 123. * 17.}
 
-let S2_6 (S2_in_10: S2_in) =
+let S2_4 (S2_in_9: S2_in) =
-  decl temp_a_12 : decimal;
+  decl temp_a_11 : decimal;
-  try:
+  decl temp_a_12 : option decimal;
-    decl temp_a_13 : unit → decimal;
+  decl temp_a_13 : option decimal;
-    let func temp_a_13 (__14 : unit) =
+  switch handle_exceptions []:
-      decl temp_a_15 : unit → bool;
+  | ENone __14 →
-      let func temp_a_15 (__16 : unit) =
+    if true:
-        return true;
+      temp_a_13 = ESome glob3_1 ¤44.00 + 100.
-      decl temp_a_17 : unit → decimal;
+      else:
-      let func temp_a_17 (__18 : unit) =
+        temp_a_13 = ENone ()
-        return glob3_3 ¤44.00 + 100.;
+  | ESome x_15 →
-      return handle_default [] temp_a_15 temp_a_17;
+    temp_a_13 = ESome x_15;
-    decl temp_a_19 : unit → bool;
+  switch handle_exceptions [temp_a_13]:
-    let func temp_a_19 (__20 : unit) =
+  | ENone __16 →
-      return false;
+    if false:
-    decl temp_a_21 : unit → decimal;
+      temp_a_12 = ENone ()
-    let func temp_a_21 (__22 : unit) =
+      else:
-      raise Empty;
+        temp_a_12 = ENone ()
-    temp_a_12 = handle_default [temp_a_13] temp_a_19 temp_a_21
+  | ESome x_17 →
-  with Empty:
+    temp_a_12 = ESome x_17;
-    fatal NoValue;
+  switch temp_a_12:
-  decl a_11 : decimal;
+  | ENone __18 →
-  a_11 = temp_a_12;
+    fatal NoValue
-  return S2 {"a": a_11}
+  | ESome arg_19 →
+    temp_a_11 = arg_19;
+  decl a_10 : decimal;
+  a_10 = temp_a_11;
+  return S2 {"a": a_10}
 
-let S3_7 (S3_in_23: S3_in) =
+let S3_5 (S3_in_20: S3_in) =
-  decl temp_a_25 : decimal;
+  decl temp_a_22 : decimal;
-  try:
+  decl temp_a_23 : option decimal;
-    decl temp_a_26 : unit → decimal;
+  decl temp_a_24 : option decimal;
-    let func temp_a_26 (__27 : unit) =
+  switch handle_exceptions []:
-      decl temp_a_28 : unit → bool;
+  | ENone __25 →
-      let func temp_a_28 (__29 : unit) =
+    if true:
-        return true;
+      temp_a_24 = ESome 50. + glob4_2 ¤44.00 55.
-      decl temp_a_30 : unit → decimal;
+      else:
-      let func temp_a_30 (__31 : unit) =
+        temp_a_24 = ENone ()
-        return 50. + glob4_4 ¤44.00 55.;
+  | ESome x_26 →
-      return handle_default [] temp_a_28 temp_a_30;
+    temp_a_24 = ESome x_26;
-    decl temp_a_32 : unit → bool;
+  switch handle_exceptions [temp_a_24]:
-    let func temp_a_32 (__33 : unit) =
+  | ENone __27 →
-      return false;
+    if false:
-    decl temp_a_34 : unit → decimal;
+      temp_a_23 = ENone ()
-    let func temp_a_34 (__35 : unit) =
+      else:
-      raise Empty;
+        temp_a_23 = ENone ()
-    temp_a_25 = handle_default [temp_a_26] temp_a_32 temp_a_34
+  | ESome x_28 →
-  with Empty:
+    temp_a_23 = ESome x_28;
-    fatal NoValue;
+  switch temp_a_23:
-  decl a_24 : decimal;
+  | ENone __29 →
-  a_24 = temp_a_25;
+    fatal NoValue
-  return S3 {"a": a_24}
+  | ESome arg_30 →
+    temp_a_22 = arg_30;
+  decl a_21 : decimal;
+  a_21 = temp_a_22;
+  return S3 {"a": a_21}
 
-let S4_8 (S4_in_36: S4_in) =
+let S4_6 (S4_in_31: S4_in) =
-  decl temp_a_38 : decimal;
+  decl temp_a_33 : decimal;
-  try:
+  decl temp_a_34 : option decimal;
-    decl temp_a_39 : unit → decimal;
+  decl temp_a_35 : option decimal;
-    let func temp_a_39 (__40 : unit) =
+  switch handle_exceptions []:
-      decl temp_a_41 : unit → bool;
+  | ENone __36 →
-      let func temp_a_41 (__42 : unit) =
+    if true:
-        return true;
+      temp_a_35 = ESome glob5_5 + 1.
-      decl temp_a_43 : unit → decimal;
+      else:
-      let func temp_a_43 (__44 : unit) =
+        temp_a_35 = ENone ()
-        return glob5_6 + 1.;
+  | ESome x_37 →
-      return handle_default [] temp_a_41 temp_a_43;
+    temp_a_35 = ESome x_37;
-    decl temp_a_45 : unit → bool;
+  switch handle_exceptions [temp_a_35]:
-    let func temp_a_45 (__46 : unit) =
+  | ENone __38 →
-      return false;
+    if false:
-    decl temp_a_47 : unit → decimal;
+      temp_a_34 = ENone ()
-    let func temp_a_47 (__48 : unit) =
+      else:
-      raise Empty;
+        temp_a_34 = ENone ()
-    temp_a_38 = handle_default [temp_a_39] temp_a_45 temp_a_47
+  | ESome x_39 →
-  with Empty:
+    temp_a_34 = ESome x_39;
-    fatal NoValue;
+  switch temp_a_34:
-  decl a_37 : decimal;
+  | ENone __40 →
-  a_37 = temp_a_38;
+    fatal NoValue
-  return S4 {"a": a_37}
+  | ESome arg_41 →
+    temp_a_33 = arg_41;
+  decl a_32 : decimal;
+  a_32 = temp_a_33;
+  return S4 {"a": a_32}
 
-let S_9 (S_in_49: S_in) =
+let S_7 (S_in_42: S_in) =
-  decl temp_a_63 : decimal;
+  decl temp_a_54 : decimal;
-  try:
+  decl temp_a_55 : option decimal;
-    decl temp_a_64 : unit → decimal;
+  decl temp_a_56 : option decimal;
-    let func temp_a_64 (__65 : unit) =
+  switch handle_exceptions []:
-      decl temp_a_66 : unit → bool;
+  | ENone __57 →
-      let func temp_a_66 (__67 : unit) =
+    if true:
-        return true;
+      temp_a_56 = ESome glob1_1 * glob1_1
-      decl temp_a_68 : unit → decimal;
+      else:
-      let func temp_a_68 (__69 : unit) =
+        temp_a_56 = ENone ()
-        return glob1_2 * glob1_2;
+  | ESome x_58 →
-      return handle_default [] temp_a_66 temp_a_68;
+    temp_a_56 = ESome x_58;
-    decl temp_a_70 : unit → bool;
+  switch handle_exceptions [temp_a_56]:
-    let func temp_a_70 (__71 : unit) =
+  | ENone __59 →
-      return false;
+    if false:
-    decl temp_a_72 : unit → decimal;
+      temp_a_55 = ENone ()
-    let func temp_a_72 (__73 : unit) =
+      else:
-      raise Empty;
+        temp_a_55 = ENone ()
-    temp_a_63 = handle_default [temp_a_64] temp_a_70 temp_a_72
+  | ESome x_60 →
-  with Empty:
+    temp_a_55 = ESome x_60;
-    fatal NoValue;
+  switch temp_a_55:
-  decl a_50 : decimal;
+  | ENone __61 →
-  a_50 = temp_a_63;
+    fatal NoValue
-  decl temp_b_52 : A {y: bool; z: decimal};
+  | ESome arg_62 →
-  try:
+    temp_a_54 = arg_62;
-    decl temp_b_53 : unit → A {y: bool; z: decimal};
+  decl a_43 : decimal;
-    let func temp_b_53 (__54 : unit) =
+  a_43 = temp_a_54;
-      decl temp_b_55 : unit → bool;
+  decl temp_b_45 : A {y: bool; z: decimal};
-      let func temp_b_55 (__56 : unit) =
+  decl temp_b_46 : option A {y: bool; z: decimal};
-        return true;
+  decl temp_b_47 : option A {y: bool; z: decimal};
-      decl temp_b_57 : unit → A {y: bool; z: decimal};
+  switch handle_exceptions []:
-      let func temp_b_57 (__58 : unit) =
+  | ENone __48 →
-        return glob2_9;
+    if true:
-      return handle_default [] temp_b_55 temp_b_57;
+      temp_b_47 = ESome glob2_8
-    decl temp_b_59 : unit → bool;
+      else:
-    let func temp_b_59 (__60 : unit) =
+        temp_b_47 = ENone ()
-      return false;
+  | ESome x_49 →
-    decl temp_b_61 : unit → A {y: bool; z: decimal};
+    temp_b_47 = ESome x_49;
-    let func temp_b_61 (__62 : unit) =
+  switch handle_exceptions [temp_b_47]:
-      raise Empty;
+  | ENone __50 →
-    temp_b_52 = handle_default [temp_b_53] temp_b_59 temp_b_61
+    if false:
-  with Empty:
+      temp_b_46 = ENone ()
-    fatal NoValue;
+      else:
-  decl b_51 : A {y: bool; z: decimal};
+        temp_b_46 = ENone ()
-  b_51 = temp_b_52;
+  | ESome x_51 →
-  return S {"a": a_50, "b": b_51}
+    temp_b_46 = ESome x_51;
+  switch temp_b_46:
+  | ENone __52 →
+    fatal NoValue
+  | ESome arg_53 →
+    temp_b_45 = arg_53;
+  decl b_44 : A {y: bool; z: decimal};
+  b_44 = temp_b_45;
+  return S {"a": a_43, "b": b_44}
 ```
 
 ```catala-test-inline
@@ -423,155 +443,205 @@ glob2 = (
     decimal_of_string("30.")),
     z = (decimal_of_string("123.") *
     decimal_of_string("17.")))
-    )
+)
 
 def s2(s2_in:S2In):
-    try:
+    perhaps_none_arg = handle_exceptions([], [])
-        def temp_a(_:Unit):
+    if perhaps_none_arg is None:
-            def temp_a_1(_:Unit):
+        if True:
-                return True
+            temp_a = (glob3(money_of_cents_string("4400")) +
-            def temp_a_2(_:Unit):
+                decimal_of_string("100."))
-                return (glob3(money_of_cents_string("4400")) +
+        else:
-                    decimal_of_string("100."))
+            temp_a = None
-            return handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+    else:
+        x_3 = perhaps_none_arg
+        temp_a = x_3
+    perhaps_none_arg_1 = handle_exceptions(
+                             [SourcePosition(
+                                  filename="tests/name_resolution/good/toplevel_defs.catala_en",
                                   start_line=53, start_column=24,
                                   end_line=53, end_column=43,
-                                  law_headings=["Test toplevel function defs"]), [],
+                                  law_headings=["Test toplevel function defs"]
-                                  temp_a_1, temp_a_2)
+                              )],
-        def temp_a_3(_:Unit):
+                             [temp_a]
-            return False
+                         )
-        def temp_a_4(_:Unit):
+    if perhaps_none_arg_1 is None:
-            raise Empty
+        if False:
-        temp_a_5 = handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+            temp_a_1 = None
-                                  start_line=50, start_column=10,
+        else:
-                                  end_line=50, end_column=11,
+            temp_a_1 = None
-                                  law_headings=["Test toplevel function defs"]), [temp_a],
+    else:
-                                  temp_a_3, temp_a_4)
+        x_4 = perhaps_none_arg_1
-    except Empty:
+        temp_a_1 = x_4
+    perhaps_none_arg_2 = temp_a_1
+    if perhaps_none_arg_2 is None:
         raise NoValue(SourcePosition(
                           filename="tests/name_resolution/good/toplevel_defs.catala_en",
                           start_line=50, start_column=10,
                           end_line=50, end_column=11,
                           law_headings=["Test toplevel function defs"]))
-    a = temp_a_5
+    else:
+        arg = perhaps_none_arg_2
+        temp_a_2 = arg
+    a = temp_a_2
     return S2(a = a)
 
 def s3(s3_in:S3In):
-    try:
+    perhaps_none_arg_3 = handle_exceptions([], [])
-        def temp_a_6(_:Unit):
+    if perhaps_none_arg_3 is None:
-            def temp_a_7(_:Unit):
+        if True:
-                return True
+            temp_a_3 = (decimal_of_string("50.") +
-            def temp_a_8(_:Unit):
+                glob4(money_of_cents_string("4400"),
-                return (decimal_of_string("50.") +
+                      decimal_of_string("55.")))
-                    glob4(money_of_cents_string("4400"),
+        else:
-                          decimal_of_string("55.")))
+            temp_a_3 = None
-            return handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+    else:
+        x_5 = perhaps_none_arg_3
+        temp_a_3 = x_5
+    perhaps_none_arg_4 = handle_exceptions(
+                             [SourcePosition(
+                                  filename="tests/name_resolution/good/toplevel_defs.catala_en",
                                   start_line=74, start_column=24,
                                   end_line=74, end_column=47,
-                                  law_headings=["Test function def with two args"]), [],
+                                  law_headings=["Test function def with two args"]
-                                  temp_a_7, temp_a_8)
+                              )],
-        def temp_a_9(_:Unit):
+                             [temp_a_3]
-            return False
+                         )
-        def temp_a_10(_:Unit):
+    if perhaps_none_arg_4 is None:
-            raise Empty
+        if False:
-        temp_a_11 = handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+            temp_a_4 = None
-                                   start_line=71, start_column=10,
+        else:
-                                   end_line=71, end_column=11,
+            temp_a_4 = None
-                                   law_headings=["Test function def with two args"]), [temp_a_6],
+    else:
-                                   temp_a_9, temp_a_10)
+        x_6 = perhaps_none_arg_4
-    except Empty:
+        temp_a_4 = x_6
+    perhaps_none_arg_5 = temp_a_4
+    if perhaps_none_arg_5 is None:
         raise NoValue(SourcePosition(
                           filename="tests/name_resolution/good/toplevel_defs.catala_en",
                           start_line=71, start_column=10,
                           end_line=71, end_column=11,
                           law_headings=["Test function def with two args"]))
-    a_1 = temp_a_11
+    else:
+        arg_1 = perhaps_none_arg_5
+        temp_a_5 = arg_1
+    a_1 = temp_a_5
     return S3(a = a_1)
 
 def s4(s4_in:S4In):
-    try:
+    perhaps_none_arg_6 = handle_exceptions([], [])
-        def temp_a_12(_:Unit):
+    if perhaps_none_arg_6 is None:
-            def temp_a_13(_:Unit):
+        if True:
-                return True
+            temp_a_6 = (glob5 + decimal_of_string("1."))
-            def temp_a_14(_:Unit):
+        else:
-                return (glob5 + decimal_of_string("1."))
+            temp_a_6 = None
-            return handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+    else:
+        x_7 = perhaps_none_arg_6
+        temp_a_6 = x_7
+    perhaps_none_arg_7 = handle_exceptions(
+                             [SourcePosition(
+                                  filename="tests/name_resolution/good/toplevel_defs.catala_en",
                                   start_line=98, start_column=24,
                                   end_line=98, end_column=34,
-                                  law_headings=["Test inline defs in toplevel defs"]), [],
+                                  law_headings=["Test inline defs in toplevel defs"]
-                                  temp_a_13, temp_a_14)
+                              )],
-        def temp_a_15(_:Unit):
+                             [temp_a_6]
-            return False
+                         )
-        def temp_a_16(_:Unit):
+    if perhaps_none_arg_7 is None:
-            raise Empty
+        if False:
-        temp_a_17 = handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+            temp_a_7 = None
-                                   start_line=95, start_column=10,
+        else:
-                                   end_line=95, end_column=11,
+            temp_a_7 = None
-                                   law_headings=["Test inline defs in toplevel defs"]), [temp_a_12],
+    else:
-                                   temp_a_15, temp_a_16)
+        x_8 = perhaps_none_arg_7
-    except Empty:
+        temp_a_7 = x_8
+    perhaps_none_arg_8 = temp_a_7
+    if perhaps_none_arg_8 is None:
         raise NoValue(SourcePosition(
                           filename="tests/name_resolution/good/toplevel_defs.catala_en",
                           start_line=95, start_column=10,
                           end_line=95, end_column=11,
                           law_headings=["Test inline defs in toplevel defs"]))
-    a_2 = temp_a_17
+    else:
+        arg_2 = perhaps_none_arg_8
+        temp_a_8 = arg_2
+    a_2 = temp_a_8
     return S4(a = a_2)
 
 def s(s_in:SIn):
-    try:
+    perhaps_none_arg_9 = handle_exceptions([], [])
-        def temp_a_18(_:Unit):
+    if perhaps_none_arg_9 is None:
-            def temp_a_19(_:Unit):
+        if True:
-                return True
+            temp_a_9 = (glob1 * glob1)
-            def temp_a_20(_:Unit):
+        else:
-                return (glob1 * glob1)
+            temp_a_9 = None
-            return handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+    else:
-                                  start_line=18, start_column=24,
+        x_9 = perhaps_none_arg_9
-                                  end_line=18, end_column=37,
+        temp_a_9 = x_9
-                                  law_headings=["Test basic toplevel values defs"]), [],
+    perhaps_none_arg_10 = handle_exceptions(
-                                  temp_a_19, temp_a_20)
+                              [SourcePosition(
-        def temp_a_21(_:Unit):
+                                   filename="tests/name_resolution/good/toplevel_defs.catala_en",
-            return False
+                                   start_line=18, start_column=24,
-        def temp_a_22(_:Unit):
+                                   end_line=18, end_column=37,
-            raise Empty
+                                   law_headings=["Test basic toplevel values defs"]
-        temp_a_23 = handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+                               )],
-                                   start_line=7, start_column=10,
+                              [temp_a_9]
-                                   end_line=7, end_column=11,
+                          )
-                                   law_headings=["Test basic toplevel values defs"]), [temp_a_18],
+    if perhaps_none_arg_10 is None:
-                                   temp_a_21, temp_a_22)
+        if False:
-    except Empty:
+            temp_a_10 = None
+        else:
+            temp_a_10 = None
+    else:
+        x_10 = perhaps_none_arg_10
+        temp_a_10 = x_10
+    perhaps_none_arg_11 = temp_a_10
+    if perhaps_none_arg_11 is None:
         raise NoValue(SourcePosition(
                           filename="tests/name_resolution/good/toplevel_defs.catala_en",
                           start_line=7, start_column=10,
                           end_line=7, end_column=11,
                           law_headings=["Test basic toplevel values defs"]))
-    a_3 = temp_a_23
+    else:
-    try:
+        arg_3 = perhaps_none_arg_11
-        def temp_b(_:Unit):
+        temp_a_11 = arg_3
-            def temp_b_1(_:Unit):
+    a_3 = temp_a_11
-                return True
+    perhaps_none_arg_12 = handle_exceptions([], [])
-            def temp_b_2(_:Unit):
+    if perhaps_none_arg_12 is None:
-                return glob2
+        if True:
-            return handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+            temp_b = glob2
-                                  start_line=19, start_column=24,
+        else:
-                                  end_line=19, end_column=29,
+            temp_b = None
-                                  law_headings=["Test basic toplevel values defs"]), [],
+    else:
-                                  temp_b_1, temp_b_2)
+        x_11 = perhaps_none_arg_12
-        def temp_b_3(_:Unit):
+        temp_b = x_11
-            return False
+    perhaps_none_arg_13 = handle_exceptions(
-        def temp_b_4(_:Unit):
+                              [SourcePosition(
-            raise Empty
+                                   filename="tests/name_resolution/good/toplevel_defs.catala_en",
-        temp_b_5 = handle_default(SourcePosition(filename="tests/name_resolution/good/toplevel_defs.catala_en",
+                                   start_line=19, start_column=24,
-                                  start_line=8, start_column=10,
+                                   end_line=19, end_column=29,
-                                  end_line=8, end_column=11,
+                                   law_headings=["Test basic toplevel values defs"]
-                                  law_headings=["Test basic toplevel values defs"]), [temp_b],
+                               )],
-                                  temp_b_3, temp_b_4)
+                              [temp_b]
-    except Empty:
+                          )
+    if perhaps_none_arg_13 is None:
+        if False:
+            temp_b_1 = None
+        else:
+            temp_b_1 = None
+    else:
+        x_12 = perhaps_none_arg_13
+        temp_b_1 = x_12
+    perhaps_none_arg_14 = temp_b_1
+    if perhaps_none_arg_14 is None:
         raise NoValue(SourcePosition(
                           filename="tests/name_resolution/good/toplevel_defs.catala_en",
                           start_line=8, start_column=10,
                           end_line=8, end_column=11,
                           law_headings=["Test basic toplevel values defs"]))
-    b = temp_b_5
+    else:
+        arg_4 = perhaps_none_arg_14
+        temp_b_2 = arg_4
+    b = temp_b_2
     return S(a = a_3, b = b)
 ```

tests/scope/good/nothing.catala_en

@@ -39,11 +39,11 @@ $ catala Scalc -s Foo2 -O -t
 │ 5 │   output bar content integer
 │   │          ‾‾‾
 └─ Test
-let Foo2_3 (Foo2_in_2: Foo2_in) =
+let Foo2_1 (Foo2_in_1: Foo2_in) =
-  decl temp_bar_4 : integer;
+  decl temp_bar_3 : integer;
   fatal NoValue;
-  decl bar_3 : integer;
+  decl bar_2 : integer;
-  bar_3 = temp_bar_4;
+  bar_2 = temp_bar_3;
-  return Foo2 {"bar": bar_3}
+  return Foo2 {"bar": bar_2}
 
 ```

tests/scope/good/scope_call4.catala_en

@@ -68,7 +68,7 @@ $ catala interpret -s RentComputation --debug
 ```
 
 ```catala-test-inline
-$ catala Interpret --lcalc -s RentComputation --avoid-exceptions --optimize --debug
+$ catala Interpret --lcalc -s RentComputation --optimize --debug
 [DEBUG] = INIT =
 [DEBUG] = SURFACE =
 [DEBUG] Parsing "tests/scope/good/scope_call4.catala_en"

tests/scope/good/simple.catala_en

@@ -24,12 +24,20 @@ $ catala Typecheck --check-invariants
 $ catala Lcalc -s Foo
 let scope Foo (Foo_in: Foo_in): Foo {bar: integer} =
   let set bar : integer =
-    try
+    match
-      handle_default
+      (match
-        [λ () → handle_default [] (λ () → true) (λ () → 0)]
+         (handle_exceptions
-        (λ () → false)
+            [
-        (λ () → raise Empty)
+              match (handle_exceptions []) with
-    with Empty -> error NoValue
+              | ENone → if true then ESome 0 else ENone ()
+              | ESome x → ESome x
+            ])
+       with
+       | ENone → if false then ENone () else ENone ()
+       | ESome x → ESome x)
+    with
+    | ENone → error NoValue
+    | ESome arg → arg
   in
   return { Foo bar = bar; }
 ```