Compiling blocks to SCalc

Makefile

@@ -223,7 +223,7 @@ build_french_law_library_js: generate_french_law_library_ocaml format
 	cp -f $(ROOT_DIR)/_build/default/$(FRENCH_LAW_OCAML_LIB_DIR)/api_web.bc.js $(FRENCH_LAW_JS_LIB_DIR)/french_law.js
 
 #> generate_french_law_library_python	: Generates the French law library Python sources from Catala
-generate_french_law_library_ocaml:\
+generate_french_law_library_python:\
 	$(FRENCH_LAW_PYTHON_LIB_DIR)/allocations_familiales.py
 
 

compiler/scalc/ast.ml

@@ -32,14 +32,16 @@ type expr =
 
 type stmt =
   | SInnerFuncDef of func
+  | SLocalDecl of LocalVarName.t Pos.marked * D.typ Pos.marked
   | SLocalDef of LocalVarName.t Pos.marked * expr Pos.marked
   | STryExcept of block Pos.marked * L.except * block Pos.marked
   | SRaise of L.except
   | SIfThenElse of expr Pos.marked * block Pos.marked * block Pos.marked
   | SSwitch of expr Pos.marked * D.EnumName.t * block Pos.marked list
       (** Each block corresponds to one case of the enum *)
-  | SReturn of expr Pos.marked
-  | SAssert of expr Pos.marked
+  | SReturn of expr
+  | SBlock of block
+  | SAssert of expr
 
 and block = stmt Pos.marked list
 

compiler/scalc/compile_from_lambda.ml

@@ -23,8 +23,66 @@ type ctxt = {
   inside_definition_of : A.LocalVarName.t list;
 }
 
-let translate_block (ctxt : ctxt) (block_expr : L.expr Pos.marked) : A.block Pos.marked =
-  assert false
+let translate_expr (_ctxt : ctxt) (_expr : L.expr Pos.marked) : A.expr Pos.marked = assert false
+
+let rec translate_block (ctxt : ctxt) (block_expr : L.expr Pos.marked) : A.block Pos.marked =
+  match Pos.unmark block_expr with
+  | L.EApp ((L.EAbs ((binder, binder_pos), taus), eabs_pos), args) ->
+      (* This defines multiple local variables at the time *)
+      let vars, body = Bindlib.unmbind binder in
+      let vars_tau = List.map2 (fun x tau -> (x, tau)) (Array.to_list vars) taus in
+      let ctxt =
+        {
+          ctxt with
+          var_dict =
+            List.fold_left
+              (fun var_dict (x, _) ->
+                L.VarMap.add x (A.LocalVarName.fresh (Bindlib.name_of x, binder_pos)) var_dict)
+              ctxt.var_dict vars_tau;
+        }
+      in
+      let local_decls =
+        List.map
+          (fun (x, tau) ->
+            (A.SLocalDecl ((L.VarMap.find x ctxt.var_dict, binder_pos), tau), eabs_pos))
+          vars_tau
+      in
+      let vars_args =
+        List.map2
+          (fun (x, _) arg -> ((L.VarMap.find x ctxt.var_dict, binder_pos), arg))
+          vars_tau args
+      in
+      let def_blocks =
+        List.map
+          (fun (x, arg) ->
+            let ctxt =
+              { ctxt with inside_definition_of = Pos.unmark x :: ctxt.inside_definition_of }
+            in
+            translate_block ctxt arg)
+          vars_args
+      in
+      let rest_of_block = translate_block ctxt body in
+      ( local_decls
+        @ List.map (fun def -> (A.SBlock (Pos.unmark def), Pos.get_position def)) def_blocks
+        @ Pos.unmark rest_of_block,
+        Pos.get_position rest_of_block )
+  | _ -> (
+      (* We have reached the bottom of the L.expr, which means that we have to return it. If we are
+         at the top-level block of the function, we insert a return statement. But if this block was
+         used inside the definition of a local var, we define this local var (which should be on top
+         of the stack) *)
+      match ctxt.inside_definition_of with
+      | hd :: _ ->
+          ( [
+              ( A.SLocalDef (Pos.same_pos_as hd block_expr, translate_expr ctxt block_expr),
+                Pos.get_position block_expr );
+            ],
+            Pos.get_position block_expr )
+      | [] ->
+          ( [
+              (A.SReturn (Pos.unmark (translate_expr ctxt block_expr)), Pos.get_position block_expr);
+            ],
+            Pos.get_position block_expr ))
 
 let translate_scope (func_dict : A.FuncName.t L.VarMap.t) (scope_expr : L.expr Pos.marked) :
     (A.LocalVarName.t Pos.marked * D.typ Pos.marked) list * A.block Pos.marked =
@@ -42,7 +100,7 @@ let translate_scope (func_dict : A.FuncName.t L.VarMap.t) (scope_expr : L.expr P
           (fun var typ -> ((L.VarMap.find var var_dict, binder_pos), typ))
           (Array.to_list vars) typs
       in
-      let new_body = translate_block { func_dict; var_dict } body in
+      let new_body = translate_block { func_dict; var_dict; inside_definition_of = [] } body in
       (param_list, new_body)
   | _ -> assert false
 (* should not happen *)