fix printing boxes & merge issues

.nix/catala.nix

@@ -26,7 +26,6 @@
 , zarith_stubs_js
 , cohttp-lwt-unix
 , ppx_expect
-, ocaml-crunch
 }:
 
 buildDunePackage {

compiler/catala_utils/cli.ml

@@ -523,9 +523,6 @@ let warning_print (format : ('a, out_channel, unit) format) =
 let warning_format (format : ('a, Format.formatter, unit) format) =
   Format.printf ("%s" ^^ format ^^ "\n%!") (warning_marker ())
 
-let warning_format (format : ('a, Format.formatter, unit) format) =
-  Format.printf ("%s" ^^ format ^^ "\n%!") (warning_marker ())
-
 let result_print (format : ('a, out_channel, unit) format) =
   Printf.printf ("%s" ^^ format ^^ "\n%!") (result_marker ())
 

compiler/catala_utils/cli.mli

@@ -158,4 +158,4 @@ val warning_format : ('a, Format.formatter, unit) format -> 'a
 val result_print : ('a, out_channel, unit) format -> 'a
 val result_format : ('a, Format.formatter, unit) format -> 'a
 val log_print : ('a, out_channel, unit) format -> 'a
-
+val log_format : ('a, Format.formatter, unit) format -> 'a

compiler/dcalc/optimizations.ml

@@ -138,10 +138,9 @@ let rec partial_evaluation (ctx : partial_evaluation_ctx) (e : 'm expr) :
                     args = [(ELit (LBool false), _)];
                   } ),
               _ ) ) ->
-          ELit LEmptyError
+          EEmptyError
         | [], just ->
-          EIfThenElse
-            { cond = just; etrue = cons; efalse = ELit LEmptyError, mark }
+          EIfThenElse { cond = just; etrue = cons; efalse = EEmptyError, mark }
         | excepts, just -> EDefault { excepts; just; cons })
     | EIfThenElse
         {

compiler/lcalc/compile_without_exceptions.ml

@@ -229,7 +229,6 @@ let rec trans ctx (e : 'm D.expr) : (lcalc, 'm mark) boxed_gexpr =
     (* this is to be used with monad_bind. *)
     let _, body = Bindlib.unmbind binder in
     trans ctx body
-
   | EAbs { binder; tys } ->
     (* Every functions of type [a -> b] are translated to a function of type [a
        -> option b] *)
@@ -256,14 +255,8 @@ let rec trans ctx (e : 'm D.expr) : (lcalc, 'm mark) boxed_gexpr =
       (Expr.eop Op.HandleDefaultOpt [TAny, pos; TAny, pos; TAny, pos] m')
       [Expr.earray excepts' m; just'; cons']
       pos
-  | ELit l -> begin
-    match l with
-    | LEmptyError -> monad_empty ~mark
-    (* gadts cannot infer l is in fact lcalc glit. Hence, we explicit it. *)
-    | (LBool _ | LInt _ | LRat _ | LMoney _ | LUnit | LDate _ | LDuration _) as
-      l ->
-      monad_return ~mark (Expr.elit l m)
-  end
+  | ELit l -> monad_return ~mark (Expr.elit l m)
+  | EEmptyError -> monad_empty ~mark
   | EErrorOnEmpty arg ->
     let arg' = trans ctx arg in
     monad_eoe arg' ~mark ~toplevel:false

compiler/shared_ast/scope.ml

@@ -214,6 +214,7 @@ let format_scope_body ?(debug = false) ctx fmt (n, l) : unit =
 
   let var, body = Bindlib.unbind scope_body_expr in
 
+  let _ =
     Format.pp_open_hbox fmt ();
     Print.keyword fmt "let scope";
     Format.pp_print_space fmt ();
@@ -230,12 +231,19 @@ let format_scope_body ?(debug = false) ctx fmt (n, l) : unit =
     (if debug then Print.typ_debug else Print.typ ctx) fmt output_typ;
     Format.pp_print_space fmt ();
     Print.punctuation fmt "=";
+    let _ =
+      Format.pp_open_vbox fmt 2;
       Format.pp_print_cut fmt ();
-  Format.pp_force_newline fmt ();
+      Format.pp_print_cut fmt ();
+      let _ =
         Format.pp_open_vbox fmt 2;
         (format_scope_body_expr ~debug ctx) fmt body;
-  Format.pp_close_box fmt ();
-  Format.pp_close_box fmt ();
+        Format.pp_close_box fmt ()
+      in
+      Format.pp_close_box fmt ()
+    in
+    Format.pp_close_box fmt ()
+  in
   Format.pp_force_newline fmt ()
 
 let format_by_expr