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

Typed defaults: translate types in scope lets as well in the new

Browse Source 
compile without exception passe
This commit is contained in:
adelaett 2023-11-15 12:16:36 +01:00 committed by Louis Gesbert
parent f6027109d8
commit 576da177c5
1 changed files with 58 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
compiler/lcalc/compile_without_exceptions.ml
View File

@ -28,8 +28,6 @@ module A = Ast
The typing translation is to simply trnsform defult type into option types. *)
let translate_var : 'm D.expr Var.t -> 'm A.expr Var.t = Var.translate
let rec translate_typ (tau : typ) : typ =
Mark.copy tau
begin
@ -103,6 +101,63 @@ and translate_expr (e : 'm D.expr) : 'm A.expr boxed =
Expr.map ~f:translate_expr (Mark.add mark e)
| _ -> .
let translate_scope_body_expr (scope_body_expr : 'expr1 scope_body_expr) :
'expr2 scope_body_expr Bindlib.box =
Scope.fold_right_lets
~f:(fun scope_let var_next acc ->
Bindlib.box_apply2
(fun scope_let_next scope_let_expr ->
ScopeLet
{
scope_let with
scope_let_next;
scope_let_expr;
scope_let_typ = translate_typ scope_let.scope_let_typ;
})
(Bindlib.bind_var (Var.translate var_next) acc)
(Expr.Box.lift (translate_expr scope_let.scope_let_expr)))
~init:(fun res ->
Bindlib.box_apply
(fun res -> Result res)
(Expr.Box.lift (translate_expr res)))
scope_body_expr
let translate_code_items scopes =
let f = function
| ScopeDef (name, body) ->
let scope_input_var, scope_lets = Bindlib.unbind body.scope_body_expr in
let new_body_expr = translate_scope_body_expr scope_lets in
let new_body_expr =
Bindlib.bind_var (Var.translate scope_input_var) new_body_expr
in
Bindlib.box_apply
(fun scope_body_expr -> ScopeDef (name, { body with scope_body_expr }))
new_body_expr
| Topdef (name, typ, expr) ->
Bindlib.box_apply
(fun e -> Topdef (name, typ, e))
(Expr.Box.lift (translate_expr expr))
in
Scope.map ~f ~varf:Var.translate scopes
let translate_program (prg : typed D.program) : untyped A.program =
Program.untype
@@ Bindlib.unbox (Program.map_exprs ~f:translate_expr ~varf:translate_var prg)
@@ Bindlib.unbox
@@ Bindlib.box_apply
(fun code_items ->
let ctx_enums =
EnumName.Map.map
(EnumConstructor.Map.map translate_typ)
prg.decl_ctx.ctx_enums
in
let ctx_structs =
StructName.Map.map
(StructField.Map.map translate_typ)
prg.decl_ctx.ctx_structs
in
{
prg with
code_items;
decl_ctx = { prg.decl_ctx with ctx_enums; ctx_structs };
})
(translate_code_items prg.code_items)