before any issues with mark on code_item

.nix/catala.nix

@@ -25,6 +25,7 @@
 , z3
 , zarith
 , zarith_stubs_js
+, cohttp-lwt-unix
 }:
 
 buildDunePackage {
@@ -61,6 +62,7 @@ buildDunePackage {
     z3
     zarith
     zarith_stubs_js
+    cohttp-lwt-unix
   ];
 
   # Currently there is no unit tests in catala and Cram tests are handled by clerk

compiler/catala_utils/dune

@@ -1,7 +1,9 @@
 (library
  (name catala_utils)
  (public_name catala.catala_utils)
- (libraries cmdliner ubase ANSITerminal re bindlib catala.runtime_ocaml))
+ (libraries cmdliner ubase ANSITerminal re bindlib catala.runtime_ocaml)
+ (preprocess
+  (pps ppx_yojson_conv)))
 
 (documentation
  (package catala)

compiler/dcalc/from_scopelang.ml

@@ -131,10 +131,11 @@ let merge_defaults
 
 let tag_with_log_entry
     (e : 'm Ast.expr boxed)
-    (l : log_entry)
-    (markings : Uid.MarkedString.info list) : 'm Ast.expr boxed =
-  let m = mark_tany (Marked.get_mark e) (Expr.pos e) in
-  Expr.eapp (Expr.eop (Log (l, markings)) [TAny, Expr.pos e] m) [e] m
+    (_l : log_entry)
+    (_markings : Uid.MarkedString.info list) : 'm Ast.expr boxed =
+  let _m = mark_tany (Marked.get_mark e) (Expr.pos e) in
+  (* Expr.eapp (Expr.eop (Log (l, markings)) [TAny, Expr.pos e] m) [e] m *)
+  e
 
 (* In a list of exceptions, it is normally an error if more than a single one
    apply at the same time. This relaxes this constraint slightly, allowing a
@@ -335,7 +336,7 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
        function and not during its definition, then we're missing the call log
        instructions of the function returned. To avoid this trap, we need to
        rebind the resulting scope output struct by eta-expanding the functions
-       to insert logging instructions*)
+       to insert logging instructions. *)
     let result_var = Var.make "result" in
     let result_eta_expanded_var = Var.make "result" in
     (* result_eta_expanded = { struct_output_function_field = lambda x -> log

compiler/lcalc/ast.ml

@@ -33,7 +33,7 @@ let option_enum_config : typ EnumConstructor.Map.t =
   |> EnumConstructor.Map.add none_constr (TLit TUnit, Pos.no_pos)
   |> EnumConstructor.Map.add some_constr (TAny, Pos.no_pos)
 
-(* FIXME: proper typing in all the constructors below *)
+(* TODO: proper typing in all the constructors below *)
 
 let make_none m =
   let tunit = TLit TUnit, Expr.mark_pos m in

compiler/lcalc/compile_without_exceptions.ml

@@ -54,7 +54,7 @@ type analysis_mark = {
 (* voir sur papier pour voir si ça marche *)
 
 type analysis_info = { unpure_info : bool; unpure_return : bool option }
-(* type analysis_ctx = (dcalc, analysis_info) Var.Map.t *)
+type analysis_ctx = (dcalc, analysis_info) Var.Map.t
 
 let make_new_mark (m : typed mark) ?(unpure_return = None) (unpure : bool) :
     analysis_mark =
@@ -69,16 +69,6 @@ let make_new_mark (m : typed mark) ?(unpure_return = None) (unpure : bool) :
     end;
     { pos = m.pos; ty = m.ty; unpure; unpure_return }
 
-(** [{
-      type struct_ctx_analysis = bool StructField.Map.t StructName.Map.t
-    }]
-
-    [{ let rec detect_unpure_expr = assert false }]
-    [{ let detect_unpure_scope_let = assert false }]
-    [{ let detect_unpure_scope_body = assert false }]
-    [{ let detect_unpure_scopes = assert false }]
-    [{ let detect_unpure_program = assert false }]
-    [{ let detect_unpure_scope_let = assert false }] *)
 let rec detect_unpure_expr ctx (e : (dcalc, typed mark) gexpr) :
     (dcalc, analysis_mark) boxed_gexpr =
   let m = Marked.get_mark e in
@@ -230,6 +220,30 @@ let rec detect_unpure_expr ctx (e : (dcalc, typed mark) gexpr) :
 
 let _ = detect_unpure_expr
 
+(** [{
+      type struct_ctx_analysis = bool StructField.Map.t StructName.Map.t
+    }]
+
+    [{ let rec detect_unpure_expr = assert false }]
+    [{ let detect_unpure_scope_let = assert false }]
+    [{ let detect_unpure_scope_body = assert false }]
+    [{ let detect_unpure_scopes = assert false }]
+    [{ let detect_unpure_program = assert false }]
+    [{ let detect_unpure_scope_let = assert false }] *)
+
+let detect_unpure_code_item (ctx : analysis_ctx) var (code_item : _ code_item) :
+    analysis_ctx * _ code_item Bindlib.box =
+  match code_item with _ -> assert false
+
+let detect_unpure_code_item_list ctx code_items =
+  Scope.fold_map ~f:detect_unpure_code_item ~varf:Fun.id ctx code_items
+
+(* f:('a -> ([< `Dcalc | `Desugared | `Lcalc | `Scopelang ] as 'b, 'c mark)
+   gexpr code_item -> 'a * ([< `Dcalc | `Desugared | `Lcalc | `Scopelang ] as
+   'd, 'e mark) gexpr code_item Bindlib.box) -> varf:(('b, 'c mark) naked_gexpr
+   Bindlib.var -> ('d, 'e mark) naked_gexpr Bindlib.var) -> 'a -> ('b, 'c mark)
+   gexpr code_item_list -> ('d, 'e mark) gexpr code_item_list Bindlib.box *)
+
 type 'm hoists = ('m A.expr, 'm D.expr) Var.Map.t
 (** Hoists definition. It represent bindings between [A.Var.t] and [D.expr]. *)
 

compiler/shared_ast/print.ml

@@ -262,7 +262,7 @@ let var_debug fmt v =
 let var fmt v = Format.pp_print_string fmt (Bindlib.name_of v)
 
 let needs_parens (type a) (e : (a, _) gexpr) : bool =
-  match Marked.unmark e with EAbs _ | EStruct _ -> true | _ -> false
+  match Marked.unmark e with _ -> true
 
 let rec expr_aux :
     type a.
@@ -307,7 +307,7 @@ let rec expr_aux :
     let expr = exprb bnd_ctx in
     let xs_tau = List.mapi (fun i tau -> xs.(i), tau) tys in
     let xs_tau_arg = List.map2 (fun (x, tau) arg -> x, tau, arg) xs_tau args in
-    Format.fprintf fmt "%a%a"
+    Format.fprintf fmt "(%a%a)"
       (Format.pp_print_list
          ~pp_sep:(fun fmt () -> Format.fprintf fmt "")
          (fun fmt (x, tau, arg) ->

flake.nix

@@ -32,6 +32,10 @@
               pkgs.obelisk
               pkgs.ninja
               pkgs.colordiff
+              pkgs.pandoc
+              pkgs.python3.pkgs.pygments
+              pkgs.nodejs
+              pkgs.nodePackages.npm
             ];
           };
         }