CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-11-08 07:51:43 +03:00
Code Issues Projects Releases Wiki Activity

Setting up special compilation

Browse Source
This commit is contained in:
Denis Merigoux 2023-12-08 11:03:28 +01:00
parent 4e8d2ef219
commit c61bdbc5d7
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
1 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
compiler/scalc/from_lcalc.ml
View File

@ -26,6 +26,7 @@ type 'm ctxt = {
var_dict : ('m L.expr, A.VarName.t) Var.Map.t;
inside_definition_of : A.VarName.t option;
context_name : string;
keep_special_ops : bool;
}
(* Expressions can spill out side effect, hence this function also returns a
@ -76,6 +77,10 @@ let rec translate_expr (ctxt : 'm ctxt) (expr : 'm L.expr) : A.block * A.expr =
| EInj { e = e1; cons; name } ->
let e1_stmts, new_e1 = translate_expr ctxt e1 in
e1_stmts, (A.EInj (new_e1, cons, name), Expr.pos expr)
| EApp
{ f = EOp { op = Op.HandleDefaultOpt; tys = _ }, _binder_mark; args = _ }
when ctxt.keep_special_ops ->
assert false
| EApp { f; args } ->
let f_stmts, new_f = translate_expr ctxt f in
let args_stmts, new_args =
@ -285,6 +290,7 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
])
let rec translate_scope_body_expr
~(keep_special_ops : bool)
(scope_name : ScopeName.t)
(decl_ctx : decl_ctx)
(var_dict : ('m L.expr, A.VarName.t) Var.Map.t)
@ -300,6 +306,7 @@ let rec translate_scope_body_expr
var_dict;
inside_definition_of = None;
context_name = Mark.remove (ScopeName.get_info scope_name);
keep_special_ops;
}
e
in
@ -319,6 +326,7 @@ let rec translate_scope_body_expr
var_dict;
inside_definition_of = Some let_var_id;
context_name = Mark.remove (ScopeName.get_info scope_name);
keep_special_ops;
}
scope_let.scope_let_expr
| _ ->
@ -330,6 +338,7 @@ let rec translate_scope_body_expr
var_dict;
inside_definition_of = Some let_var_id;
context_name = Mark.remove (ScopeName.get_info scope_name);
keep_special_ops;
}
scope_let.scope_let_expr
in
@ -341,8 +350,8 @@ let rec translate_scope_body_expr
( A.SLocalDef ((let_var_id, scope_let.scope_let_pos), new_let_expr),
scope_let.scope_let_pos );
])
@ translate_scope_body_expr scope_name decl_ctx new_var_dict func_dict
scope_let_next
@ translate_scope_body_expr ~keep_special_ops scope_name decl_ctx
new_var_dict func_dict scope_let_next
let translate_program ~(keep_special_ops : bool) (p : 'm L.program) : A.program
=
@ -362,8 +371,8 @@ let translate_program ~(keep_special_ops : bool) (p : 'm L.program) : A.program
Var.Map.add scope_input_var scope_input_var_id var_dict
in
let new_scope_body =
translate_scope_body_expr name p.decl_ctx var_dict_local func_dict
scope_body_expr
translate_scope_body_expr ~keep_special_ops name p.decl_ctx
var_dict_local func_dict scope_body_expr
in
let func_id = A.FuncName.fresh (Bindlib.name_of var, Pos.no_pos) in
( Var.Map.add var func_id func_dict,
@ -408,6 +417,7 @@ let translate_program ~(keep_special_ops : bool) (p : 'm L.program) : A.program
var_dict args args_id;
inside_definition_of = None;
context_name = Mark.remove (TopdefName.get_info name);
keep_special_ops;
}
in
translate_expr ctxt expr
@ -443,6 +453,7 @@ let translate_program ~(keep_special_ops : bool) (p : 'm L.program) : A.program
var_dict;
inside_definition_of = None;
context_name = Mark.remove (TopdefName.get_info name);
keep_special_ops;
}
in
translate_expr ctxt expr