Beginning to compile specially HandleDefaultOp, Map, Fold, etc. for C

compiler/catala_utils/cli.ml

@@ -395,6 +395,14 @@ module Flags = struct
     & info ["avoid_exceptions"]
         ~doc:"Compiles the default calculus without exceptions."
 
+  let keep_special_ops =
+    value
+    & flag
+    & info ["keep_special_ops"]
+        ~doc:
+          "During the Lcalc->Scalc translation, uses special AST nodes for \
+           higher-order operators rather than nested closures (useful for C)."
+
   let closure_conversion =
     value
     & flag

compiler/catala_utils/cli.mli

@@ -129,6 +129,7 @@ module Flags : sig
   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 include_dirs : raw_file list Term.t
   val disable_counterexamples : bool Term.t
 end

compiler/driver.ml

@@ -284,14 +284,15 @@ module Passes = struct
       ~optimize
       ~check_invariants
       ~avoid_exceptions
-      ~closure_conversion :
+      ~closure_conversion
+      ~keep_special_ops :
       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
     in
     debug_pass_name "scalc";
-    Scalc.From_lcalc.translate_program prg, type_ordering
+    Scalc.From_lcalc.translate_program ~keep_special_ops prg, type_ordering
 end
 
 module Commands = struct
@@ -835,10 +836,11 @@ module Commands = struct
       check_invariants
       avoid_exceptions
       closure_conversion
+      keep_special_ops
       ex_scope_opt =
     let prg, _ =
       Passes.scalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion
+        ~avoid_exceptions ~closure_conversion ~keep_special_ops
     in
     let _output_file, with_output = get_output_format options output in
     with_output
@@ -872,6 +874,7 @@ module Commands = struct
         $ Cli.Flags.check_invariants
         $ Cli.Flags.avoid_exceptions
         $ Cli.Flags.closure_conversion
+        $ Cli.Flags.keep_special_ops
         $ Cli.Flags.ex_scope_opt)
 
   let python
@@ -884,7 +887,7 @@ module Commands = struct
       closure_conversion =
     let prg, type_ordering =
       Passes.scalc options ~includes ~optimize ~check_invariants
-        ~avoid_exceptions ~closure_conversion
+        ~avoid_exceptions ~closure_conversion ~keep_special_ops:false
     in
 
     let output_file, with_output =
@@ -913,7 +916,7 @@ module Commands = struct
   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
+        ~avoid_exceptions:false ~closure_conversion ~keep_special_ops:false
     in
 
     let output_file, with_output = get_output_format options ~ext:".r" output in
@@ -937,7 +940,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
+        ~avoid_exceptions:true ~closure_conversion:true ~keep_special_ops:true
     in
     let output_file, with_output = get_output_format options ~ext:".c" output in
     Message.emit_debug "Compiling program into C...";

compiler/driver.mli

@@ -62,6 +62,7 @@ module Passes : sig
     check_invariants:bool ->
     avoid_exceptions:bool ->
     closure_conversion:bool ->
+    keep_special_ops:bool ->
     Scalc.Ast.program * Scopelang.Dependency.TVertex.t list
 end
 

compiler/scalc/ast.ml

@@ -71,7 +71,9 @@ type stmt =
         list  (** Each block corresponds to one case of the enum *)
   | SReturn of naked_expr
   | SAssert of naked_expr
+  | SSpecialOp of special_operator
 
+and special_operator = OHandleDefaultOpt of expr list * expr * block
 and block = stmt Mark.pos list
 
 and func = {

compiler/scalc/from_lcalc.ml

@@ -344,7 +344,8 @@ let rec translate_scope_body_expr
     @ translate_scope_body_expr scope_name decl_ctx new_var_dict func_dict
         scope_let_next
 
-let translate_program (p : 'm L.program) : A.program =
+let translate_program ~(keep_special_ops : bool) (p : 'm L.program) : A.program
+    =
   let _, _, rev_items =
     Scope.fold_left
       ~f:(fun (func_dict, var_dict, rev_items) code_item var ->

compiler/scalc/from_lcalc.mli

@@ -16,4 +16,9 @@
 
 open Shared_ast
 
-val translate_program : untyped Lcalc.Ast.program -> Ast.program
+(* When [keep_special_ops] is true, then this translation uses special Scalc AST
+   nodes for higher-order operators like map, fold, handle_default, etc. This is
+   useful if the target language after Scalc does not support nested functions
+   like C. *)
+val translate_program :
+  keep_special_ops:bool -> untyped Lcalc.Ast.program -> Ast.program

compiler/scalc/print.ml

@@ -164,6 +164,8 @@ let rec format_statement
              (format_block decl_ctx ~debug)
              arm_block))
       (List.combine (EnumConstructor.Map.bindings cons) arms)
+  | SSpecialOp (OHandleDefaultOpt (_exceptions, _just, _cons)) ->
+    Format.fprintf fmt "handle_default_opt ..."
 
 and format_block
     (decl_ctx : decl_ctx)

compiler/scalc/to_c.ml

@@ -505,6 +505,7 @@ let rec format_statement
       (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)
+  | SSpecialOp _ -> failwith "should not happen"
 
 and format_block (ctx : decl_ctx) (fmt : Format.formatter) (b : block) : unit =
   Format.pp_print_list

compiler/scalc/to_python.ml

@@ -464,6 +464,7 @@ let rec format_statement
       (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)
+  | SSpecialOp _ -> failwith "should not happen"
 
 and format_block (ctx : decl_ctx) (fmt : Format.formatter) (b : block) : unit =
   Format.pp_print_list

compiler/scalc/to_r.ml

@@ -451,6 +451,7 @@ let rec format_statement
       (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)
+  | SSpecialOp _ -> failwith "should not happen"
 
 and format_block (ctx : decl_ctx) (fmt : Format.formatter) (b : block) : unit =
   Format.pp_print_list