Simplify default tree encoding

compiler/desugared/desugared_to_scope.ml

@@ -248,7 +248,7 @@ let rec rule_tree_to_expr
       Scopelang.Ast.expr Marked.pos Bindlib.box list =
     List.map
       (fun e ->
-        (* There are two levels of boxing her e, the outermost is introduced by
+        (* There are two levels of boxing here, the outermost is introduced by
            the [translate_expr] function for which all of the bindings should
            have been closed by now, so we can safely unbox. *)
         Bindlib.unbox (Bindlib.box_apply (translate_expr ctx) e))
@@ -358,9 +358,12 @@ let translate_def
   in
   let top_list = def_map_to_tree def_info def in
   let top_value =
-    (if is_cond then Ast.always_false_rule else Ast.empty_rule)
-      (Ast.ScopeDef.get_position def_info)
-      is_def_func_param_typ
+    if is_cond then
+      Some
+        (Ast.always_false_rule
+           (Ast.ScopeDef.get_position def_info)
+           is_def_func_param_typ)
+    else None
   in
   if
     Ast.RuleMap.cardinal def = 0
@@ -398,11 +401,24 @@ let translate_def
       (rule_tree_to_expr ~toplevel:true ctx
          (Ast.ScopeDef.get_position def_info)
          (Option.map (fun _ -> Ast.Var.make "param") is_def_func_param_typ)
-         (match top_list with
-         | [] ->
-           (* In this case, there are no rules to define the expression *)
+         (match top_list, top_value with
+         | [], None ->
+           (* In this case, there are no rules to define the expression and no
+              default value so we put an empty rule. *)
+           Leaf [Ast.empty_rule (Marked.get_mark typ) is_def_func_param_typ]
+         | [], Some top_value ->
+           (* In this case, there are no rules to define the expression but a
+              default value so we put it. *)
            Leaf [top_value]
-         | _ -> Node (top_list, [top_value])))
+         | _, Some top_value ->
+           (* When there are rules + a default value, we put the rules as
+              exceptions to the default value *)
+           Node (top_list, [top_value])
+         | [top_tree], None -> top_tree
+         | _, None ->
+           Node
+             ( top_list,
+               [Ast.empty_rule (Marked.get_mark typ) is_def_func_param_typ] )))
 
 (** Translates a scope *)
 let translate_scope (ctx : ctx) (scope : Ast.scope) : Scopelang.Ast.scope_decl =

tests/test_bool/good/output/test_bool.catala_en.Dcalc

@@ -6,10 +6,10 @@ let TestBool_14 :
     let foo_16 : unit → bool = TestBool_in_15."foo_in" in
     let bar_17 : unit → integer = TestBool_in_15."bar_in" in
     let bar_18 : integer = error_empty
-      ⟨bar_17 () | true ⊢ ⟨⟨true ⊢ 1⟩ | false ⊢ ∅ ⟩⟩ in
+      ⟨bar_17 () | true ⊢ ⟨true ⊢ 1⟩⟩ in
     let foo_19 : bool = error_empty
       ⟨foo_16 () | true ⊢
-        ⟨⟨bar_18 < 0 ⊢ false⟩, ⟨bar_18 >= 0 ⊢ true⟩ | false ⊢
+        ⟨⟨bar_18 >= 0 ⊢ true⟩, ⟨bar_18 < 0 ⊢ false⟩ | false ⊢
           ∅ ⟩⟩ in
     TestBool_out {"foo_out"= foo_19; "bar_out"= bar_18} in
 TestBool_14

tests/test_bool/good/output/test_bool.catala_en.Scopelang

@@ -1,5 +1,4 @@
 let scope TestBool (foo: bool|context|output) (bar: integer|context|output) =
-  let bar : integer = reentrant or by default
-    ⟨⟨true ⊢ 1⟩ | false ⊢ ∅ ⟩;
+  let bar : integer = reentrant or by default ⟨true ⊢ 1⟩;
   let foo : bool = reentrant or by default
-    ⟨⟨bar < 0 ⊢ false⟩, ⟨bar >= 0 ⊢ true⟩ | false ⊢ ∅ ⟩
+    ⟨⟨bar >= 0 ⊢ true⟩, ⟨bar < 0 ⊢ false⟩ | false ⊢ ∅ ⟩

tests/test_exception/good/output/groups_of_exceptions.catala_en.scopelang

@@ -1,8 +1,6 @@
 let scope Foo (y: integer|input) (x: integer|internal|output) =
   let x : integer =
-    ⟨⟨⟨⟨⟨y = 4 ⊢ 4⟩, ⟨y = 5 ⊢ 5⟩ | false ⊢ ∅ ⟩ |
-            true ⊢
-            ⟨⟨y = 2 ⊢ 2⟩, ⟨y = 3 ⊢ 3⟩ | false ⊢ ∅ ⟩⟩ |
+    ⟨⟨⟨⟨y = 4 ⊢ 4⟩, ⟨y = 5 ⊢ 5⟩ | false ⊢ ∅ ⟩ |
          true ⊢
-         ⟨⟨y = 0 ⊢ 0⟩, ⟨y = 1 ⊢ 1⟩ | false ⊢ ∅ ⟩⟩ |
-      false ⊢ ∅ ⟩
+         ⟨⟨y = 2 ⊢ 2⟩, ⟨y = 3 ⊢ 3⟩ | false ⊢ ∅ ⟩⟩ |
+      true ⊢ ⟨⟨y = 0 ⊢ 0⟩, ⟨y = 1 ⊢ 1⟩ | false ⊢ ∅ ⟩⟩

tests/test_io/good/output/all_io.catala_en.A.Dcalc

@@ -5,14 +5,10 @@ let A =
     let d_23 : integer = A_in_21."d_in" in
     let e_24 : unit → integer = A_in_21."e_in" in
     let f_25 : unit → integer = A_in_21."f_in" in
-    let a_26 : integer = error_empty ⟨⟨true ⊢ 0⟩ | false ⊢ ∅ ⟩
-      in
-    let b_27 : integer = error_empty
-      ⟨⟨true ⊢ a_26 + 1⟩ | false ⊢ ∅ ⟩ in
+    let a_26 : integer = error_empty ⟨true ⊢ 0⟩ in
+    let b_27 : integer = error_empty ⟨true ⊢ a_26 + 1⟩ in
     let e_28 : integer = error_empty
-      ⟨e_24 () | true ⊢
-        ⟨⟨true ⊢ b_27 + c_22 + d_23 + 1⟩ | false ⊢ ∅ ⟩⟩ in
+      ⟨e_24 () | true ⊢ ⟨true ⊢ b_27 + c_22 + d_23 + 1⟩⟩ in
     let f_29 : integer = error_empty
-      ⟨f_25 () | true ⊢ ⟨⟨true ⊢ e_28 + 1⟩ | false ⊢ ∅ ⟩⟩
-      in
+      ⟨f_25 () | true ⊢ ⟨true ⊢ e_28 + 1⟩⟩ in
     A_out {"b_out"= b_27; "d_out"= d_23; "f_out"= f_29}

tests/test_io/good/output/subscope.catala_en.B.Dcalc

@@ -1,8 +1,7 @@
 let B =
   λ (B_in_27: B_in{}) →
     let a.a_28 : unit → integer = λ (__29: unit) → ∅  in
-    let a.b_30 : integer = error_empty
-      ⟨⟨true ⊢ 2⟩ | false ⊢ ∅ ⟩ in
+    let a.b_30 : integer = error_empty ⟨true ⊢ 2⟩ in
     let result_31 : A_out{"c_out": integer} =
       A_17 (A_in {"a_in"= a.a_28; "b_in"= a.b_30}) in
     let a.c_32 : integer = result_31."c_out" in

tests/test_scope/good/output/191_fix_record_name_confusion.catala_en.OCaml

@@ -34,13 +34,9 @@ let scope_a (scope_a_in: ScopeAIn.t) : ScopeAOut.t =
                     (handle_default ([|(fun (_: _) -> a_ ())|])
                        (fun (_: _) -> true)
                        (fun (_: _) ->
-                          handle_default
-                            ([|(fun (_: _) ->
-                                  handle_default ([||]) (fun (_: _) -> true)
-                                    (fun (_: _) -> true))|])
-                            (fun (_: _) -> false)
-                            (fun (_: _) -> raise EmptyError))) with
-                    EmptyError -> (raise (NoValueProvided
+                          handle_default ([||]) (fun (_: _) -> true)
+                            (fun (_: _) -> true))) with EmptyError -> (raise
+                    (NoValueProvided
                     {filename = "tests/test_scope/good/191_fix_record_name_confusion.catala_en";
                       start_line=5; start_column=18;
                       end_line=5; end_column=19; law_headings=["Article"]}))) in
@@ -55,13 +51,9 @@ let scope_b (scope_b_in: ScopeBIn.t) : ScopeBOut.t =
                     (handle_default ([|(fun (_: _) -> a_ ())|])
                        (fun (_: _) -> true)
                        (fun (_: _) ->
-                          handle_default
-                            ([|(fun (_: _) ->
-                                  handle_default ([||]) (fun (_: _) -> true)
-                                    (fun (_: _) -> scope_a_dot_a_))|])
-                            (fun (_: _) -> false)
-                            (fun (_: _) -> raise EmptyError))) with
-                    EmptyError -> (raise (NoValueProvided
+                          handle_default ([||]) (fun (_: _) -> true)
+                            (fun (_: _) -> scope_a_dot_a_))) with EmptyError
+                    -> (raise (NoValueProvided
                     {filename = "tests/test_scope/good/191_fix_record_name_confusion.catala_en";
                       start_line=8; start_column=11;
                       end_line=8; end_column=12; law_headings=["Article"]}))) in

tests/test_variable_state/good/output/subscope.catala_en.A.Scopelang

@@ -1,6 +1,5 @@
 let scope A (foo_bar: integer|context) (foo_baz: integer|internal)
   (foo_fizz: integer|internal|output) =
-  let foo_bar : integer = reentrant or by default
-    ⟨⟨true ⊢ 1⟩ | false ⊢ ∅ ⟩;
-  let foo_baz : integer = ⟨⟨true ⊢ foo_bar + 1⟩ | false ⊢ ∅ ⟩;
-  let foo_fizz : integer = ⟨⟨true ⊢ foo_baz + 1⟩ | false ⊢ ∅ ⟩
+  let foo_bar : integer = reentrant or by default ⟨true ⊢ 1⟩;
+  let foo_baz : integer = ⟨true ⊢ foo_bar + 1⟩;
+  let foo_fizz : integer = ⟨true ⊢ foo_baz + 1⟩