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

Add top-level definitions (#391)

Browse Source
This commit is contained in:
Denis Merigoux 2023-02-15 16:27:04 +01:00 committed by GitHub
commit fced0fff54
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
58 changed files with 26750 additions and 12193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
compiler/dcalc/from_scopelang.ml
View File

@ -49,8 +49,9 @@ type 'm scope_sigs_ctx = 'm scope_sig_ctx ScopeName.Map.t
type 'm ctx = {
structs : struct_ctx;
enums : enum_ctx;
scope_name : ScopeName.t;
scope_name : ScopeName.t option;
scopes_parameters : 'm scope_sigs_ctx;
toplevel_vars : ('m Ast.expr Var.t * naked_typ) TopdefName.Map.t;
scope_vars :
('m Ast.expr Var.t * naked_typ * Desugared.Ast.io) ScopeVar.Map.t;
subscope_vars :
@ -59,21 +60,6 @@ type 'm ctx = {
local_vars : ('m Scopelang.Ast.expr, 'm Ast.expr Var.t) Var.Map.t;
}
let empty_ctx
(struct_ctx : struct_ctx)
(enum_ctx : enum_ctx)
(scopes_ctx : 'm scope_sigs_ctx)
(scope_name : ScopeName.t) =
{
structs = struct_ctx;
enums = enum_ctx;
scope_name;
scopes_parameters = scopes_ctx;
scope_vars = ScopeVar.Map.empty;
subscope_vars = SubScopeName.Map.empty;
local_vars = Var.Map.empty;
}
let mark_tany m pos = Expr.with_ty m (Marked.mark pos TAny) ~pos
(* Expression argument is used as a type witness, its type and positions aren't
@ -222,6 +208,9 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
Expr.estruct name fields m
| EStructAccess { e; field; name } ->
Expr.estructaccess (translate_expr ctx e) field name m
| ETuple es -> Expr.etuple (List.map (translate_expr ctx) es) m
| ETupleAccess { e; index; size } ->
Expr.etupleaccess (translate_expr ctx e) index size m
| EInj { e; cons; name } ->
let e' = translate_expr ctx e in
Expr.einj e' cons name m
@ -437,17 +426,21 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
(* We insert various log calls to record arguments and outputs of
user-defined functions belonging to scopes *)
let e1_func = translate_expr ctx f in
let markings l =
match l with
| ScopelangScopeVar (v, _) ->
[ScopeName.get_info ctx.scope_name; ScopeVar.get_info v]
| SubScopeVar (s, _, (v, _)) ->
[ScopeName.get_info s; ScopeVar.get_info v]
let markings =
match ctx.scope_name, Marked.unmark f with
| Some sname, ELocation loc -> (
match loc with
| ScopelangScopeVar (v, _) ->
[ScopeName.get_info sname; ScopeVar.get_info v]
| SubScopeVar (s, _, (v, _)) ->
[ScopeName.get_info s; ScopeVar.get_info v]
| ToplevelVar _ -> [])
| _ -> []
in
let e1_func =
match Marked.unmark f with
| ELocation l -> tag_with_log_entry e1_func BeginCall (markings l)
| _ -> e1_func
match markings with
| [] -> e1_func
| m -> tag_with_log_entry e1_func BeginCall m
in
let new_args = List.map (translate_expr ctx) args in
let input_typ, output_typ =
@ -469,26 +462,35 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
ctx.subscope_vars
|> SubScopeName.Map.find (Marked.unmark sname)
|> retrieve_in_and_out_typ_or_any var
| ELocation (ToplevelVar tvar) -> (
let _, typ =
TopdefName.Map.find (Marked.unmark tvar) ctx.toplevel_vars
in
match typ with
| TArrow ((tin, _), (tout, _)) -> tin, tout
| _ ->
Errors.raise_spanned_error (Expr.pos e)
"Application of non-function toplevel variable")
| _ -> TAny, TAny
in
let new_args =
match Marked.unmark f, new_args with
| ELocation l, [new_arg] ->
match markings, new_args with
| (_ :: _ as m), [new_arg] ->
[
tag_with_log_entry new_arg (VarDef input_typ)
(markings l @ [Marked.mark (Expr.pos e) "input"]);
(m @ [Marked.mark (Expr.pos e) "input"]);
]
| _ -> new_args
in
let new_e = Expr.eapp e1_func new_args m in
let new_e =
match Marked.unmark f with
| ELocation l ->
match markings with
| [] -> new_e
| m ->
tag_with_log_entry
(tag_with_log_entry new_e (VarDef output_typ)
(markings l @ [Marked.mark (Expr.pos e) "output"]))
EndCall (markings l)
| _ -> new_e
(m @ [Marked.mark (Expr.pos e) "output"]))
EndCall m
in
new_e
| EAbs { binder; tys } ->
@ -536,6 +538,9 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
%a's results. Maybe you forgot to qualify it as an output?"
SubScopeName.format_t (Marked.unmark s) ScopeVar.format_t
(Marked.unmark a) SubScopeName.format_t (Marked.unmark s))
| ELocation (ToplevelVar v) ->
let v, _ = TopdefName.Map.find (Marked.unmark v) ctx.toplevel_vars in
Expr.evar v m
| EIfThenElse { cond; etrue; efalse } ->
Expr.eifthenelse (translate_expr ctx cond) (translate_expr ctx etrue)
(translate_expr ctx efalse)
@ -658,6 +663,11 @@ let translate_rule
(a_var, Marked.unmark tau, a_io)))
ctx.subscope_vars;
} )
| Definition ((ToplevelVar _, _), _, _, _) ->
assert false
(* A global variable can't be defined locally. The [Definition] constructor
could be made more specific to avoid this case, but the added complexity
didn't seem worth it *)
| Call (subname, subindex, m) ->
let subscope_sig = ScopeName.Map.find subname ctx.scopes_parameters in
let all_subscope_vars = subscope_sig.scope_sig_local_vars in
@ -861,15 +871,16 @@ let translate_rules
new_ctx )
let translate_scope_decl
(struct_ctx : struct_ctx)
(enum_ctx : enum_ctx)
(sctx : 'm scope_sigs_ctx)
(ctx : 'm ctx)
(scope_name : ScopeName.t)
(sigma : 'm Scopelang.Ast.scope_decl) :
'm Ast.expr scope_body Bindlib.box * struct_ctx =
let sigma_info = ScopeName.get_info sigma.scope_decl_name in
let scope_sig = ScopeName.Map.find sigma.scope_decl_name sctx in
let scope_sig =
ScopeName.Map.find sigma.scope_decl_name ctx.scopes_parameters
in
let scope_variables = scope_sig.scope_sig_local_vars in
let ctx = { ctx with scope_name = Some scope_name } in
let ctx =
(* the context must be initialized for fresh variables for all only-input
scope variables *)
@ -889,8 +900,7 @@ let translate_scope_decl
ctx.scope_vars;
}
| _ -> ctx)
(empty_ctx struct_ctx enum_ctx sctx scope_name)
scope_variables
ctx scope_variables
in
let scope_input_var = scope_sig.scope_sig_input_var in
let scope_input_struct_name = scope_sig.scope_sig_input_struct in
@ -981,10 +991,10 @@ let translate_scope_decl
new_struct_ctx )
let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program =
let scope_dependencies = Scopelang.Dependency.build_program_dep_graph prgm in
Scopelang.Dependency.check_for_cycle_in_scope scope_dependencies;
let scope_ordering =
Scopelang.Dependency.get_scope_ordering scope_dependencies
let defs_dependencies = Scopelang.Dependency.build_program_dep_graph prgm in
Scopelang.Dependency.check_for_cycle_in_defs defs_dependencies;
let defs_ordering =
Scopelang.Dependency.get_defs_ordering defs_dependencies
in
let decl_ctx = prgm.program_ctx in
let sctx : 'm scope_sigs_ctx =
@ -1039,36 +1049,68 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program =
scope_sig_in_fields;
scope_sig_out_fields = scope_return.out_struct_fields;
})
prgm.program_scopes
prgm.Scopelang.Ast.program_scopes
in
let top_ctx =
let toplevel_vars =
TopdefName.Map.mapi
(fun name (_, ty) ->
Var.make (Marked.unmark (TopdefName.get_info name)), Marked.unmark ty)
prgm.Scopelang.Ast.program_topdefs
in
{
structs = decl_ctx.ctx_structs;
enums = decl_ctx.ctx_enums;
scope_name = None;
scopes_parameters = sctx;
scope_vars = ScopeVar.Map.empty;
subscope_vars = SubScopeName.Map.empty;
local_vars = Var.Map.empty;
toplevel_vars;
}
in
(* the resulting expression is the list of definitions of all the scopes,
ending with the top-level scope. The decl_ctx is filled in left-to-right
order, then the chained scopes aggregated from the right. *)
let rec translate_scopes decl_ctx = function
| scope_name :: next_scopes ->
let scope = ScopeName.Map.find scope_name prgm.program_scopes in
let scope_body, scope_in_struct =
translate_scope_decl decl_ctx.ctx_structs decl_ctx.ctx_enums sctx
scope_name scope
let rec translate_defs ctx = function
| [] -> Bindlib.box Nil, ctx
| def :: next ->
let ctx, dvar, def =
match def with
| Scopelang.Dependency.Topdef gname ->
let expr, ty = TopdefName.Map.find gname prgm.program_topdefs in
let expr = translate_expr ctx expr in
( ctx,
fst (TopdefName.Map.find gname ctx.toplevel_vars),
Bindlib.box_apply
(fun e -> Topdef (gname, ty, e))
(Expr.Box.lift expr) )
| Scopelang.Dependency.Scope scope_name ->
let scope = ScopeName.Map.find scope_name prgm.program_scopes in
let scope_body, scope_in_struct =
translate_scope_decl ctx scope_name scope
in
( {
ctx with
structs =
StructName.Map.union
(fun _ _ -> assert false)
ctx.structs scope_in_struct;
},
(ScopeName.Map.find scope_name sctx).scope_sig_scope_var,
Bindlib.box_apply
(fun body -> ScopeDef (scope_name, body))
scope_body )
in
let dvar = (ScopeName.Map.find scope_name sctx).scope_sig_scope_var in
let decl_ctx =
{
decl_ctx with
ctx_structs =
StructName.Map.union
(fun _ _ -> assert false (* should not happen *))
decl_ctx.ctx_structs scope_in_struct;
}
in
let scope_next, decl_ctx = translate_scopes decl_ctx next_scopes in
let scope_next, ctx = translate_defs ctx next in
let next_bind = Bindlib.bind_var dvar scope_next in
( Bindlib.box_apply2
(fun scope_body scope_next ->
ScopeDef { scope_name; scope_body; scope_next })
scope_body
(Bindlib.bind_var dvar scope_next),
decl_ctx )
| [] -> Bindlib.box Nil, decl_ctx
(fun item next_bind -> Cons (item, next_bind))
def next_bind,
ctx )
in
let scopes, decl_ctx = translate_scopes decl_ctx scope_ordering in
{ scopes = Bindlib.unbox scopes; decl_ctx }
let items, ctx = translate_defs top_ctx defs_ordering in
{
code_items = Bindlib.unbox items;
decl_ctx = { decl_ctx with ctx_structs = ctx.structs };
}

13
compiler/dcalc/interpreter.ml
View File

@ -314,7 +314,7 @@ and evaluate_expr (ctx : decl_ctx) (e : 'm Ast.expr) : 'm Ast.expr =
| EVar _ ->
Errors.raise_spanned_error (Expr.pos e)
"free variable found at evaluation (should not happen if term was \
well-typed"
well-typed)"
| EApp { f = e1; args } -> (
let e1 = evaluate_expr ctx e1 in
let args = List.map (evaluate_expr ctx) args in
@ -364,6 +364,17 @@ and evaluate_expr (ctx : decl_ctx) (e : 'm Ast.expr) : 'm Ast.expr =
if the term was well-typed)"
(Expr.format ctx ~debug:true)
e StructName.format_t s)
| ETuple es ->
Marked.same_mark_as (ETuple (List.map (evaluate_expr ctx) es)) e
| ETupleAccess { e = e1; index; size } -> (
match evaluate_expr ctx e1 with
| ETuple es, _ when List.length es = size -> List.nth es index
| e ->
Errors.raise_spanned_error (Expr.pos e)
"The expression %a was expected to be a tuple of size %d (should not \
happen if the term was well-typed)"
(Expr.format ctx ~debug:true)
e size)
| EInj { e = e1; name; cons } ->
let e1' = evaluate_expr ctx e1 in
if is_empty_error e then Marked.same_mark_as (ELit LEmptyError) e

69
compiler/dcalc/optimizations.ml
View File

@ -213,70 +213,11 @@ let rec partial_evaluation (ctx : partial_evaluation_ctx) (e : 'm expr) :
let optimize_expr (decl_ctx : decl_ctx) (e : 'm expr) =
partial_evaluation { var_values = Var.Map.empty; decl_ctx } e
let rec scope_lets_map
(t : 'a -> 'm expr -> (dcalc, 'm mark) boxed_gexpr)
(ctx : 'a)
(scope_body_expr : 'm expr scope_body_expr) :
'm expr scope_body_expr Bindlib.box =
match scope_body_expr with
| Result e ->
Bindlib.box_apply (fun e' -> Result e') (Expr.Box.lift (t ctx e))
| ScopeLet scope_let ->
let var, next = Bindlib.unbind scope_let.scope_let_next in
let new_scope_let_expr = Expr.Box.lift (t ctx scope_let.scope_let_expr) in
let new_next = scope_lets_map t ctx next in
let new_next = Bindlib.bind_var var new_next in
Bindlib.box_apply2
(fun new_scope_let_expr new_next ->
ScopeLet
{
scope_let with
scope_let_expr = new_scope_let_expr;
scope_let_next = new_next;
})
new_scope_let_expr new_next
let rec scopes_map
(t : 'a -> 'm expr -> (dcalc, 'm mark) boxed_gexpr)
(ctx : 'a)
(scopes : 'm expr scopes) : 'm expr scopes Bindlib.box =
match scopes with
| Nil -> Bindlib.box Nil
| ScopeDef scope_def ->
let scope_var, scope_next = Bindlib.unbind scope_def.scope_next in
let scope_arg_var, scope_body_expr =
Bindlib.unbind scope_def.scope_body.scope_body_expr
in
let new_scope_body_expr = scope_lets_map t ctx scope_body_expr in
let new_scope_body_expr =
Bindlib.bind_var scope_arg_var new_scope_body_expr
in
let new_scope_next = scopes_map t ctx scope_next in
let new_scope_next = Bindlib.bind_var scope_var new_scope_next in
Bindlib.box_apply2
(fun new_scope_body_expr new_scope_next ->
ScopeDef
{
scope_def with
scope_next = new_scope_next;
scope_body =
{
scope_def.scope_body with
scope_body_expr = new_scope_body_expr;
};
})
new_scope_body_expr new_scope_next
let program_map
(t : 'a -> 'm expr -> (dcalc, 'm mark) boxed_gexpr)
(ctx : 'a)
(p : 'm program) : 'm program Bindlib.box =
Bindlib.box_apply
(fun new_scopes -> { p with scopes = new_scopes })
(scopes_map t ctx p.scopes)
let optimize_program (p : 'm program) : 'm program =
Bindlib.unbox
(program_map partial_evaluation
{ var_values = Var.Map.empty; decl_ctx = p.decl_ctx }
(Program.map_exprs
~f:
(partial_evaluation
{ var_values = Var.Map.empty; decl_ctx = p.decl_ctx })
~varf:(fun v -> v)
p)

21
compiler/desugared/ast.ml
View File

@ -197,6 +197,7 @@ type scope = {
type program = {
program_scopes : scope ScopeName.Map.t;
program_topdefs : (expr * typ) TopdefName.Map.t;
program_ctx : decl_ctx;
}
@ -216,15 +217,19 @@ let free_variables (def : rule RuleName.Map.t) : Pos.t ScopeDefMap.t =
Pos.t ScopeDefMap.t =
LocationSet.fold
(fun (loc, loc_pos) acc ->
ScopeDefMap.add
(match loc with
| DesugaredScopeVar (v, st) -> ScopeDef.Var (Marked.unmark v, st)
let usage =
match loc with
| DesugaredScopeVar (v, st) ->
Some (ScopeDef.Var (Marked.unmark v, st))
| SubScopeVar (_, sub_index, sub_var) ->
ScopeDef.SubScopeVar
( Marked.unmark sub_index,
Marked.unmark sub_var,
Marked.get_mark sub_index ))
loc_pos acc)
Some
(ScopeDef.SubScopeVar
( Marked.unmark sub_index,
Marked.unmark sub_var,
Marked.get_mark sub_index ))
| ToplevelVar _ -> None
in
match usage with Some u -> ScopeDefMap.add u loc_pos acc | None -> acc)
locs acc
in
RuleName.Map.fold

1
compiler/desugared/ast.mli
View File

@ -119,6 +119,7 @@ type scope = {
type program = {
program_scopes : scope ScopeName.Map.t;
program_topdefs : (expr * typ) TopdefName.Map.t;
program_ctx : decl_ctx;
}

58
compiler/desugared/dependency.ml
View File

@ -41,15 +41,24 @@ module Vertex = struct
| Var (x, Some sx) -> Int.logxor (ScopeVar.hash x) (StateName.hash sx)
| SubScope x -> SubScopeName.hash x
let compare = compare
let compare x y =
match x, y with
| Var (x, xst), Var (y, yst) -> (
match ScopeVar.compare x y with
| 0 -> Option.compare StateName.compare xst yst
| n -> n)
| SubScope x, SubScope y -> SubScopeName.compare x y
| Var _, _ -> -1
| _, Var _ -> 1
| SubScope _, _ -> .
| _, SubScope _ -> .
let equal x y =
match x, y with
| Var (x, None), Var (y, None) -> ScopeVar.compare x y = 0
| Var (x, Some sx), Var (y, Some sy) ->
ScopeVar.compare x y = 0 && StateName.compare sx sy = 0
| SubScope x, SubScope y -> SubScopeName.compare x y = 0
| _ -> false
| Var (x, sx), Var (y, sy) ->
ScopeVar.equal x y && Option.equal StateName.equal sx sy
| SubScope x, SubScope y -> SubScopeName.equal x y
| (Var _ | SubScope _), _ -> false
let format_t (fmt : Format.formatter) (x : t) : unit =
match x with
@ -57,6 +66,11 @@ module Vertex = struct
| Var (v, Some sv) ->
Format.fprintf fmt "%a.%a" ScopeVar.format_t v StateName.format_t sv
| SubScope v -> SubScopeName.format_t fmt v
let info = function
| Var (v, None) -> ScopeVar.get_info v
| Var (_, Some sv) -> StateName.get_info sv
| SubScope v -> SubScopeName.get_info v
end
(** On the edges, the label is the position of the expression responsible for
@ -97,32 +111,13 @@ let check_for_cycle (scope : Ast.scope) (g : ScopeDependencies.t) : unit =
List.flatten
(List.map
(fun v ->
let var_str, var_info =
match v with
| Vertex.Var (v, None) ->
Format.asprintf "%a" ScopeVar.format_t v, ScopeVar.get_info v
| Vertex.Var (v, Some sv) ->
( Format.asprintf "%a.%a" ScopeVar.format_t v
StateName.format_t sv,
StateName.get_info sv )
| Vertex.SubScope v ->
( Format.asprintf "%a" SubScopeName.format_t v,
SubScopeName.get_info v )
in
let var_str = Format.asprintf "%a" Vertex.format_t v in
let var_info = Vertex.info v in
let succs = ScopeDependencies.succ_e g v in
let _, edge_pos, succ =
List.find (fun (_, _, succ) -> List.mem succ scc) succs
in
let succ_str =
match succ with
| Vertex.Var (v, None) ->
Format.asprintf "%a" ScopeVar.format_t v
| Vertex.Var (v, Some sv) ->
Format.asprintf "%a.%a" ScopeVar.format_t v StateName.format_t
sv
| Vertex.SubScope v ->
Format.asprintf "%a" SubScopeName.format_t v
in
let succ_str = Format.asprintf "%a" Vertex.format_t succ in
[
( Some ("Cycle variable " ^ var_str ^ ", declared:"),
Marked.get_mark var_info );
@ -171,7 +166,10 @@ let build_scope_dependencies (scope : Ast.scope) : ScopeDependencies.t =
| ( Ast.ScopeDef.Var (v_defined, s_defined),
Ast.ScopeDef.Var (v_used, s_used) ) ->
(* simple case *)
if v_used = v_defined && s_used = s_defined then
if
ScopeVar.equal v_used v_defined
&& Option.equal StateName.equal s_used s_defined
then
(* variable definitions cannot be recursive *)
Errors.raise_spanned_error fv_def_pos
"The variable %a is used in one of its definitions, but \
@ -199,7 +197,7 @@ let build_scope_dependencies (scope : Ast.scope) : ScopeDependencies.t =
Ast.ScopeDef.SubScopeVar (used, _, _) ) ->
(* here we are defining the input of a scope with the output of
another subscope *)
if used = defined then
if SubScopeName.equal used defined then
(* subscopes are not recursive functions *)
Errors.raise_spanned_error fv_def_pos
"The subscope %a is used when defining one of its inputs, \

14
compiler/desugared/disambiguate.ml
View File

@ -58,6 +58,16 @@ let scope ctx env scope =
{ scope with scope_defs; scope_assertions }
let program prg =
let env =
TopdefName.Map.fold
(fun name (_e, ty) env -> Typing.Env.add_toplevel_var name ty env)
prg.program_topdefs Typing.Env.empty
in
let program_topdefs =
TopdefName.Map.map
(fun (e, ty) -> Expr.unbox (expr prg.program_ctx env (Expr.box e)), ty)
prg.program_topdefs
in
let env =
ScopeName.Map.fold
(fun scope_name scope env ->
@ -70,9 +80,9 @@ let program prg =
scope.scope_defs ScopeVar.Map.empty
in
Typing.Env.add_scope scope_name ~vars env)
prg.program_scopes Typing.Env.empty
prg.program_scopes env
in
let program_scopes =
ScopeName.Map.map (scope prg.program_ctx env) prg.program_scopes
in
{ prg with program_scopes }
{ prg with program_topdefs; program_scopes }

114
compiler/desugared/from_surface.ml
View File

@ -192,13 +192,18 @@ let rec check_formula (op, pos_op) e =
(** Usage: [translate_expr scope ctxt naked_expr]
Translates [expr] into its desugared equivalent. [scope] is used to
disambiguate the scope and subscopes variables than occur in the expression *)
disambiguate the scope and subscopes variables than occur in the expression,
[None] is assumed to mean a toplevel definition *)
let rec translate_expr
(scope : ScopeName.t)
(scope : ScopeName.t option)
(inside_definition_of : Ast.ScopeDef.t Marked.pos option)
(ctxt : Name_resolution.context)
(expr : Surface.Ast.expression) : Ast.expr boxed =
let scope_ctxt = ScopeName.Map.find scope ctxt.scopes in
let scope_vars =
match scope with
| None -> IdentName.Map.empty
| Some s -> (ScopeName.Map.find s ctxt.scopes).var_idmap
in
let rec_helper = translate_expr scope inside_definition_of ctxt in
let pos = Marked.get_mark expr in
let emark = Untyped { pos } in
@ -299,10 +304,13 @@ let rec translate_expr
Expr.elit lit emark
| Ident ([], (x, pos)) -> (
(* first we check whether this is a local var, then we resort to scope-wide
variables *)
variables, then global variables *)
match IdentName.Map.find_opt x ctxt.local_var_idmap with
| Some uid ->
Expr.make_var uid emark
(* the whole box thing is to accomodate for this case *)
| None -> (
match IdentName.Map.find_opt x scope_ctxt.var_idmap with
match IdentName.Map.find_opt x scope_vars with
| Some (ScopeVar uid) ->
(* If the referenced variable has states, then here are the rules to
desambiguate. In general, only the last state can be referenced.
@ -343,21 +351,28 @@ let rec translate_expr
Some (List.hd (List.rev states)))
in
Expr.elocation (DesugaredScopeVar ((uid, pos), x_state)) emark
| Some (SubScope _) | None ->
Name_resolution.raise_unknown_identifier
"for a local or scope-wide variable" (x, pos))
| Some uid ->
Expr.make_var uid emark
(* the whole box thing is to accomodate for this case *))
| Some (SubScope _)
(* Note: allowing access to a global variable with the same name as a
subscope is disputable, but I see no good reason to forbid it either *)
| None -> (
match IdentName.Map.find_opt x ctxt.topdefs with
| Some v ->
Expr.elocation
(ToplevelVar (v, Marked.get_mark (TopdefName.get_info v)))
emark
| None ->
Name_resolution.raise_unknown_identifier
"for a local, scope-wide or global variable" (x, pos))))
| Ident (_path, _x) ->
Errors.raise_spanned_error pos "Qualified paths are not supported yet"
| Dotted (e, ((path, x), _ppos)) -> (
match path, Marked.unmark e with
| [], Ident ([], (y, _)) when Name_resolution.is_subscope_uid scope ctxt y
->
| [], Ident ([], (y, _))
when Option.fold scope ~none:false ~some:(fun s ->
Name_resolution.is_subscope_uid s ctxt y) ->
(* In this case, y.x is a subscope variable *)
let subscope_uid, subscope_real_uid =
match IdentName.Map.find y scope_ctxt.var_idmap with
match IdentName.Map.find y scope_vars with
| SubScope (sub, sc) -> sub, sc
| ScopeVar _ -> assert false
in
@ -383,8 +398,12 @@ let rec translate_expr
Errors.raise_spanned_error pos "Qualified paths are not supported yet"
in
Expr.edstructaccess e (Marked.unmark x) str emark)
| FunCall (f, arg) -> Expr.eapp (rec_helper f) [rec_helper arg] emark
| FunCall (f, args) ->
Expr.eapp (rec_helper f) (List.map rec_helper args) emark
| ScopeCall ((([], sc_name), _), fields) ->
if scope = None then
Errors.raise_spanned_error pos
"Scope calls are not allowed outside of a scope";
let called_scope = Name_resolution.get_scope ctxt sc_name in
let scope_def = ScopeName.Map.find called_scope ctxt.scopes in
let in_struct =
@ -739,7 +758,7 @@ let rec translate_expr
| Builtin LastDayOfMonth -> Expr.eop LastDayOfMonth [TLit TDate, pos] emark
and disambiguate_match_and_build_expression
(scope : ScopeName.t)
(scope : ScopeName.t option)
(inside_definition_of : Ast.ScopeDef.t Marked.pos option)
(ctxt : Name_resolution.context)
(cases : Surface.Ast.match_case Marked.pos list) :
@ -906,11 +925,11 @@ let process_default
(cons : Surface.Ast.expression) : Ast.rule =
let just =
match just with
| Some just -> Some (translate_expr scope (Some def_key) ctxt just)
| Some just -> Some (translate_expr (Some scope) (Some def_key) ctxt just)
| None -> None
in
let just = merge_conditions precond just (Marked.get_mark def_key) in
let cons = translate_expr scope (Some def_key) ctxt cons in
let cons = translate_expr (Some scope) (Some def_key) ctxt cons in
{
rule_just = just;
rule_cons = cons;
@ -1037,7 +1056,7 @@ let process_assert
(ass : Surface.Ast.assertion) : Ast.program =
let scope : Ast.scope = ScopeName.Map.find scope_uid prgm.program_scopes in
let ass =
translate_expr scope_uid None ctxt
translate_expr (Some scope_uid) None ctxt
(match ass.Surface.Ast.assertion_condition with
| None -> ass.Surface.Ast.assertion_content
| Some cond ->
@ -1071,7 +1090,7 @@ let process_scope_use_item
(ctxt : Name_resolution.context)
(prgm : Ast.program)
(item : Surface.Ast.scope_use_item Marked.pos) : Ast.program =
let precond = Option.map (translate_expr scope None ctxt) precond in
let precond = Option.map (translate_expr (Some scope) None ctxt) precond in
match Marked.unmark item with
| Surface.Ast.Rule rule -> process_rule precond scope ctxt prgm rule
| Surface.Ast.Definition def -> process_def precond scope ctxt prgm def
@ -1146,6 +1165,55 @@ let process_scope_use
(process_scope_use_item precond scope_uid ctxt)
prgm use.scope_use_items
let process_topdef
(ctxt : Name_resolution.context)
(prgm : Ast.program)
(def : S.top_def) : Ast.program =
let id =
IdentName.Map.find
(Marked.unmark def.S.topdef_name)
ctxt.Name_resolution.topdefs
in
let ty_pos = Marked.get_mark def.S.topdef_type in
let translate_typ t =
(* Todo: better helper function from a more appropriate place *)
Name_resolution.process_base_typ ctxt
(S.Data (Marked.unmark t), Marked.get_mark t)
in
let body_type = translate_typ def.S.topdef_type in
let arg_types =
List.map (fun (_, ty) -> translate_typ ty) def.S.topdef_args
in
let expr =
let ctxt, rv_args =
List.fold_left
(fun (ctxt, rv_args) (v, _ty) ->
let ctxt, a =
Name_resolution.add_def_local_var ctxt (Marked.unmark v)
in
ctxt, a :: rv_args)
(ctxt, []) def.S.topdef_args
in
let body = translate_expr None None ctxt def.S.topdef_expr in
match rv_args with
| [] -> body
| rv_args ->
Expr.make_abs
(Array.of_list (List.rev rv_args))
body arg_types
(Marked.get_mark def.S.topdef_name)
in
let typ =
List.fold_right
(fun argty retty -> TArrow (argty, retty), ty_pos)
arg_types body_type
in
{
prgm with
Ast.program_topdefs =
TopdefName.Map.add id (Expr.unbox expr, typ) prgm.Ast.program_topdefs;
}
let attribute_to_io (attr : Surface.Ast.scope_decl_context_io) : Ast.io =
{
Ast.io_output = attr.scope_decl_context_io_output;
@ -1294,6 +1362,7 @@ let translate_program
ctxt.Name_resolution.typedefs ScopeName.Map.empty;
ctx_struct_fields = ctxt.Name_resolution.field_idmap;
};
Ast.program_topdefs = TopdefName.Map.empty;
Ast.program_scopes;
}
in
@ -1310,7 +1379,10 @@ let translate_program
(fun prgm item ->
match Marked.unmark item with
| Surface.Ast.ScopeUse use -> process_scope_use ctxt prgm use
| _ -> prgm)
| Surface.Ast.Topdef def -> process_topdef ctxt prgm def
| Surface.Ast.ScopeDecl _ | Surface.Ast.StructDecl _
| Surface.Ast.EnumDecl _ ->
prgm)
prgm block
| LawInclude _ | LawText _ -> prgm
in

14
compiler/desugared/name_resolution.ml
View File

@ -81,6 +81,7 @@ type context = {
(** The names of the enum constructors. Constructor names can be shared
between different enums *)
scopes : scope_context ScopeName.Map.t; (** For each scope, its context *)
topdefs : TopdefName.t IdentName.Map.t; (** Global definitions *)
structs : struct_context StructName.Map.t;
(** For each struct, its context *)
enums : enum_context EnumName.Map.t; (** For each enum, its context *)
@ -638,6 +639,15 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Marked.pos)
(TEnum e_uid) ctxt.typedefs;
}
| ScopeUse _ -> ctxt
| Topdef def ->
let name, pos = def.topdef_name in
Option.iter
(fun use ->
raise_already_defined_error (TopdefName.get_info use) name pos
"toplevel definition")
(IdentName.Map.find_opt name ctxt.topdefs);
let uid = TopdefName.fresh def.topdef_name in
{ ctxt with topdefs = IdentName.Map.add name uid ctxt.topdefs }
(** Process a code item that is a declaration *)
let process_decl_item (ctxt : context) (item : Surface.Ast.code_item Marked.pos)
@ -647,6 +657,7 @@ let process_decl_item (ctxt : context) (item : Surface.Ast.code_item Marked.pos)
| StructDecl sdecl -> process_struct_decl ctxt sdecl
| EnumDecl edecl -> process_enum_decl ctxt edecl
| ScopeUse _ -> ctxt
| Topdef _ -> ctxt
(** Process a code block *)
let process_code_block
@ -865,7 +876,7 @@ let process_scope_use (ctxt : context) (suse : Surface.Ast.scope_use) : context
let process_use_item (ctxt : context) (item : Surface.Ast.code_item Marked.pos)
: context =
match Marked.unmark item with
| ScopeDecl _ | StructDecl _ | EnumDecl _ -> ctxt
| ScopeDecl _ | StructDecl _ | EnumDecl _ | Topdef _ -> ctxt
| ScopeUse suse -> process_scope_use ctxt suse
(** {1 API} *)
@ -877,6 +888,7 @@ let form_context (prgm : Surface.Ast.program) : context =
local_var_idmap = IdentName.Map.empty;
typedefs = IdentName.Map.empty;
scopes = ScopeName.Map.empty;
topdefs = IdentName.Map.empty;
var_typs = ScopeVar.Map.empty;
structs = StructName.Map.empty;
field_idmap = IdentName.Map.empty;

5
compiler/desugared/name_resolution.mli
View File

@ -81,6 +81,7 @@ type context = {
(** The names of the enum constructors. Constructor names can be shared
between different enums *)
scopes : scope_context ScopeName.Map.t; (** For each scope, its context *)
topdefs : TopdefName.t IdentName.Map.t; (** Global definitions *)
structs : struct_context StructName.Map.t;
(** For each struct, its context *)
enums : enum_context EnumName.Map.t; (** For each enum, its context *)
@ -149,6 +150,10 @@ val get_scope : context -> IdentName.t Marked.pos -> ScopeName.t
(** Find a scope definition from the typedefs, failing if there is none or it
has a different kind *)
val process_base_typ : context -> Surface.Ast.base_typ Marked.pos -> typ
(** Convert a surface base type to an AST type *)
(* Note: should probably be moved to a different module *)
(** {1 API} *)
val form_context : Surface.Ast.program -> context

35
compiler/driver.ml
View File

@ -237,14 +237,13 @@ let driver source_file (options : Cli.options) : int =
( scope_uid,
Option.get
(Shared_ast.Scope.fold_left ~init:None
~f:(fun acc scope_def _ ->
if
Shared_ast.ScopeName.compare scope_def.scope_name
scope_uid
= 0
then Some scope_def.scope_body
else acc)
prgm.scopes) )
~f:(fun acc def _ ->
match def with
| ScopeDef (name, body)
when Shared_ast.ScopeName.equal name scope_uid ->
Some body
| _ -> acc)
prgm.code_items) )
else
let prgrm_dcalc_expr =
Shared_ast.Expr.unbox (Shared_ast.Program.to_expr prgm scope_uid)
@ -357,7 +356,7 @@ let driver source_file (options : Cli.options) : int =
p.Plugin.apply ~source_file ~output_file ~scope:options.ex_scope
prgm type_ordering
| (`Python | `Scalc | `Plugin (Plugin.Scalc _)) as backend -> (
let prgm = Scalc.Compile_from_lambda.translate_program prgm in
let prgm = Scalc.From_lambda.translate_program prgm in
match backend with
| `Scalc ->
let _output_file, with_output = get_output_format () in
@ -365,19 +364,15 @@ let driver source_file (options : Cli.options) : int =
@@ fun fmt ->
if Option.is_some options.ex_scope then
Format.fprintf fmt "%a\n"
(Scalc.Print.format_scope ~debug:options.debug
(Scalc.Print.format_item ~debug:options.debug
prgm.decl_ctx)
(List.find
(fun body ->
body.Scalc.Ast.scope_body_name = scope_uid)
prgm.scopes)
else
Format.fprintf fmt "%a\n"
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "\n\n")
(fun fmt scope ->
(Scalc.Print.format_scope prgm.decl_ctx) fmt scope))
prgm.scopes
(function
| Scalc.Ast.SScope { scope_body_name; _ } ->
scope_body_name = scope_uid
| _ -> false)
prgm.code_items)
else Scalc.Print.format_program prgm.decl_ctx fmt prgm
| `Python ->
let output_file, with_output =
get_output_format ~ext:".py" ()

92
compiler/lcalc/closure_conversion.ml
View File

@ -166,53 +166,49 @@ let closure_conversion_expr (type m) (ctx : m ctx) (e : m expr) : m expr boxed =
e'
let closure_conversion (p : 'm program) : 'm program Bindlib.box =
let new_scopes, _ =
Scope.fold_left
~f:(fun (acc_new_scopes, global_vars) scope scope_var ->
(* [acc_new_scopes] represents what has been translated in the past, it
needs a continuation to attach the rest of the translated scopes. *)
let scope_input_var, scope_body_expr =
Bindlib.unbind scope.scope_body.scope_body_expr
in
let global_vars = Var.Set.add scope_var global_vars in
let ctx =
{
name_context = Marked.unmark (ScopeName.get_info scope.scope_name);
globally_bound_vars = global_vars;
}
in
let new_scope_lets =
Scope.map_exprs_in_lets
~f:(closure_conversion_expr ctx)
~varf:(fun v -> v)
scope_body_expr
in
let new_scope_body_expr =
Bindlib.bind_var scope_input_var new_scope_lets
in
( (fun next ->
acc_new_scopes
(Bindlib.box_apply2
(fun new_scope_body_expr next ->
ScopeDef
{
scope with
scope_body =
{
scope.scope_body with
scope_body_expr = new_scope_body_expr;
};
scope_next = next;
})
new_scope_body_expr
(Bindlib.bind_var scope_var next))),
global_vars ))
~init:
( Fun.id,
Var.Set.of_list
(List.map Var.translate [handle_default; handle_default_opt]) )
p.scopes
let _, new_code_items =
Scope.fold_map
~f:(fun toplevel_vars var code_item ->
( Var.Set.add var toplevel_vars,
match code_item with
| ScopeDef (name, body) ->
let scope_input_var, scope_body_expr =
Bindlib.unbind body.scope_body_expr
in
let ctx =
{
name_context = Marked.unmark (ScopeName.get_info name);
globally_bound_vars = toplevel_vars;
}
in
let new_scope_lets =
Scope.map_exprs_in_lets
~f:(closure_conversion_expr ctx)
~varf:(fun v -> v)
scope_body_expr
in
let new_scope_body_expr =
Bindlib.bind_var scope_input_var new_scope_lets
in
Bindlib.box_apply
(fun scope_body_expr ->
ScopeDef (name, { body with scope_body_expr }))
new_scope_body_expr
| Topdef (name, ty, expr) ->
let ctx =
{
name_context = Marked.unmark (TopdefName.get_info name);
globally_bound_vars = toplevel_vars;
}
in
Bindlib.box_apply
(fun e -> Topdef (name, ty, e))
(Expr.Box.lift (closure_conversion_expr ctx expr)) ))
~varf:(fun v -> v)
(Var.Set.of_list
(List.map Var.translate [handle_default; handle_default_opt]))
p.code_items
in
Bindlib.box_apply
(fun new_scopes -> { p with scopes = new_scopes })
(new_scopes (Bindlib.box Nil))
(fun new_code_items -> { p with code_items = new_code_items })
new_code_items

110
compiler/lcalc/compile_with_exceptions.ml
View File

@ -19,9 +19,10 @@ open Shared_ast
module D = Dcalc.Ast
module A = Ast
type 'm ctx = ('m D.expr, 'm A.expr Var.t) Var.Map.t
(** This environment contains a mapping between the variables in Dcalc and their
correspondance in Lcalc. *)
type 'm ctx = unit
(** This translation no longer needs a context at the moment, but we keep
passing the argument through the functions in case the need arises with
further evolutions. *)
let thunk_expr (type m) (e : m A.expr boxed) : m A.expr boxed =
let dummy_var = Var.make "_" in
@ -29,6 +30,8 @@ let thunk_expr (type m) (e : m A.expr boxed) : m A.expr boxed =
let arg_t = Marked.mark pos (TLit TUnit) in
Expr.make_abs [| dummy_var |] e [arg_t] pos
let translate_var : 'm D.expr Var.t -> 'm A.expr Var.t = Var.translate
let rec translate_default
(ctx : 'm ctx)
(exceptions : 'm D.expr list)
@ -56,11 +59,14 @@ let rec translate_default
and translate_expr (ctx : 'm ctx) (e : 'm D.expr) : 'm A.expr boxed =
let m = Marked.get_mark e in
match Marked.unmark e with
| EVar v -> Expr.make_var (Var.Map.find v ctx) m
| EVar v -> Expr.make_var (translate_var v) m
| EStruct { name; fields } ->
Expr.estruct name (StructField.Map.map (translate_expr ctx) fields) m
| EStructAccess { name; e; field } ->
Expr.estructaccess (translate_expr ctx e) field name m
| ETuple es -> Expr.etuple (List.map (translate_expr ctx) es) m
| ETupleAccess { e; index; size } ->
Expr.etupleaccess (translate_expr ctx e) index size m
| EInj { name; e; cons } -> Expr.einj (translate_expr ctx e) cons name m
| EMatch { name; e; cases } ->
Expr.ematch (translate_expr ctx e) name
@ -88,16 +94,8 @@ and translate_expr (ctx : 'm ctx) (e : 'm D.expr) : 'm A.expr boxed =
(Marked.get_mark e)
| EAbs { binder; tys } ->
let vars, body = Bindlib.unmbind binder in
let ctx, lc_vars =
Array.fold_right
(fun var (ctx, lc_vars) ->
let lc_var = Var.make (Bindlib.name_of var) in
Var.Map.add var lc_var ctx, lc_var :: lc_vars)
vars (ctx, [])
in
let lc_vars = Array.of_list lc_vars in
let new_body = translate_expr ctx body in
let new_binder = Expr.bind lc_vars new_body in
let new_binder = Expr.bind (Array.map translate_var vars) new_body in
Expr.eabs new_binder tys (Marked.get_mark e)
| EDefault { excepts = [exn]; just; cons } when !Cli.optimize_flag ->
(* FIXME: bad place to rely on a global flag *)
@ -118,14 +116,14 @@ let rec translate_scope_lets
| Result e ->
Bindlib.box_apply (fun e -> Result e) (Expr.Box.lift (translate_expr ctx e))
| ScopeLet scope_let ->
let old_scope_let_var, scope_let_next =
let scope_let_var, scope_let_next =
Bindlib.unbind scope_let.scope_let_next
in
let new_scope_let_var = Var.make (Bindlib.name_of old_scope_let_var) in
let new_scope_let_expr = translate_expr ctx scope_let.scope_let_expr in
let new_ctx = Var.Map.add old_scope_let_var new_scope_let_var ctx in
let new_scope_next = translate_scope_lets decl_ctx new_ctx scope_let_next in
let new_scope_next = Bindlib.bind_var new_scope_let_var new_scope_next in
let new_scope_next = translate_scope_lets decl_ctx ctx scope_let_next in
let new_scope_next =
Bindlib.bind_var (translate_var scope_let_var) new_scope_next
in
Bindlib.box_apply2
(fun new_scope_next new_scope_let_expr ->
ScopeLet
@ -139,58 +137,38 @@ let rec translate_scope_lets
new_scope_next
(Expr.Box.lift new_scope_let_expr)
let rec translate_scopes
let translate_items
(decl_ctx : decl_ctx)
(ctx : 'm ctx)
(scopes : 'm D.expr scopes) : 'm A.expr scopes Bindlib.box =
match scopes with
| Nil -> Bindlib.box Nil
| ScopeDef scope_def ->
let old_scope_var, scope_next = Bindlib.unbind scope_def.scope_next in
let new_scope_var =
Var.make (Marked.unmark (ScopeName.get_info scope_def.scope_name))
in
let old_scope_input_var, scope_body_expr =
Bindlib.unbind scope_def.scope_body.scope_body_expr
in
let new_scope_input_var = Var.make (Bindlib.name_of old_scope_input_var) in
let new_ctx = Var.Map.add old_scope_input_var new_scope_input_var ctx in
let new_scope_body_expr =
translate_scope_lets decl_ctx new_ctx scope_body_expr
in
let new_scope_body_expr =
Bindlib.bind_var new_scope_input_var new_scope_body_expr
in
let new_scope : 'm A.expr scope_body Bindlib.box =
Bindlib.box_apply
(fun new_scope_body_expr ->
{
scope_body_input_struct =
scope_def.scope_body.scope_body_input_struct;
scope_body_output_struct =
scope_def.scope_body.scope_body_output_struct;
scope_body_expr = new_scope_body_expr;
})
new_scope_body_expr
in
let new_ctx = Var.Map.add old_scope_var new_scope_var new_ctx in
let scope_next =
Bindlib.bind_var new_scope_var
(translate_scopes decl_ctx new_ctx scope_next)
in
Bindlib.box_apply2
(fun new_scope scope_next ->
ScopeDef
{
scope_name = scope_def.scope_name;
scope_body = new_scope;
scope_next;
})
new_scope scope_next
(scopes : 'm D.expr code_item_list) : 'm A.expr code_item_list Bindlib.box =
Scope.map_ctx
~f:
(fun ctx -> function
| Topdef (name, ty, e) ->
( ctx,
Bindlib.box_apply
(fun e -> Topdef (name, ty, e))
(Expr.Box.lift (translate_expr ctx e)) )
| ScopeDef (name, body) ->
let scope_input_var, body_expr =
Bindlib.unbind body.scope_body_expr
in
let new_scope_body_expr =
translate_scope_lets decl_ctx ctx body_expr
in
let new_body =
Bindlib.bind_var (translate_var scope_input_var) new_scope_body_expr
in
( ctx,
Bindlib.box_apply
(fun scope_body_expr ->
ScopeDef (name, { body with scope_body_expr }))
new_body ))
~varf:translate_var ctx scopes
let translate_program (prgm : 'm D.program) : 'm A.program =
{
scopes =
Bindlib.unbox (translate_scopes prgm.decl_ctx Var.Map.empty prgm.scopes);
code_items =
Bindlib.unbox (translate_items prgm.decl_ctx () prgm.code_items);
decl_ctx = prgm.decl_ctx;
}

72
compiler/lcalc/compile_without_exceptions.ml
View File

@ -268,6 +268,19 @@ let rec translate_and_hoist (ctx : 'm ctx) (e : 'm D.expr) :
let e1', hoists = translate_and_hoist ctx e1 in
let e1' = Expr.estructaccess e1' field name mark in
e1', hoists
| ETuple es ->
let hoists, es' =
List.fold_left_map
(fun hoists e ->
let e, h = translate_and_hoist ctx e in
h :: hoists, e)
[] es
in
Expr.etuple es' mark, disjoint_union_maps (Expr.pos e) hoists
| ETupleAccess { e = e1; index; size } ->
let e1', hoists = translate_and_hoist ctx e1 in
let e1' = Expr.etupleaccess e1' index size mark in
e1', hoists
| EInj { name; e = e1; cons } ->
let e1', hoists = translate_and_hoist ctx e1 in
let e1' = Expr.einj e1' cons name mark in
@ -498,39 +511,34 @@ let translate_scope_body
})
(Bindlib.bind_var v' (translate_scope_let ctx' lets))
let rec translate_scopes (ctx : 'm ctx) (scopes : 'm D.expr scopes) :
'm A.expr scopes Bindlib.box =
match scopes with
| Nil -> Bindlib.box Nil
| ScopeDef { scope_name; scope_body; scope_next } ->
let scope_var, next = Bindlib.unbind scope_next in
let vmark =
match Bindlib.unbind scope_body.scope_body_expr with
| _, (Result e | ScopeLet { scope_let_expr = e; _ }) -> Marked.get_mark e
in
let new_ctx = add_var vmark scope_var true ctx in
let new_scope_name =
(find ~info:"variable that was just created" scope_var new_ctx).var
in
let scope_pos = Marked.get_mark (ScopeName.get_info scope_name) in
let new_body = translate_scope_body scope_pos ctx scope_body in
let tail = translate_scopes new_ctx next in
Bindlib.box_apply2
(fun body tail ->
ScopeDef { scope_name; scope_body = body; scope_next = tail })
new_body
(Bindlib.bind_var new_scope_name tail)
let translate_code_items (ctx : 'm ctx) (scopes : 'm D.expr code_item_list) :
'm A.expr code_item_list Bindlib.box =
let _ctx, scopes =
Scope.fold_map
~f:
(fun ctx var -> function
| Topdef (name, ty, e) ->
( add_var (Marked.get_mark e) var true ctx,
Bindlib.box_apply
(fun e -> Topdef (name, ty, e))
(Expr.Box.lift (translate_expr ~append_esome:false ctx e)) )
| ScopeDef (scope_name, scope_body) ->
( ctx,
let scope_pos = Marked.get_mark (ScopeName.get_info scope_name) in
Bindlib.box_apply
(fun body -> ScopeDef (scope_name, body))
(translate_scope_body scope_pos ctx scope_body) ))
~varf:Var.translate ctx scopes
in
scopes
let translate_program (prgm : 'm D.program) : 'm A.program =
let inputs_structs =
Scope.fold_left prgm.scopes ~init:[] ~f:(fun acc scope_def _ ->
scope_def.scope_body.scope_body_input_struct :: acc)
Scope.fold_left prgm.code_items ~init:[] ~f:(fun acc def _ ->
match def with
| ScopeDef (_, body) -> body.scope_body_input_struct :: acc
| Topdef _ -> acc)
in
(* Cli.debug_print @@ Format.asprintf "List of structs to modify: [%a]"
(Format.pp_print_list D.StructName.format_t) inputs_structs; *)
let decl_ctx =
@ -557,9 +565,9 @@ let translate_program (prgm : 'm D.program) : 'm A.program =
}
in
let scopes =
let code_items =
Bindlib.unbox
(translate_scopes { decl_ctx; vars = Var.Map.empty } prgm.scopes)
(translate_code_items { decl_ctx; vars = Var.Map.empty } prgm.code_items)
in
{ scopes; decl_ctx }
{ code_items; decl_ctx }

18
compiler/lcalc/optimizations.ml
View File

@ -53,16 +53,20 @@ let rec beta_expr (e : 'm expr) : 'm expr boxed =
| _ -> visitor_map beta_expr e
let iota_optimizations (p : 'm program) : 'm program =
let new_scopes = Scope.map_exprs ~f:iota_expr ~varf:(fun v -> v) p.scopes in
{ p with scopes = Bindlib.unbox new_scopes }
let new_code_items =
Scope.map_exprs ~f:iota_expr ~varf:(fun v -> v) p.code_items
in
{ p with code_items = Bindlib.unbox new_code_items }
(* TODO: beta optimizations apply inlining of the program. We left the inclusion
of beta-optimization as future work since its produce code that is harder to
read, and can produce exponential blowup of the size of the generated
program. *)
let _beta_optimizations (p : 'm program) : 'm program =
let new_scopes = Scope.map_exprs ~f:beta_expr ~varf:(fun v -> v) p.scopes in
{ p with scopes = Bindlib.unbox new_scopes }
let new_code_items =
Scope.map_exprs ~f:beta_expr ~varf:(fun v -> v) p.code_items
in
{ p with code_items = Bindlib.unbox new_code_items }
let rec peephole_expr (e : 'm expr) : 'm expr boxed =
let m = Marked.get_mark e in
@ -95,10 +99,10 @@ let rec peephole_expr (e : 'm expr) : 'm expr boxed =
| _ -> visitor_map peephole_expr e
let peephole_optimizations (p : 'm program) : 'm program =
let new_scopes =
Scope.map_exprs ~f:peephole_expr ~varf:(fun v -> v) p.scopes
let new_code_items =
Scope.map_exprs ~f:peephole_expr ~varf:(fun v -> v) p.code_items
in
{ p with scopes = Bindlib.unbox new_scopes }
{ p with code_items = Bindlib.unbox new_code_items }
let optimize_program (p : 'm program) : untyped program =
p |> iota_optimizations |> peephole_optimizations |> Program.untype

40
compiler/lcalc/to_ocaml.ml
View File

@ -504,24 +504,27 @@ let rec format_scope_body_expr
(format_scope_body_expr ctx)
scope_let_next
let rec format_scopes
let format_code_items
(ctx : decl_ctx)
(fmt : Format.formatter)
(scopes : 'm Ast.expr scopes) : unit =
match scopes with
| Nil -> ()
| ScopeDef scope_def ->
let scope_input_var, scope_body_expr =
Bindlib.unbind scope_def.scope_body.scope_body_expr
in
let scope_var, scope_next = Bindlib.unbind scope_def.scope_next in
Format.fprintf fmt "@\n@\n@[<hov 2>let %a (%a: %a.t) : %a.t =@\n%a@]%a"
format_var scope_var format_var scope_input_var format_to_module_name
(`Sname scope_def.scope_body.scope_body_input_struct)
format_to_module_name
(`Sname scope_def.scope_body.scope_body_output_struct)
(format_scope_body_expr ctx)
scope_body_expr (format_scopes ctx) scope_next
(code_items : 'm Ast.expr code_item_list) : unit =
Scope.fold_left
~f:(fun () item var ->
match item with
| Topdef (_, typ, e) ->
Format.fprintf fmt "@\n@\n@[<hov 2>let %a : %a =@\n%a@]" format_var var
format_typ typ (format_expr ctx) e
| ScopeDef (_, body) ->
let scope_input_var, scope_body_expr =
Bindlib.unbind body.scope_body_expr
in
Format.fprintf fmt "@\n@\n@[<hov 2>let %a (%a: %a.t) : %a.t =@\n%a@]"
format_var var format_var scope_input_var format_to_module_name
(`Sname body.scope_body_input_struct) format_to_module_name
(`Sname body.scope_body_output_struct)
(format_scope_body_expr ctx)
scope_body_expr)
~init:() code_items
let format_program
(fmt : Format.formatter)
@ -538,5 +541,6 @@ let format_program
@\n\
%a%a@\n\
@?"
(format_ctx type_ordering) p.decl_ctx (format_scopes p.decl_ctx)
p.scopes)
(format_ctx type_ordering) p.decl_ctx
(format_code_items p.decl_ctx)
p.code_items)

79
compiler/plugins/api_web.ml
View File

@ -329,48 +329,49 @@ module To_jsoo = struct
Format.fprintf fmt "%a@\n" format_enum_decl (e, find_enum e ctx))
(type_ordering @ scope_structs)
let fmt_input_struct_name fmt (scope_def : 'a expr scope_def) =
format_struct_name fmt scope_def.scope_body.scope_body_input_struct
let fmt_input_struct_name fmt (scope_body : 'a expr scope_body) =
format_struct_name fmt scope_body.scope_body_input_struct
let fmt_output_struct_name fmt (scope_def : 'a expr scope_def) =
format_struct_name fmt scope_def.scope_body.scope_body_output_struct
let fmt_output_struct_name fmt (scope_body : 'a expr scope_body) =
format_struct_name fmt scope_body.scope_body_output_struct
let rec format_scopes_to_fun
(ctx : decl_ctx)
let format_scopes_to_fun
(_ctx : decl_ctx)
(fmt : Format.formatter)
(scopes : 'e scopes) =
match scopes with
| Nil -> ()
| ScopeDef scope_def ->
let scope_var, scope_next = Bindlib.unbind scope_def.scope_next in
let fmt_fun_call fmt _ =
Format.fprintf fmt "@[<hv>%a@ |> %a_of_jsoo@ |> %a@ |> %a_to_jsoo@]"
fmt_input_struct_name scope_def fmt_input_struct_name scope_def
format_var scope_var fmt_output_struct_name scope_def
in
Format.fprintf fmt
"@\n@\n@[<hov 2>let %a@ (%a : %a Js.t)@ : %a Js.t =@\n%a@]@\n%a"
format_var scope_var fmt_input_struct_name scope_def
fmt_input_struct_name scope_def fmt_output_struct_name scope_def
fmt_fun_call () (format_scopes_to_fun ctx) scope_next
(scopes : 'e code_item_list) =
Scope.fold_left
~f:(fun () code_item var ->
match code_item with
| Topdef _ -> ()
| ScopeDef (_name, body) ->
let fmt_fun_call fmt _ =
Format.fprintf fmt "@[<hv>%a@ |> %a_of_jsoo@ |> %a@ |> %a_to_jsoo@]"
fmt_input_struct_name body fmt_input_struct_name body format_var
var fmt_output_struct_name body
in
Format.fprintf fmt
"@\n@\n@[<hov 2>let %a@ (%a : %a Js.t)@ : %a Js.t =@\n%a@]@\n"
format_var var fmt_input_struct_name body fmt_input_struct_name body
fmt_output_struct_name body fmt_fun_call ())
~init:() scopes
let rec format_scopes_to_callbacks
(ctx : decl_ctx)
let format_scopes_to_callbacks
(_ctx : decl_ctx)
(fmt : Format.formatter)
(scopes : 'e scopes) : unit =
match scopes with
| Nil -> ()
| ScopeDef scope_def ->
let scope_var, scope_next = Bindlib.unbind scope_def.scope_next in
let fmt_meth_name fmt _ =
Format.fprintf fmt "method %a : (%a Js.t -> %a Js.t) Js.callback"
format_var_camel_case scope_var fmt_input_struct_name scope_def
fmt_output_struct_name scope_def
in
Format.fprintf fmt "@,@[<hov 2>%a =@ Js.wrap_callback@ %a@]@,%a"
fmt_meth_name () format_var scope_var
(format_scopes_to_callbacks ctx)
scope_next
(scopes : 'e code_item_list) : unit =
Scope.fold_left
~f:(fun () code_item var ->
match code_item with
| Topdef _ -> ()
| ScopeDef (_name, body) ->
let fmt_meth_name fmt _ =
Format.fprintf fmt "method %a : (%a Js.t -> %a Js.t) Js.callback"
format_var_camel_case var fmt_input_struct_name body
fmt_output_struct_name body
in
Format.fprintf fmt "@,@[<hov 2>%a =@ Js.wrap_callback@ %a@]@,"
fmt_meth_name () format_var var)
~init:() scopes
let format_program
(fmt : Format.formatter)
@ -411,9 +412,9 @@ module To_jsoo = struct
(Option.fold ~none:"" ~some:(fun name -> name) module_name)
(format_ctx type_ordering) prgm.decl_ctx
(format_scopes_to_fun prgm.decl_ctx)
prgm.scopes fmt_lib_name ()
prgm.code_items fmt_lib_name ()
(format_scopes_to_callbacks prgm.decl_ctx)
prgm.scopes)
prgm.code_items)
end
let apply

23
compiler/plugins/json_schema.ml
View File

@ -48,14 +48,15 @@ module To_json = struct
Format.fprintf fmt "%s" s
let rec find_scope_def (target_name : string) :
'm expr scopes -> 'm expr scope_def option = function
'm expr code_item_list -> (ScopeName.t * 'm expr scope_body) option =
function
| Nil -> None
| ScopeDef scope_def ->
let name = Format.asprintf "%a" ScopeName.format_t scope_def.scope_name in
if name = target_name then Some scope_def
else
let _, next_scope = Bindlib.unbind scope_def.scope_next in
find_scope_def target_name next_scope
| Cons (ScopeDef (name, body), _)
when String.equal target_name (Marked.unmark (ScopeName.get_info name)) ->
Some (name, body)
| Cons (_, next_bind) ->
let _, next_scope = Bindlib.unbind next_bind in
find_scope_def target_name next_scope
let fmt_tlit fmt (tlit : typ_lit) =
match tlit with
@ -101,7 +102,7 @@ module To_json = struct
let fmt_definitions
(ctx : decl_ctx)
(fmt : Format.formatter)
(scope_def : 'e scope_def) =
((_scope_name, scope_body) : ScopeName.t * 'e scope_body) =
let get_name t =
match Marked.unmark t with
| TStruct sname -> Format.asprintf "%a" format_struct_name sname
@ -198,13 +199,13 @@ module To_json = struct
format_enum_name ename fmt_enum_properties ename
| _ -> ()))
(collect_required_type_defs_from_scope_input
scope_def.scope_body.scope_body_input_struct)
scope_body.scope_body_input_struct)
let format_program
(fmt : Format.formatter)
(scope : string)
(prgm : 'm Lcalc.Ast.program) =
match find_scope_def scope prgm.scopes with
match find_scope_def scope prgm.code_items with
| None -> Cli.error_print "Internal error: scope '%s' not found." scope
| Some scope_def ->
Cli.call_unstyled (fun _ ->
@ -220,7 +221,7 @@ module To_json = struct
(fmt_definitions prgm.decl_ctx)
scope_def
(fmt_struct_properties prgm.decl_ctx)
scope_def.scope_body.scope_body_input_struct)
(snd scope_def).scope_body_input_struct)
end
let apply

33
compiler/scalc/ast.ml
View File

@ -18,18 +18,18 @@ open Catala_utils
open Shared_ast
module D = Dcalc.Ast
module L = Lcalc.Ast
module TopLevelName = Uid.Make (Uid.MarkedString) ()
module LocalName = Uid.Make (Uid.MarkedString) ()
module FuncName = Uid.Gen ()
module VarName = Uid.Gen ()
let dead_value = LocalName.fresh ("dead_value", Pos.no_pos)
let handle_default = TopLevelName.fresh ("handle_default", Pos.no_pos)
let handle_default_opt = TopLevelName.fresh ("handle_default_opt", Pos.no_pos)
let dead_value = VarName.fresh ("dead_value", Pos.no_pos)
let handle_default = FuncName.fresh ("handle_default", Pos.no_pos)
let handle_default_opt = FuncName.fresh ("handle_default_opt", Pos.no_pos)
type expr = naked_expr Marked.pos
and naked_expr =
| EVar : LocalName.t -> naked_expr
| EFunc : TopLevelName.t -> naked_expr
| EVar : VarName.t -> naked_expr
| EFunc : FuncName.t -> naked_expr
| EStruct : expr list * StructName.t -> naked_expr
| EStructFieldAccess : expr * StructField.t * StructName.t -> naked_expr
| EInj : expr * EnumConstructor.t * EnumName.t -> naked_expr
@ -39,9 +39,9 @@ and naked_expr =
| EOp : (lcalc, _) operator -> naked_expr
type stmt =
| SInnerFuncDef of LocalName.t Marked.pos * func
| SLocalDecl of LocalName.t Marked.pos * typ
| SLocalDef of LocalName.t Marked.pos * expr
| SInnerFuncDef of VarName.t Marked.pos * func
| SLocalDecl of VarName.t Marked.pos * typ
| SLocalDef of VarName.t Marked.pos * expr
| STryExcept of block * except * block
| SRaise of except
| SIfThenElse of expr * block * block
@ -49,7 +49,7 @@ type stmt =
expr
* EnumName.t
* (block (* Statements corresponding to arm closure body*)
* (* Variable instantiated with enum payload *) LocalName.t)
* (* Variable instantiated with enum payload *) VarName.t)
list (** Each block corresponds to one case of the enum *)
| SReturn of naked_expr
| SAssert of naked_expr
@ -57,14 +57,19 @@ type stmt =
and block = stmt Marked.pos list
and func = {
func_params : (LocalName.t Marked.pos * typ) list;
func_params : (VarName.t Marked.pos * typ) list;
func_body : block;
}
type scope_body = {
scope_body_name : ScopeName.t;
scope_body_var : TopLevelName.t;
scope_body_var : FuncName.t;
scope_body_func : func;
}
type program = { decl_ctx : decl_ctx; scopes : scope_body list }
type code_item =
| SVar of { var : VarName.t; expr : expr }
| SFunc of { var : FuncName.t; func : func }
| SScope of scope_body
type program = { decl_ctx : decl_ctx; code_items : code_item list }

210
compiler/scalc/compile_from_lambda.ml → compiler/scalc/from_lambda.ml
View File

@ -21,10 +21,10 @@ module L = Lcalc.Ast
module D = Dcalc.Ast
type 'm ctxt = {
func_dict : ('m L.expr, A.TopLevelName.t) Var.Map.t;
func_dict : ('m L.expr, A.FuncName.t) Var.Map.t;
decl_ctx : decl_ctx;
var_dict : ('m L.expr, A.LocalName.t) Var.Map.t;
inside_definition_of : A.LocalName.t option;
var_dict : ('m L.expr, A.VarName.t) Var.Map.t;
inside_definition_of : A.VarName.t option;
context_name : string;
}
@ -90,14 +90,14 @@ let rec translate_expr (ctxt : 'm ctxt) (expr : 'm L.expr) : A.block * A.expr =
| ELit l -> [], (A.ELit l, Expr.pos expr)
| _ ->
let tmp_var =
A.LocalName.fresh
A.VarName.fresh
( (*This piece of logic is used to make the code more readable. TODO:
should be removed when
https://github.com/CatalaLang/catala/issues/240 is fixed. *)
(match ctxt.inside_definition_of with
| None -> ctxt.context_name
| Some v ->
let v = Marked.unmark (A.LocalName.get_info v) in
let v = Marked.unmark (A.VarName.get_info v) in
let tmp_rex = Re.Pcre.regexp "^temp_" in
if Re.Pcre.pmatch ~rex:tmp_rex v then v else "temp_" ^ v),
Expr.pos expr )
@ -106,7 +106,7 @@ let rec translate_expr (ctxt : 'm ctxt) (expr : 'm L.expr) : A.block * A.expr =
{
ctxt with
inside_definition_of = Some tmp_var;
context_name = Marked.unmark (A.LocalName.get_info tmp_var);
context_name = Marked.unmark (A.VarName.get_info tmp_var);
}
in
let tmp_stmts = translate_statements ctxt expr in
@ -133,7 +133,7 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
List.fold_left
(fun var_dict (x, _) ->
Var.Map.add x
(A.LocalName.fresh (Bindlib.name_of x, binder_pos))
(A.VarName.fresh (Bindlib.name_of x, binder_pos))
var_dict)
ctxt.var_dict vars_tau;
}
@ -159,7 +159,7 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
ctxt with
inside_definition_of = Some (Marked.unmark x);
context_name =
Marked.unmark (A.LocalName.get_info (Marked.unmark x));
Marked.unmark (A.VarName.get_info (Marked.unmark x));
}
in
let arg_stmts, new_arg = translate_expr ctxt arg in
@ -174,7 +174,7 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
let vars_tau = List.map2 (fun x tau -> x, tau) (Array.to_list vars) tys in
let closure_name =
match ctxt.inside_definition_of with
| None -> A.LocalName.fresh (ctxt.context_name, Expr.pos block_expr)
| None -> A.VarName.fresh (ctxt.context_name, Expr.pos block_expr)
| Some x -> x
in
let ctxt =
@ -184,7 +184,7 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
List.fold_left
(fun var_dict (x, _) ->
Var.Map.add x
(A.LocalName.fresh (Bindlib.name_of x, binder_pos))
(A.VarName.fresh (Bindlib.name_of x, binder_pos))
var_dict)
ctxt.var_dict vars_tau;
inside_definition_of = None;
@ -215,7 +215,7 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
assert (Array.length vars = 1);
let var = vars.(0) in
let scalc_var =
A.LocalName.fresh (Bindlib.name_of var, Expr.pos arg)
A.VarName.fresh (Bindlib.name_of var, Expr.pos arg)
in
let ctxt =
{ ctxt with var_dict = Var.Map.add var scalc_var ctxt.var_dict }
@ -272,8 +272,8 @@ and translate_statements (ctxt : 'm ctxt) (block_expr : 'm L.expr) : A.block =
let rec translate_scope_body_expr
(scope_name : ScopeName.t)
(decl_ctx : decl_ctx)
(var_dict : ('m L.expr, A.LocalName.t) Var.Map.t)
(func_dict : ('m L.expr, A.TopLevelName.t) Var.Map.t)
(var_dict : ('m L.expr, A.VarName.t) Var.Map.t)
(func_dict : ('m L.expr, A.FuncName.t) Var.Map.t)
(scope_expr : 'm L.expr scope_body_expr) : A.block =
match scope_expr with
| Result e ->
@ -292,7 +292,7 @@ let rec translate_scope_body_expr
| ScopeLet scope_let ->
let let_var, scope_let_next = Bindlib.unbind scope_let.scope_let_next in
let let_var_id =
A.LocalName.fresh (Bindlib.name_of let_var, scope_let.scope_let_pos)
A.VarName.fresh (Bindlib.name_of let_var, scope_let.scope_let_pos)
in
let new_var_dict = Var.Map.add let_var let_var_id var_dict in
(match scope_let.scope_let_kind with
@ -330,54 +330,136 @@ let rec translate_scope_body_expr
scope_let_next
let translate_program (p : 'm L.program) : A.program =
{
decl_ctx = p.decl_ctx;
scopes =
(let _, new_scopes =
Scope.fold_left
~f:(fun (func_dict, new_scopes) scope_def scope_var ->
let scope_input_var, scope_body_expr =
Bindlib.unbind scope_def.scope_body.scope_body_expr
in
let input_pos =
Marked.get_mark (ScopeName.get_info scope_def.scope_name)
in
let scope_input_var_id =
A.LocalName.fresh (Bindlib.name_of scope_input_var, input_pos)
in
let var_dict =
Var.Map.singleton scope_input_var scope_input_var_id
in
let new_scope_body =
translate_scope_body_expr scope_def.scope_name p.decl_ctx
var_dict func_dict scope_body_expr
in
let func_id =
A.TopLevelName.fresh (Bindlib.name_of scope_var, Pos.no_pos)
in
let func_dict = Var.Map.add scope_var func_id func_dict in
( func_dict,
{
Ast.scope_body_name = scope_def.scope_name;
Ast.scope_body_var = func_id;
scope_body_func =
let _, _, rev_items =
Scope.fold_left
~f:(fun (func_dict, var_dict, rev_items) code_item var ->
match code_item with
| ScopeDef (name, body) ->
let scope_input_var, scope_body_expr =
Bindlib.unbind body.scope_body_expr
in
let input_pos = Marked.get_mark (ScopeName.get_info name) in
let scope_input_var_id =
A.VarName.fresh (Bindlib.name_of scope_input_var, input_pos)
in
let var_dict_local =
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
in
let func_id = A.FuncName.fresh (Bindlib.name_of var, Pos.no_pos) in
( Var.Map.add var func_id func_dict,
var_dict,
A.SScope
{
Ast.scope_body_name = name;
Ast.scope_body_var = func_id;
scope_body_func =
{
A.func_params =
[
( (scope_input_var_id, input_pos),
(TStruct body.scope_body_input_struct, input_pos) );
];
A.func_body = new_scope_body;
};
}
:: rev_items )
| Topdef (name, _, (EAbs abs, _)) ->
(* Toplevel function def *)
let func_id = A.FuncName.fresh (Bindlib.name_of var, Pos.no_pos) in
let args_a, expr = Bindlib.unmbind abs.binder in
let args = Array.to_list args_a in
let args_id =
List.map2
(fun v ty ->
let pos = Marked.get_mark ty in
(A.VarName.fresh (Bindlib.name_of v, pos), pos), ty)
args abs.tys
in
let block, expr =
let ctxt =
{
func_dict;
decl_ctx = p.decl_ctx;
var_dict =
List.fold_left2
(fun map arg ((id, _), _) -> Var.Map.add arg id map)
var_dict args args_id;
inside_definition_of = None;
context_name = Marked.unmark (TopdefName.get_info name);
}
in
translate_expr ctxt expr
in
let body_block =
block @ [A.SReturn (Marked.unmark expr), Marked.get_mark expr]
in
( Var.Map.add var func_id func_dict,
var_dict,
A.SFunc
{
var = func_id;
func = { A.func_params = args_id; A.func_body = body_block };
}
:: rev_items )
| Topdef (name, _ty, expr) ->
(* Toplevel constant def *)
let var_id = A.VarName.fresh (Bindlib.name_of var, Pos.no_pos) in
let block, expr =
let ctxt =
{
func_dict;
decl_ctx = p.decl_ctx;
var_dict;
inside_definition_of = None;
context_name = Marked.unmark (TopdefName.get_info name);
}
in
translate_expr ctxt expr
in
(* If the evaluation of the toplevel expr requires preliminary
statements, we lift its computation into an auxiliary function *)
let rev_items =
match block with
| [] -> A.SVar { var = var_id; expr } :: rev_items
| block ->
let pos = Marked.get_mark expr in
let func_id =
A.FuncName.fresh (Bindlib.name_of var ^ "_aux", pos)
in
(* The list is being built in reverse order *)
A.SVar
{ var = var_id; expr = A.EApp ((EFunc func_id, pos), []), pos }
:: A.SFunc
{
A.func_params =
[
( (scope_input_var_id, input_pos),
( TStruct scope_def.scope_body.scope_body_input_struct,
input_pos ) );
];
A.func_body = new_scope_body;
};
}
:: new_scopes ))
~init:
( (if !Cli.avoid_exceptions_flag then
Var.Map.singleton L.handle_default_opt A.handle_default_opt
else Var.Map.singleton L.handle_default A.handle_default),
[] )
p.scopes
in
List.rev new_scopes);
}
var = func_id;
func =
{
A.func_params = [];
A.func_body =
block
@ [
( A.SReturn (Marked.unmark expr),
Marked.get_mark expr );
];
};
}
:: rev_items
in
( func_dict,
(* No need to add func_id since the function will only be called
right here *)
Var.Map.add var var_id var_dict,
rev_items ))
~init:
( (if !Cli.avoid_exceptions_flag then
Var.Map.singleton L.handle_default_opt A.handle_default_opt
else Var.Map.singleton L.handle_default A.handle_default),
Var.Map.empty,
[] )
p.code_items
in
{ decl_ctx = p.decl_ctx; code_items = List.rev rev_items }

75
compiler/scalc/print.ml
View File

@ -20,9 +20,12 @@ open Ast
let needs_parens (_e : expr) : bool = false
let format_local_name (fmt : Format.formatter) (v : LocalName.t) : unit =
Format.fprintf fmt "%a_%s" LocalName.format_t v
(string_of_int (LocalName.hash v))
let format_var_name (fmt : Format.formatter) (v : VarName.t) : unit =
Format.fprintf fmt "%a_%s" VarName.format_t v (string_of_int (VarName.hash v))
let format_func_name (fmt : Format.formatter) (v : FuncName.t) : unit =
Format.fprintf fmt "%a_%s" FuncName.format_t v
(string_of_int (FuncName.hash v))
let rec format_expr
(decl_ctx : decl_ctx)
@ -37,8 +40,8 @@ let rec format_expr
else Format.fprintf fmt "%a" format_expr e
in
match Marked.unmark e with
| EVar v -> Format.fprintf fmt "%a" format_local_name v
| EFunc v -> Format.fprintf fmt "%a" TopLevelName.format_t v
| EVar v -> Format.fprintf fmt "%a" format_var_name v
| EFunc v -> Format.fprintf fmt "%a" format_func_name v
| EStruct (es, s) ->
Format.fprintf fmt "@[<hov 2>%a@ %a%a%a@]" StructName.format_t s
Print.punctuation "{"
@ -75,6 +78,7 @@ let rec format_expr
| EApp ((EOp op, _), [arg1]) ->
Format.fprintf fmt "@[<hov 2>%a@ %a@]" Print.operator op format_with_parens
arg1
| EApp (f, []) -> Format.fprintf fmt "@[<hov 2>%a@ ()@]" format_expr f
| EApp (f, args) ->
Format.fprintf fmt "@[<hov 2>%a@ %a@]" format_expr f
(Format.pp_print_list
@ -92,22 +96,22 @@ let rec format_statement
match Marked.unmark stmt with
| SInnerFuncDef (name, func) ->
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@ %a@]@\n@[<v 2> %a@]" Print.keyword
"let" format_local_name (Marked.unmark name)
"let" format_var_name (Marked.unmark name)
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
(fun fmt ((name, _), typ) ->
Format.fprintf fmt "%a%a %a@ %a%a" Print.punctuation "("
format_local_name name Print.punctuation ":" (Print.typ decl_ctx)
typ Print.punctuation ")"))
format_var_name name Print.punctuation ":" (Print.typ decl_ctx) typ
Print.punctuation ")"))
func.func_params Print.punctuation "="
(format_block decl_ctx ~debug)
func.func_body
| SLocalDecl (name, typ) ->
Format.fprintf fmt "@[<hov 2>%a %a %a@ %a@]" Print.keyword "decl"
format_local_name (Marked.unmark name) Print.punctuation ":"
format_var_name (Marked.unmark name) Print.punctuation ":"
(Print.typ decl_ctx) typ
| SLocalDef (name, naked_expr) ->
Format.fprintf fmt "@[<hov 2>%a %a@ %a@]" format_local_name
Format.fprintf fmt "@[<hov 2>%a %a@ %a@]" format_var_name
(Marked.unmark name) Print.punctuation "="
(format_expr decl_ctx ~debug)
naked_expr
@ -147,7 +151,7 @@ let rec format_statement
(fun fmt ((case, _), (arm_block, payload_name)) ->
Format.fprintf fmt "%a %a%a@ %a @[<v 2>%a@ %a@]" Print.punctuation
"|" Print.enum_constructor case Print.punctuation ":"
format_local_name payload_name Print.punctuation "→"
format_var_name payload_name Print.punctuation "→"
(format_block decl_ctx ~debug)
arm_block))
(List.combine
@ -165,20 +169,35 @@ and format_block
(format_statement decl_ctx ~debug)
fmt block
let format_scope
(decl_ctx : decl_ctx)
?(debug : bool = false)
(fmt : Format.formatter)
(body : scope_body) : unit =
if debug then () else ();
Format.fprintf fmt "@[<hov 2>%a@ %a@ %a@ %a@]@\n@[<v 2> %a@]" Print.keyword
"let" TopLevelName.format_t body.scope_body_var
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@ ")
(fun fmt ((name, _), typ) ->
Format.fprintf fmt "%a%a %a@ %a%a" Print.punctuation "("
format_local_name name Print.punctuation ":" (Print.typ decl_ctx) typ
Print.punctuation ")"))
body.scope_body_func.func_params Print.punctuation "="
(format_block decl_ctx ~debug)
body.scope_body_func.func_body
let format_item decl_ctx ?debug ppf def =
Format.pp_open_hvbox ppf 2;
Format.pp_open_hovbox ppf 4;
Print.keyword ppf "let ";
let () =
match def with
| SVar { var; expr } ->
format_var_name ppf var;
Print.punctuation ppf " =";
Format.pp_close_box ppf ();
Format.pp_print_space ppf ();
format_expr decl_ctx ?debug ppf expr
| SScope { scope_body_var = var; scope_body_func = func; _ }
| SFunc { var; func } ->
format_func_name ppf var;
Format.pp_print_list
(fun ppf (arg, ty) ->
Format.fprintf ppf "@ (%a: %a)" format_var_name (Marked.unmark arg)
(Print.typ decl_ctx) ty)
ppf func.func_params;
Print.punctuation ppf " =";
Format.pp_close_box ppf ();
Format.pp_print_space ppf ();
format_block decl_ctx ?debug ppf func.func_body
in
Format.pp_close_box ppf ();
Format.pp_print_cut ppf ()
let format_program decl_ctx ?debug ppf prg =
Format.pp_open_vbox ppf 0;
Format.pp_print_list (format_item decl_ctx ?debug) ppf prg.code_items;
Format.pp_close_box ppf ()

7
compiler/scalc/print.mli
View File

@ -14,9 +14,12 @@
License for the specific language governing permissions and limitations under
the License. *)
val format_scope :
val format_item :
Shared_ast.decl_ctx ->
?debug:bool ->
Format.formatter ->
Ast.scope_body ->
Ast.code_item ->
unit
val format_program :
Shared_ast.decl_ctx -> ?debug:bool -> Format.formatter -> Ast.program -> unit

4
compiler/scalc/scalc.mld
View File

@ -12,13 +12,13 @@ The module describing the abstract syntax tree is:
{1 Compilation from lambda calculus }
{!module: Scalc.Compile_from_lambda} Performs the classical translation
{!module: Scalc.From_lambda} Performs the classical translation
from an expression-based language to a statement-based language. Union types
are eliminated in favor of tagged unions.
Related modules:
{!modules: Scalc.Compile_from_lambda}
{!modules: Scalc.From_lambda}
{1 Backends}

50
compiler/scalc/to_python.ml
View File

@ -203,16 +203,16 @@ let format_name_cleaned (fmt : Format.formatter) (s : string) : unit =
module StringMap = Map.Make (String)
module IntMap = Map.Make (Int)
(** For each `LocalName.t` defined by its string and then by its hash, we keep
(** For each `VarName.t` defined by its string and then by its hash, we keep
track of which local integer id we've given it. This is used to keep
variable naming with low indices rather than one global counter for all
variables. TODO: should be removed when
https://github.com/CatalaLang/catala/issues/240 is fixed. *)
let string_counter_map : int IntMap.t StringMap.t ref = ref StringMap.empty
let format_var (fmt : Format.formatter) (v : LocalName.t) : unit =
let v_str = Marked.unmark (LocalName.get_info v) in
let hash = LocalName.hash v in
let format_var (fmt : Format.formatter) (v : VarName.t) : unit =
let v_str = Marked.unmark (VarName.get_info v) in
let hash = VarName.hash v in
let local_id =
match StringMap.find_opt v_str !string_counter_map with
| Some ids -> (
@ -241,10 +241,13 @@ let format_var (fmt : Format.formatter) (v : LocalName.t) : unit =
else if local_id = 0 then format_name_cleaned fmt v_str
else Format.fprintf fmt "%a_%d" format_name_cleaned v_str local_id
let format_toplevel_name (fmt : Format.formatter) (v : TopLevelName.t) : unit =
let v_str = Marked.unmark (TopLevelName.get_info v) in
let format_func_name (fmt : Format.formatter) (v : FuncName.t) : unit =
let v_str = Marked.unmark (FuncName.get_info v) in
format_name_cleaned fmt v_str
let format_var_name (fmt : Format.formatter) (v : VarName.t) : unit =
Format.fprintf fmt "%a_%s" VarName.format_t v (string_of_int (VarName.hash v))
let needs_parens (e : expr) : bool =
match Marked.unmark e with
| ELit (LBool _ | LUnit) | EVar _ | EOp _ -> false
@ -276,7 +279,7 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
unit =
match Marked.unmark e with
| EVar v -> format_var fmt v
| EFunc f -> format_toplevel_name fmt f
| EFunc f -> format_func_name fmt f
| EStruct (es, s) ->
Format.fprintf fmt "%a(%a)" format_struct_name s
(Format.pp_print_list
@ -348,12 +351,12 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
Format.fprintf fmt "%a(%a)" format_op (op, Pos.no_pos)
(format_expression ctx) arg1
| EApp ((EFunc x, pos), args)
when Ast.TopLevelName.compare x Ast.handle_default = 0
|| Ast.TopLevelName.compare x Ast.handle_default_opt = 0 ->
when Ast.FuncName.compare x Ast.handle_default = 0
|| Ast.FuncName.compare x Ast.handle_default_opt = 0 ->
Format.fprintf fmt
"%a(@[<hov 0>SourcePosition(filename=\"%s\",@ start_line=%d,@ \
start_column=%d,@ end_line=%d, end_column=%d,@ law_headings=%a), %a)@]"
format_toplevel_name x (Pos.get_file pos) (Pos.get_start_line pos)
format_func_name x (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)
(Format.pp_print_list
@ -400,7 +403,7 @@ let rec format_statement
| SSwitch (e1, e_name, [(case_none, _); (case_some, case_some_var)])
when EnumName.compare e_name L.option_enum = 0 ->
(* We translate the option type with an overloading by Python's [None] *)
let tmp_var = LocalName.fresh ("perhaps_none_arg", Pos.no_pos) in
let tmp_var = VarName.fresh ("perhaps_none_arg", Pos.no_pos) in
Format.fprintf fmt
"%a = %a@\n\
@[<hov 4>if %a is None:@\n\
@ -418,7 +421,7 @@ let rec format_statement
cases
(EnumConstructor.Map.bindings (EnumName.Map.find e_name ctx.ctx_enums))
in
let tmp_var = LocalName.fresh ("match_arg", Pos.no_pos) in
let tmp_var = VarName.fresh ("match_arg", Pos.no_pos) in
Format.fprintf fmt "%a = %a@\n@[<hov 4>if %a@]" format_var tmp_var
(format_expression ctx) e1
(Format.pp_print_list
@ -583,7 +586,7 @@ let format_program
(* We disable the style flag in order to enjoy formatting from the
pretty-printers of Dcalc and Lcalc but without the color terminal
markers. *)
Cli.call_unstyled (fun _ ->
Cli.call_unstyled (fun () ->
Format.fprintf fmt
"# This file has been generated by the Catala compiler, do not edit!\n\
@\n\
@ -591,20 +594,25 @@ let format_program
from typing import Any, List, Callable, Tuple\n\
from enum import Enum\n\
@\n\
%a@\n\
@[<v>%a@]@\n\
@\n\
%a@?"
(format_ctx type_ordering) p.decl_ctx
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n@\n")
(fun fmt body ->
let { Ast.func_params; Ast.func_body } = body.scope_body_func in
Format.fprintf fmt "@[<hov 4>def %a(%a):@\n%a@]"
format_toplevel_name body.scope_body_var
(Format.pp_print_list ~pp_sep:Format.pp_print_newline (fun fmt ->
function
| SVar { var; expr } ->
Format.fprintf fmt "@[<hv 4>%a = (@,%a@,@])@," format_var_name var
(format_expression p.decl_ctx)
expr
| SFunc { var; func }
| SScope { scope_body_var = var; scope_body_func = func; _ } ->
let { Ast.func_params; Ast.func_body } = func in
Format.fprintf fmt "@[<hv 4>def %a(%a):@\n%a@]@," format_func_name
var
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
(fun fmt (var, typ) ->
Format.fprintf fmt "%a:%a" format_var (Marked.unmark var)
format_typ typ))
func_params (format_block p.decl_ctx) func_body))
p.scopes)
p.code_items)

16
compiler/scopelang/ast.ml
View File

@ -53,6 +53,7 @@ type 'm scope_decl = {
type 'm program = {
program_scopes : 'm scope_decl ScopeName.Map.t;
program_topdefs : ('m expr * typ) TopdefName.Map.t;
program_ctx : decl_ctx;
}
@ -69,12 +70,23 @@ let type_rule decl_ctx env = function
Call (sc_name, ssc_name, Typed { pos; ty = Marked.mark pos TAny })
let type_program (prg : 'm program) : typed program =
let typing_env =
TopdefName.Map.fold
(fun name (_, ty) -> Typing.Env.add_toplevel_var name ty)
prg.program_topdefs Typing.Env.empty
in
let program_topdefs =
TopdefName.Map.map
(fun (expr, typ) ->
Expr.unbox (Typing.expr prg.program_ctx ~env:typing_env ~typ expr), typ)
prg.program_topdefs
in
let typing_env =
ScopeName.Map.fold
(fun scope_name scope_decl ->
let vars = ScopeVar.Map.map fst scope_decl.scope_sig in
Typing.Env.add_scope scope_name ~vars)
prg.program_scopes Typing.Env.empty
prg.program_scopes typing_env
in
let program_scopes =
ScopeName.Map.map
@ -98,4 +110,4 @@ let type_program (prg : 'm program) : typed program =
{ scope_decl with scope_decl_rules; scope_mark })
prg.program_scopes
in
{ prg with program_scopes }
{ prg with program_topdefs; program_scopes }

1
compiler/scopelang/ast.mli
View File

@ -45,6 +45,7 @@ type 'm scope_decl = {
type 'm program = {
program_scopes : 'm scope_decl ScopeName.Map.t;
program_topdefs : ('m expr * typ) TopdefName.Map.t;
program_ctx : decl_ctx;
}

106
compiler/scopelang/dependency.ml
View File

@ -19,7 +19,46 @@
open Catala_utils
open Shared_ast
module SVertex = ScopeName
type vertex = Scope of ScopeName.t | Topdef of TopdefName.t
module SVertex = struct
type t = vertex
(* While we enforce that globals don't depend on scopes, and could therefore
compute two separate dependency graphs and traverse them one after the
other, code-wise it's simpler to have a single graph including both *)
let compare v1 v2 =
match v1, v2 with
| Scope s1, Scope s2 -> ScopeName.compare s1 s2
| Topdef g1, Topdef g2 -> TopdefName.compare g1 g2
| Scope _, _ -> -1
| _, Scope _ -> 1
| Topdef _, _ | _, Topdef _ -> .
let equal v1 v2 =
match v1, v2 with
| Scope s1, Scope s2 -> ScopeName.equal s1 s2
| Topdef g1, Topdef g2 -> TopdefName.equal g1 g2
| (Scope _ | Topdef _), _ -> false
let hash = function
| Scope s -> ScopeName.hash s
| Topdef g -> TopdefName.hash g
let to_string v =
Format.asprintf "%a"
(fun ppf -> function
| Scope s -> ScopeName.format_t ppf s
| Topdef g -> TopdefName.format_t ppf g)
v
let info = function
| Scope s -> ScopeName.get_info s
| Topdef g -> TopdefName.get_info g
end
module VMap = Map.Make (SVertex)
(** On the edges, the label is the expression responsible for the use of the
function *)
@ -38,56 +77,81 @@ module STopologicalTraversal = Graph.Topological.Make (SDependencies)
module SSCC = Graph.Components.Make (SDependencies)
(** Tarjan's stongly connected components algorithm, provided by OCamlGraph *)
let rec expr_used_scopes e =
let rec expr_used_defs e =
let recurse_subterms e =
Expr.shallow_fold
(fun e -> ScopeName.Map.union (fun _ x _ -> Some x) (expr_used_scopes e))
e ScopeName.Map.empty
(fun e -> VMap.union (fun _ x _ -> Some x) (expr_used_defs e))
e VMap.empty
in
match e with
| ELocation (ToplevelVar (v, pos)), _ -> VMap.singleton (Topdef v) pos
| (EScopeCall { scope; _ }, m) as e ->
ScopeName.Map.add scope (Expr.mark_pos m) (recurse_subterms e)
VMap.add (Scope scope) (Expr.mark_pos m) (recurse_subterms e)
| EAbs { binder; _ }, _ ->
let _, body = Bindlib.unmbind binder in
expr_used_scopes body
expr_used_defs body
| e -> recurse_subterms e
let rule_used_scopes = function
let rule_used_defs = function
| Ast.Assertion e | Ast.Definition (_, _, _, e) ->
(* TODO: maybe this info could be passed on from previous passes without
walking through all exprs again *)
expr_used_scopes e
expr_used_defs e
| Ast.Call (subscope, subindex, _) ->
ScopeName.Map.singleton subscope
VMap.singleton (Scope subscope)
(Marked.get_mark (SubScopeName.get_info subindex))
let build_program_dep_graph (prgm : 'm Ast.program) : SDependencies.t =
let g = SDependencies.empty in
let g =
TopdefName.Map.fold
(fun v _ g -> SDependencies.add_vertex g (Topdef v))
prgm.program_topdefs g
in
let g =
ScopeName.Map.fold
(fun v _ g -> SDependencies.add_vertex g v)
(fun v _ g -> SDependencies.add_vertex g (Scope v))
prgm.program_scopes g
in
let g =
TopdefName.Map.fold
(fun glo_name (expr, _) g ->
let used_defs = expr_used_defs expr in
if VMap.mem (Topdef glo_name) used_defs then
Errors.raise_spanned_error
(Marked.get_mark (TopdefName.get_info glo_name))
"The Topdef %a has a definition that refers to itself, which is \
forbidden since Catala does not provide recursion"
TopdefName.format_t glo_name;
VMap.fold
(fun def pos g ->
let edge = SDependencies.E.create def pos (Topdef glo_name) in
SDependencies.add_edge_e g edge)
used_defs g)
prgm.program_topdefs g
in
ScopeName.Map.fold
(fun scope_name scope g ->
List.fold_left
(fun g rule ->
let used_scopes = rule_used_scopes rule in
if ScopeName.Map.mem scope_name used_scopes then
let used_defs = rule_used_defs rule in
if VMap.mem (Scope scope_name) used_defs then
Errors.raise_spanned_error
(Marked.get_mark (ScopeName.get_info scope.Ast.scope_decl_name))
"The scope %a is calling into itself as a subscope, which is \
forbidden since Catala does not provide recursion"
ScopeName.format_t scope.Ast.scope_decl_name;
ScopeName.Map.fold
(fun used_scope pos g ->
let edge = SDependencies.E.create used_scope pos scope_name in
VMap.fold
(fun used_def pos g ->
let edge =
SDependencies.E.create used_def pos (Scope scope_name)
in
SDependencies.add_edge_e g edge)
used_scopes g)
used_defs g)
g scope.Ast.scope_decl_rules)
prgm.program_scopes g
let check_for_cycle_in_scope (g : SDependencies.t) : unit =
let check_for_cycle_in_defs (g : SDependencies.t) : unit =
(* if there is a cycle, there will be an strongly connected component of
cardinality > 1 *)
let sccs = SSCC.scc_list g in
@ -97,14 +161,12 @@ let check_for_cycle_in_scope (g : SDependencies.t) : unit =
List.flatten
(List.map
(fun v ->
let var_str, var_info =
Format.asprintf "%a" ScopeName.format_t v, ScopeName.get_info v
in
let var_str, var_info = SVertex.to_string v, SVertex.info v in
let succs = SDependencies.succ_e g v in
let _, edge_pos, succ =
List.find (fun (_, _, succ) -> List.mem succ scc) succs
in
let succ_str = Format.asprintf "%a" ScopeName.format_t succ in
let succ_str = SVertex.to_string succ in
[
( Some ("Cycle variable " ^ var_str ^ ", declared:"),
Marked.get_mark var_info );
@ -119,7 +181,7 @@ let check_for_cycle_in_scope (g : SDependencies.t) : unit =
Errors.raise_multispanned_error spans
"Cyclic dependency detected between scopes!"
let get_scope_ordering (g : SDependencies.t) : ScopeName.t list =
let get_defs_ordering (g : SDependencies.t) : SVertex.t list =
List.rev (STopologicalTraversal.fold (fun sd acc -> sd :: acc) g [])
module TVertex = struct

8
compiler/scopelang/dependency.mli
View File

@ -22,14 +22,16 @@ open Shared_ast
(** {1 Scope dependencies} *)
type vertex = Scope of ScopeName.t | Topdef of TopdefName.t
(** On the edges, the label is the expression responsible for the use of the
function *)
module SDependencies :
Graph.Sig.P with type V.t = ScopeName.t and type E.label = Pos.t
Graph.Sig.P with type V.t = vertex and type E.label = Pos.t
val build_program_dep_graph : 'm Ast.program -> SDependencies.t
val check_for_cycle_in_scope : SDependencies.t -> unit
val get_scope_ordering : SDependencies.t -> ScopeName.t list
val check_for_cycle_in_defs : SDependencies.t -> unit
val get_defs_ordering : SDependencies.t -> vertex list
(** {1 Type dependencies} *)

8
compiler/scopelang/from_desugared.ml
View File

@ -71,6 +71,7 @@ let rec translate_expr (ctx : ctx) (e : Desugared.Ast.expr) :
| WholeVar _ -> failwith "should not happen"
| States states -> Marked.same_mark_as (List.assoc state states) s_var))
m
| ELocation (ToplevelVar v) -> Expr.elocation (ToplevelVar v) m
| EVar v -> Expr.evar (Var.Map.find v ctx.var_mapping) m
| EStruct { name; fields } ->
Expr.estruct name (StructField.Map.map (translate_expr ctx) fields) m
@ -93,6 +94,9 @@ let rec translate_expr (ctx : ctx) (e : Desugared.Ast.expr) :
name
in
Expr.estructaccess e' field name m
| ETuple es -> Expr.etuple (List.map (translate_expr ctx) es) m
| ETupleAccess { e; index; size } ->
Expr.etupleaccess (translate_expr ctx e) index size m
| EInj { e; cons; name } -> Expr.einj (translate_expr ctx e) cons name m
| EMatch { e; name; cases } ->
Expr.ematch (translate_expr ctx e) name
@ -724,6 +728,10 @@ let translate_program (pgrm : Desugared.Ast.program) : untyped Ast.program =
pgrm.Desugared.Ast.program_ctx.ctx_scopes
in
{
Ast.program_topdefs =
TopdefName.Map.map
(fun (e, ty) -> Expr.unbox (translate_expr ctx e), ty)
pgrm.program_topdefs;
Ast.program_scopes =
ScopeName.Map.map (translate_scope ctx) pgrm.program_scopes;
program_ctx = { pgrm.program_ctx with ctx_scopes };

25
compiler/scopelang/print.ml
View File

@ -77,7 +77,7 @@ let scope ?(debug = false) ctx fmt (name, decl) =
(Print.typ ctx) typ Print.punctuation "="
(fun fmt e ->
match Marked.unmark loc with
| SubScopeVar _ -> Print.expr ctx fmt e
| SubScopeVar _ | ToplevelVar _ -> Print.expr ctx fmt e
| ScopelangScopeVar v -> (
match
Marked.unmark
@ -98,6 +98,24 @@ let scope ?(debug = false) ctx fmt (name, decl) =
SubScopeName.format_t subscope_name Print.punctuation "]"))
decl.scope_decl_rules
let print_topdef ctx ppf name (e, ty) =
Format.pp_open_vbox ppf 2;
let () =
Format.pp_open_hovbox ppf 2;
Print.keyword ppf "let";
Format.pp_print_space ppf ();
TopdefName.format_t ppf name;
Print.punctuation ppf ":";
Format.pp_print_space ppf ();
Print.typ ctx ppf ty;
Format.pp_print_space ppf ();
Print.punctuation ppf "=";
Format.pp_close_box ppf ()
in
Format.pp_print_cut ppf ();
Print.expr ctx ppf e;
Format.pp_close_box ppf ()
let program ?(debug : bool = false) (fmt : Format.formatter) (p : 'm program) :
unit =
let ctx = p.program_ctx in
@ -116,6 +134,11 @@ let program ?(debug : bool = false) (fmt : Format.formatter) (p : 'm program) :
enum ctx fmt n e;
pp_sep fmt ())
ctx.ctx_enums;
TopdefName.Map.iter
(fun name def ->
print_topdef ctx fmt name def;
pp_sep fmt ())
p.program_topdefs;
Format.pp_print_list ~pp_sep (scope ~debug ctx) fmt
(ScopeName.Map.bindings p.program_scopes);
Format.pp_close_box fmt ()

39
compiler/shared_ast/definitions.ml
View File

@ -23,6 +23,7 @@
open Catala_utils
module Runtime = Runtime_ocaml.Runtime
module ScopeName = Uid.Gen ()
module TopdefName = Uid.Gen ()
module StructName = Uid.Gen ()
module StructField = Uid.Gen ()
module EnumName = Uid.Gen ()
@ -245,6 +246,9 @@ type 'a glocation =
| SubScopeVar :
ScopeName.t * SubScopeName.t Marked.pos * ScopeVar.t Marked.pos
-> [< desugared | scopelang ] glocation
| ToplevelVar :
TopdefName.t Marked.pos
-> [< desugared | scopelang ] glocation
type ('a, 't) gexpr = (('a, 't) naked_gexpr, 't) Marked.t
(** General expressions: groups all expression cases of the different ASTs, and
@ -301,6 +305,13 @@ and ('a, 't) naked_gexpr =
cases : ('a, 't) gexpr EnumConstructor.Map.t;
}
-> ('a any, 't) naked_gexpr
| ETuple : ('a, 't) gexpr list -> ('a any, 't) naked_gexpr
| ETupleAccess : {
e : ('a, 't) gexpr;
index : int;
size : int;
}
-> ('a any, 't) naked_gexpr
(* Early stages *)
| ELocation :
'a glocation
@ -337,13 +348,6 @@ and ('a, 't) naked_gexpr =
('a, 't) gexpr
-> (([< desugared | scopelang | dcalc ] as 'a), 't) naked_gexpr
(* Lambda calculus with exceptions *)
| ETuple : ('a, 't) gexpr list -> ((lcalc as 'a), 't) naked_gexpr
| ETupleAccess : {
e : ('a, 't) gexpr;
index : int;
size : int;
}
-> ((lcalc as 'a), 't) naked_gexpr
| ERaise : except -> ((lcalc as 'a), 't) naked_gexpr
| ECatch : {
body : ('a, 't) gexpr;
@ -409,6 +413,7 @@ type 'e scope_let = {
scope_let_typ : typ;
scope_let_expr : 'e;
scope_let_next : ('e, 'e scope_body_expr) binder;
(* todo ? Factorise the code_item _list type below and use it here *)
scope_let_pos : Pos.t;
}
constraint 'e = (_ any, _ mark) gexpr
@ -434,19 +439,15 @@ type 'e scope_body = {
a result expression that uses the let-binded variables. The first binder is
the argument of type [scope_body_input_struct]. *)
type 'e scope_def = {
scope_name : ScopeName.t;
scope_body : 'e scope_body;
scope_next : ('e, 'e scopes) binder;
}
constraint 'e = (_ any, _ mark) gexpr
type 'e code_item =
| ScopeDef of ScopeName.t * 'e scope_body
| Topdef of TopdefName.t * typ * 'e
(** Finally, we do the same transformation for the whole program for the kinded
lets. This permit us to use bindlib variables for scopes names. *)
and 'e scopes =
(* A chained list, but with a binder for each element into the next: [x := let a
= e1 in e2] is thus [Cons (e1, {a. Cons (e2, {x. Nil})})] *)
type 'e code_item_list =
| Nil
| ScopeDef of 'e scope_def
constraint 'e = (_ any, _ mark) gexpr
| Cons of 'e code_item * ('e, 'e code_item_list) binder
type struct_ctx = typ StructField.Map.t StructName.Map.t
type enum_ctx = typ EnumConstructor.Map.t EnumName.Map.t
@ -464,4 +465,4 @@ type decl_ctx = {
ctx_scopes : scope_out_struct ScopeName.Map.t;
}
type 'e program = { decl_ctx : decl_ctx; scopes : 'e scopes }
type 'e program = { decl_ctx : decl_ctx; code_items : 'e code_item_list }

7
compiler/shared_ast/expr.ml
View File

@ -469,12 +469,15 @@ let compare_location
SubScopeVar (_, (ysubindex, _), (ysubvar, _)) ) ->
let c = SubScopeName.compare xsubindex ysubindex in
if c = 0 then ScopeVar.compare xsubvar ysubvar else c
| ToplevelVar (vx, _), ToplevelVar (vy, _) -> TopdefName.compare vx vy
| DesugaredScopeVar _, _ -> -1
| _, DesugaredScopeVar _ -> 1
| ScopelangScopeVar _, _ -> -1
| _, ScopelangScopeVar _ -> 1
| SubScopeVar _, _ -> .
| _, SubScopeVar _ -> .
| SubScopeVar _, _ -> -1
| _, SubScopeVar _ -> 1
| ToplevelVar _, _ -> .
| _, ToplevelVar _ -> .
let equal_location a b = compare_location a b = 0
let equal_except ex1 ex2 = ex1 = ex2

6
compiler/shared_ast/expr.mli
View File

@ -43,10 +43,10 @@ val subst :
('a, 't) gexpr list ->
('a, 't) gexpr
val etuple : (lcalc, 't) boxed_gexpr list -> 't -> (lcalc, 't) boxed_gexpr
val etuple : ('a any, 't) boxed_gexpr list -> 't -> ('a, 't) boxed_gexpr
val etupleaccess :
(lcalc, 't) boxed_gexpr -> int -> int -> 't -> (lcalc, 't) boxed_gexpr
('a any, 't) boxed_gexpr -> int -> int -> 't -> ('a, 't) boxed_gexpr
val earray : ('a any, 't) boxed_gexpr list -> 't -> ('a, 't) boxed_gexpr
val elit : 'a any glit -> 't -> ('a, 't) boxed_gexpr
@ -304,7 +304,7 @@ val make_default :
- [<ex | false :- _>], when [ex] is a single exception, is rewritten as [ex] *)
val make_tuple :
(lcalc, 'm mark) boxed_gexpr list -> 'm mark -> (lcalc, 'm mark) boxed_gexpr
('a any, 'm mark) boxed_gexpr list -> 'm mark -> ('a, 'm mark) boxed_gexpr
(** Builds a tuple; the mark argument is only used as witness and for position
when building 0-uples *)

1
compiler/shared_ast/print.ml
View File

@ -66,6 +66,7 @@ let location (type a) (fmt : Format.formatter) (l : a glocation) : unit =
| SubScopeVar (_, subindex, subvar) ->
Format.fprintf fmt "%a.%a" SubScopeName.format_t (Marked.unmark subindex)
ScopeVar.format_t (Marked.unmark subvar)
| ToplevelVar v -> TopdefName.format_t fmt (Marked.unmark v)
let enum_constructor (fmt : Format.formatter) (c : EnumConstructor.t) : unit =
Cli.format_with_style [ANSITerminal.magenta] fmt

30
compiler/shared_ast/program.ml
View File

@ -17,19 +17,19 @@
open Definitions
let map_exprs ~f ~varf { scopes; decl_ctx } =
let map_exprs ~f ~varf { code_items; decl_ctx } =
Bindlib.box_apply
(fun scopes -> { scopes; decl_ctx })
(Scope.map_exprs ~f ~varf scopes)
(fun code_items -> { code_items; decl_ctx })
(Scope.map_exprs ~f ~varf code_items)
let get_scope_body { scopes; _ } scope =
let get_scope_body { code_items; _ } scope =
match
Scope.fold_left ~init:None
~f:(fun acc scope_def _ ->
if ScopeName.equal scope_def.scope_name scope then
Some scope_def.scope_body
else acc)
scopes
~f:(fun acc item _ ->
match item with
| ScopeDef (name, body) when ScopeName.equal scope name -> Some body
| _ -> acc)
code_items
with
| None -> raise Not_found
| Some body -> body
@ -40,14 +40,14 @@ let untype : 'm. ('a, 'm mark) gexpr program -> ('a, untyped mark) gexpr program
let rec find_scope name vars = function
| Nil -> raise Not_found
| ScopeDef { scope_name; scope_body; _ } when scope_name = name ->
List.rev vars, scope_body
| ScopeDef { scope_next; _ } ->
let var, next = Bindlib.unbind scope_next in
| Cons (ScopeDef (n, body), _) when ScopeName.equal name n ->
List.rev vars, body
| Cons (_, next_bind) ->
let var, next = Bindlib.unbind next_bind in
find_scope name (var :: vars) next
let to_expr p main_scope =
let _, main_scope_body = find_scope main_scope [] p.scopes in
Scope.unfold p.decl_ctx p.scopes
let _, main_scope_body = find_scope main_scope [] p.code_items in
Scope.unfold p.decl_ctx p.code_items
(Scope.get_body_mark main_scope_body)
(ScopeName main_scope)

146
compiler/shared_ast/scope.ml
View File

@ -50,53 +50,72 @@ let map_exprs_in_lets :
Bindlib.box_apply (fun res -> Result res) (Expr.Box.lift (f res)))
scope_body_expr
let rec fold_left ~f ~init scopes =
match scopes with
let rec fold_left ~f ~init = function
| Nil -> init
| ScopeDef scope_def ->
let var, next = Bindlib.unbind scope_def.scope_next in
fold_left ~f ~init:(f init scope_def var) next
| Cons (item, next_bind) ->
let var, next = Bindlib.unbind next_bind in
fold_left ~f ~init:(f init item var) next
let rec fold_right ~f ~init scopes =
match scopes with
let rec fold_right ~f ~init = function
| Nil -> init
| ScopeDef scope_def ->
let var_next, next = Bindlib.unbind scope_def.scope_next in
| Cons (item, next_bind) ->
let var_next, next = Bindlib.unbind next_bind in
let result_next = fold_right ~f ~init next in
f scope_def var_next result_next
f item var_next result_next
let map ~f scopes =
fold_right
~f:(fun scope_def var_next acc ->
let new_def = f scope_def in
let new_next = Bindlib.bind_var var_next acc in
let rec map ~f ~varf = function
| Nil -> Bindlib.box Nil
| Cons (item, next_bind) ->
let item = f item in
let next_bind =
let var, next = Bindlib.unbind next_bind in
Bindlib.bind_var (varf var) (map ~f ~varf next)
in
Bindlib.box_apply2
(fun item next_bind -> Cons (item, next_bind))
item next_bind
let rec map_ctx ~f ~varf ctx = function
| Nil -> Bindlib.box Nil
| Cons (item, next_bind) ->
let ctx, item = f ctx item in
let next_bind =
let var, next = Bindlib.unbind next_bind in
Bindlib.bind_var (varf var) (map_ctx ~f ~varf ctx next)
in
Bindlib.box_apply2
(fun item next_bind -> Cons (item, next_bind))
item next_bind
let rec fold_map ~f ~varf ctx = function
| Nil -> ctx, Bindlib.box Nil
| Cons (item, next_bind) ->
let var, next = Bindlib.unbind next_bind in
let ctx, item = f ctx var item in
let ctx, next = fold_map ~f ~varf ctx next in
let next_bind = Bindlib.bind_var (varf var) next in
( ctx,
Bindlib.box_apply2
(fun new_def new_next ->
ScopeDef { new_def with scope_next = new_next })
new_def new_next)
~init:(Bindlib.box Nil) scopes
(fun item next_bind -> Cons (item, next_bind))
item next_bind )
let map_exprs ~f ~varf scopes =
fold_right
~f:(fun scope_def var_next acc ->
let scope_input_var, scope_lets =
Bindlib.unbind scope_def.scope_body.scope_body_expr
in
let f = function
| ScopeDef (name, body) ->
let scope_input_var, scope_lets = Bindlib.unbind body.scope_body_expr in
let new_body_expr = map_exprs_in_lets ~f ~varf scope_lets in
let new_body_expr =
Bindlib.bind_var (varf scope_input_var) new_body_expr
in
let new_next = Bindlib.bind_var (varf var_next) acc in
Bindlib.box_apply2
(fun scope_body_expr scope_next ->
ScopeDef
{
scope_def with
scope_body = { scope_def.scope_body with scope_body_expr };
scope_next;
})
new_body_expr new_next)
~init:(Bindlib.box Nil) scopes
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 (f expr))
in
map ~f ~varf scopes
(* TODO: compute the expected body expr arrow type manually instead of [TAny]
for double-checking types ? *)
@ -164,7 +183,7 @@ let format
let rec unfold
(ctx : decl_ctx)
(s : 'e scopes)
(s : 'e code_item_list)
(mark : 'm mark)
(main_scope : 'expr scope_name_or_var) : 'e boxed =
match s with
@ -172,23 +191,31 @@ let rec unfold
match main_scope with
| ScopeVar v -> Expr.make_var v mark
| ScopeName _ -> failwith "should not happen")
| ScopeDef { scope_name; scope_body; scope_next } ->
let scope_var, scope_next = Bindlib.unbind scope_next in
let scope_pos = Marked.get_mark (ScopeName.get_info scope_name) in
let scope_body_mark = get_body_mark scope_body in
let main_scope =
match main_scope with
| ScopeVar v -> ScopeVar v
| ScopeName n ->
if ScopeName.compare n scope_name = 0 then ScopeVar scope_var
else ScopeName n
| Cons (item, next_bind) ->
let var, next = Bindlib.unbind next_bind in
let typ, expr, pos, is_main =
match item with
| ScopeDef (name, body) ->
let pos = Marked.get_mark (ScopeName.get_info name) in
let body_mark = get_body_mark body in
let is_main =
match main_scope with
| ScopeName n -> ScopeName.equal n name
| ScopeVar _ -> false
in
let typ =
build_typ_from_sig ctx body.scope_body_input_struct
body.scope_body_output_struct pos
in
let expr = to_expr ctx body body_mark in
typ, expr, pos, is_main
| Topdef (name, typ, expr) ->
let pos = Marked.get_mark (TopdefName.get_info name) in
typ, Expr.rebox expr, pos, false
in
Expr.make_let_in scope_var
(build_typ_from_sig ctx scope_body.scope_body_input_struct
scope_body.scope_body_output_struct scope_pos)
(to_expr ctx scope_body scope_body_mark)
(unfold ctx scope_next mark main_scope)
scope_pos
let main_scope = if is_main then ScopeVar var else main_scope in
let next = unfold ctx next mark main_scope in
Expr.make_let_in var typ expr next pos
let rec free_vars_body_expr scope_lets =
match scope_lets with
@ -198,14 +225,15 @@ let rec free_vars_body_expr scope_lets =
Var.Set.union (Expr.free_vars e)
(Var.Set.remove v (free_vars_body_expr body))
let free_vars_body scope_body =
let { scope_body_expr = binder; _ } = scope_body in
let v, body = Bindlib.unbind binder in
Var.Set.remove v (free_vars_body_expr body)
let free_vars_item = function
| ScopeDef (_, { scope_body_expr; _ }) ->
let v, body = Bindlib.unbind scope_body_expr in
Var.Set.remove v (free_vars_body_expr body)
| Topdef (_, _, expr) -> Expr.free_vars expr
let rec free_vars scopes =
match scopes with
| Nil -> Var.Set.empty
| ScopeDef { scope_body = body; scope_next = next; _ } ->
let v, next = Bindlib.unbind next in
Var.Set.union (Var.Set.remove v (free_vars next)) (free_vars_body body)
| Cons (item, next_bind) ->
let v, next = Bindlib.unbind next_bind in
Var.Set.union (Var.Set.remove v (free_vars next)) (free_vars_item item)

50
compiler/shared_ast/scope.mli
View File

@ -15,7 +15,8 @@
License for the specific language governing permissions and limitations under
the License. *)
(** Functions handling the scope structures of [shared_ast] *)
(** Functions handling the code item structures of [shared_ast], in particular
the scopes *)
open Catala_utils
open Definitions
@ -49,18 +50,18 @@ val map_exprs_in_lets :
'expr2 scope_body_expr Bindlib.box
val fold_left :
f:('a -> 'expr1 scope_def -> 'expr1 Var.t -> 'a) ->
f:('a -> 'expr1 code_item -> 'expr1 Var.t -> 'a) ->
init:'a ->
'expr1 scopes ->
'expr1 code_item_list ->
'a
(** Usage: [fold_left ~f:(fun acc scope_def scope_var -> ...) ~init scope_def],
where [scope_var] is the variable bound to the scope in the next scopes to
be examined. *)
(** Usage: [fold_left ~f:(fun acc code_def code_var -> ...) ~init code_def],
where [code_var] is the variable bound to the code item in the next code
items to be examined. *)
val fold_right :
f:('expr1 scope_def -> 'expr1 Var.t -> 'a -> 'a) ->
f:('expr1 code_item -> 'expr1 Var.t -> 'a -> 'a) ->
init:'a ->
'expr1 scopes ->
'expr1 code_item_list ->
'a
(** Usage:
[fold_right_scope ~f:(fun scope_def scope_var acc -> ...) ~init scope_def],
@ -68,15 +69,32 @@ val fold_right :
be examined (which are before in the program order). *)
val map :
f:('e scope_def -> 'e scope_def Bindlib.box) ->
'e scopes ->
'e scopes Bindlib.box
f:('e1 code_item -> 'e2 code_item Bindlib.box) ->
varf:('e1 Var.t -> 'e2 Var.t) ->
'e1 code_item_list ->
'e2 code_item_list Bindlib.box
val map_ctx :
f:('ctx -> 'e1 code_item -> 'ctx * 'e2 code_item Bindlib.box) ->
varf:('e1 Var.t -> 'e2 Var.t) ->
'ctx ->
'e1 code_item_list ->
'e2 code_item_list Bindlib.box
(** Similar to [map], but a context is passed left-to-right through the given
function *)
val fold_map :
f:('ctx -> 'e1 Var.t -> 'e1 code_item -> 'ctx * 'e2 code_item Bindlib.box) ->
varf:('e1 Var.t -> 'e2 Var.t) ->
'ctx ->
'e1 code_item_list ->
'ctx * 'e2 code_item_list Bindlib.box
val map_exprs :
f:('expr1 -> 'expr2 boxed) ->
varf:('expr1 Var.t -> 'expr2 Var.t) ->
'expr1 scopes ->
'expr2 scopes Bindlib.box
'expr1 code_item_list ->
'expr2 code_item_list Bindlib.box
(** This is the main map visitor for all the expressions inside all the scopes
of the program. *)
@ -103,7 +121,7 @@ type 'e scope_name_or_var = ScopeName of ScopeName.t | ScopeVar of 'e Var.t
val unfold :
decl_ctx ->
((_, 'm mark) gexpr as 'e) scopes ->
((_, 'm mark) gexpr as 'e) code_item_list ->
'm mark ->
'e scope_name_or_var ->
'e boxed
@ -116,5 +134,5 @@ val build_typ_from_sig :
(** {2 Analysis and tests} *)
val free_vars_body_expr : 'e scope_body_expr -> 'e Var.Set.t
val free_vars_body : 'e scope_body -> 'e Var.Set.t
val free_vars : 'e scopes -> 'e Var.Set.t
val free_vars_item : 'e code_item -> 'e Var.Set.t
val free_vars : 'e code_item_list -> 'e Var.Set.t

52
compiler/shared_ast/typing.ml
View File

@ -276,6 +276,7 @@ module Env = struct
vars : ('e, unionfind_typ) Var.Map.t;
scope_vars : A.typ A.ScopeVar.Map.t;
scopes : A.typ A.ScopeVar.Map.t A.ScopeName.Map.t;
toplevel_vars : A.typ A.TopdefName.Map.t;
}
let empty =
@ -283,10 +284,12 @@ module Env = struct
vars = Var.Map.empty;
scope_vars = A.ScopeVar.Map.empty;
scopes = A.ScopeName.Map.empty;
toplevel_vars = A.TopdefName.Map.empty;
}
let get t v = Var.Map.find_opt v t.vars
let get_scope_var t sv = A.ScopeVar.Map.find_opt sv t.scope_vars
let get_toplevel_var t v = A.TopdefName.Map.find_opt v t.toplevel_vars
let get_subscope_out_var t scope var =
Option.bind (A.ScopeName.Map.find_opt scope t.scopes) (fun vmap ->
@ -301,6 +304,9 @@ module Env = struct
let add_scope scope_name ~vars t =
{ t with scopes = A.ScopeName.Map.add scope_name vars t.scopes }
let add_toplevel_var v typ t =
{ t with toplevel_vars = A.TopdefName.Map.add v typ t.toplevel_vars }
let open_scope scope_name t =
let scope_vars =
A.ScopeVar.Map.union
@ -361,6 +367,7 @@ and typecheck_expr_top_down :
Env.get_scope_var env (Marked.unmark v)
| SubScopeVar (scope, _, v) ->
Env.get_subscope_out_var env scope (Marked.unmark v)
| ToplevelVar v -> Env.get_toplevel_var env (Marked.unmark v)
in
let ty =
match ty_opt with
@ -777,7 +784,9 @@ let scope_body ctx env body =
let var, e = Bindlib.unbind body.A.scope_body_expr in
let env = Env.add var ty_in env in
let e' = scope_body_expr ctx env ty_out e in
( Bindlib.bind_var (Var.translate var) e',
( Bindlib.box_apply
(fun scope_body_expr -> { body with scope_body_expr })
(Bindlib.bind_var (Var.translate var) e'),
UnionFind.make
(Marked.mark
(get_pos body.A.scope_body_output_struct)
@ -785,24 +794,29 @@ let scope_body ctx env body =
let rec scopes ctx env = function
| A.Nil -> Bindlib.box A.Nil
| A.ScopeDef def ->
let body_e, ty_scope = scope_body ctx env def.scope_body in
let scope_next =
let scope_var, next = Bindlib.unbind def.scope_next in
let env = Env.add scope_var ty_scope env in
let next' = scopes ctx env next in
Bindlib.bind_var (Var.translate scope_var) next'
| A.Cons (item, next_bind) ->
let var, next = Bindlib.unbind next_bind in
let env, def =
match item with
| A.ScopeDef (name, body) ->
let body_e, ty_scope = scope_body ctx env body in
( Env.add var ty_scope env,
Bindlib.box_apply (fun body -> A.ScopeDef (name, body)) body_e )
| A.Topdef (name, typ, e) ->
let e' = expr_raw ctx ~env ~typ e in
let uf = (Marked.get_mark e').uf in
let e' = Expr.map_marks ~f:get_ty_mark e' in
( Env.add var uf env,
Bindlib.box_apply
(fun e -> A.Topdef (name, typ, e))
(Expr.Box.lift e') )
in
Bindlib.box_apply2
(fun scope_body_expr scope_next ->
A.ScopeDef
{
def with
scope_body = { def.scope_body with scope_body_expr };
scope_next;
})
body_e scope_next
let next' = scopes ctx env next in
let next_bind' = Bindlib.bind_var (Var.translate var) next' in
Bindlib.box_apply2 (fun item next -> A.Cons (item, next)) def next_bind'
let program prg =
let scopes = Bindlib.unbox (scopes prg.A.decl_ctx Env.empty prg.A.scopes) in
{ prg with scopes }
let code_items =
Bindlib.unbox (scopes prg.A.decl_ctx Env.empty prg.A.code_items)
in
{ prg with code_items }

1
compiler/shared_ast/typing.mli
View File

@ -24,6 +24,7 @@ module Env : sig
val empty : 'e t
val add_var : 'e Var.t -> typ -> 'e t -> 'e t
val add_toplevel_var : TopdefName.t -> typ -> 'e t -> 'e t
val add_scope_var : ScopeVar.t -> typ -> 'e t -> 'e t
val add_scope : ScopeName.t -> vars:typ ScopeVar.Map.t -> 'e t -> 'e t
val open_scope : ScopeName.t -> 'e t -> 'e t

34
compiler/surface/ast.ml
View File

@ -433,7 +433,7 @@ and naked_expression =
| CollectionOp of collection_op * expression
| MemCollection of expression * expression
| TestMatchCase of expression * match_case_pattern Marked.pos
| FunCall of expression * expression
| FunCall of expression * expression list
| ScopeCall of
(path * uident Marked.pos) Marked.pos
* (lident Marked.pos * expression) list
@ -737,17 +737,46 @@ type scope_decl = {
name = "scope_decl_iter";
}]
type top_def = {
topdef_name : lident Marked.pos;
topdef_args : (lident Marked.pos * base_typ_data Marked.pos) list;
(** Empty list if this is not a function *)
topdef_type : base_typ_data Marked.pos;
(** Output type if this is a function *)
topdef_expr : expression;
}
[@@deriving
visitors
{
variety = "map";
ancestors = ["lident_map"; "typ_map"; "expression_map"];
name = "top_def_map";
},
visitors
{
variety = "iter";
ancestors = ["lident_iter"; "typ_iter"; "expression_iter"];
name = "top_def_iter";
}]
type code_item =
| ScopeUse of scope_use
| ScopeDecl of scope_decl
| StructDecl of struct_decl
| EnumDecl of enum_decl
| Topdef of top_def
[@@deriving
visitors
{
variety = "map";
ancestors =
["scope_decl_map"; "enum_decl_map"; "struct_decl_map"; "scope_use_map"];
[
"scope_decl_map";
"enum_decl_map";
"struct_decl_map";
"scope_use_map";
"top_def_map";
];
name = "code_item_map";
},
visitors
@ -759,6 +788,7 @@ type code_item =
"enum_decl_iter";
"struct_decl_iter";
"scope_use_iter";
"top_def_iter";
];
name = "code_item_iter";
}]

10
compiler/surface/lexer.cppo.ml
View File

@ -601,14 +601,16 @@ let rec lex_code (lexbuf : lexbuf) : token =
Buffer.add_string cents (String.make (2 - Buffer.length cents) '0');
L.update_acc lexbuf;
MONEY_AMOUNT (Buffer.contents units, Buffer.contents cents)
| Rep (digit, 4), '-', Rep (digit, 2), '-', Rep (digit, 2) ->
| '|', Rep (digit, 4), '-', Rep (digit, 2), '-', Rep (digit, 2), '|' ->
let rex =
Re.(compile @@ whole_string @@ seq [
char '|';
group (repn digit 4 None);
char '-';
group (repn digit 2 None);
char '-';
group (repn digit 2 None);
char '|';
])
in
let date_parts = R.get_substring (R.exec ~rex (Utf8.lexeme lexbuf)) in
@ -687,9 +689,6 @@ let rec lex_code (lexbuf : lexbuf) : token =
| ']' ->
L.update_acc lexbuf;
RBRACKET
| '|' ->
L.update_acc lexbuf;
BAR
| ':' ->
L.update_acc lexbuf;
COLON
@ -705,6 +704,9 @@ let rec lex_code (lexbuf : lexbuf) : token =
| '.' ->
L.update_acc lexbuf;
DOT
| ',' ->
L.update_acc lexbuf;
COMMA
| uppercase, Star (uppercase | lowercase | digit | '_' | '\'') ->
(* Name of constructor *)
L.update_acc lexbuf;

1
compiler/surface/lexer_common.ml
View File

@ -84,7 +84,6 @@ let token_list_language_agnostic : (string * token) list =
"-", MINUS KPoly;
"*", MULT KPoly;
"/", DIV KPoly;
"|", BAR;
":", COLON;
";", SEMICOLON;
"--", ALT;

3441
compiler/surface/parser.messages
View File

File diff suppressed because it is too large Load Diff

31
compiler/surface/parser.mly
View File

@ -38,6 +38,7 @@ end>
%left PLUS MINUS PLUSPLUS
%left MULT DIV
%right apply OF CONTAINS FOR SUCH WITH
%right COMMA
%right unop_expr
%right CONTENT
%nonassoc UIDENT
@ -181,9 +182,9 @@ let naked_expression ==
| e = struct_or_enum_inject ; <>
| e1 = expression ;
OF ;
e2 = expression ; {
FunCall (e1, e2)
} %prec apply
args = funcall_args ; {
FunCall (e1, args)
}
| OUTPUT ; OF ;
c = addpos(quident) ;
fields = option(scope_call_args) ; {
@ -303,7 +304,7 @@ let literal :=
money_amount_cents = cents;
}
}
| BAR ; d = DATE_LITERAL ; BAR ; {
| d = DATE_LITERAL ; {
let (y,m,d) = d in
LDate {
literal_date_year = y;
@ -322,6 +323,10 @@ let scope_call_args ==
fields
}
let funcall_args :=
| e = expression; { [e] } %prec apply
| e = expression; COMMA; el = funcall_args ; { e :: el }
let minmax ==
| MAXIMUM ; { true }
| MINIMUM ; { false }
@ -596,6 +601,13 @@ let enum_decl_line :=
}
}
let var_content ==
| ~ = lident ; CONTENT ; ty = addpos(typ) ; <>
let depends_stance ==
| DEPENDS ; args = separated_nonempty_list(COMMA,var_content) ; <>
| DEPENDS ; LPAREN ; args = separated_nonempty_list(COMMA,var_content) ; RPAREN ; <>
| { [] }
let code_item :=
| SCOPE ; c = uident ;
e = option(preceded(UNDER_CONDITION,expression)) ;
@ -627,6 +639,17 @@ let code_item :=
enum_decl_cases = cases;
}
}
| DECLARATION ; name = lident ;
CONTENT ; ty = addpos(typ) ;
args = depends_stance ;
DEFINED_AS ; e = expression ; {
Topdef {
topdef_name = name;
topdef_args = args;
topdef_type = ty;
topdef_expr = e;
}
}
let code :=
| code = list(addpos(code_item)) ; <>

4
compiler/surface/tokens.mly
View File

@ -37,11 +37,11 @@
%token<string * string> DECIMAL_LITERAL
%token<string * string> MONEY_AMOUNT
%token BEGIN_CODE TEXT
%token COLON ALT DATA BAR
%token COLON ALT DATA
%token OF INTEGER COLLECTION CONTAINS AMONG
%token RULE CONDITION DEFINED_AS
%token<Ast.op_kind> LESSER GREATER LESSER_EQUAL GREATER_EQUAL
%token LET EXISTS IN SUCH THAT
%token LET EXISTS IN SUCH THAT COMMA
%token DOT AND OR XOR LPAREN RPAREN EQUAL
%token CARDINAL ASSERTION FIXED BY YEAR MONTH DAY
%token<Ast.op_kind> PLUS MINUS MULT DIV

90
compiler/verification/conditions.ml
View File

@ -370,54 +370,62 @@ let rec generate_verification_conditions_scope_body_expr
in
new_ctx, vc_list @ new_vcs, assert_list @ new_asserts
let rec generate_verification_conditions_scopes
let generate_verification_conditions_code_items
(decl_ctx : decl_ctx)
(scopes : 'm expr scopes)
(code_items : 'm expr code_item_list)
(s : ScopeName.t option) : verification_condition list =
match scopes with
| Nil -> []
| ScopeDef scope_def ->
let is_selected_scope =
match s with
| Some s when ScopeName.compare s scope_def.scope_name = 0 -> true
| None -> true
| _ -> false
in
let vcs =
if is_selected_scope then
let _scope_input_var, scope_body_expr =
Bindlib.unbind scope_def.scope_body.scope_body_expr
Scope.fold_left
~f:(fun vcs item _ ->
match item with
| Topdef _ -> []
| ScopeDef (name, body) ->
let is_selected_scope =
match s with
| Some s when ScopeName.equal s name -> true
| None -> true
| _ -> false
in
let ctx =
{
current_scope_name = scope_def.scope_name;
decl = decl_ctx;
input_vars = [];
scope_variables_typs =
Var.Map.empty
(* We don't need to add the typ of the scope input var here
because it will never appear in an expression for which we
generate a verification conditions (the big struct is
destructured with a series of let bindings just after. )*);
}
let new_vcs =
if is_selected_scope then
let _scope_input_var, scope_body_expr =
Bindlib.unbind body.scope_body_expr
in
let ctx =
{
current_scope_name = name;
decl = decl_ctx;
input_vars = [];
scope_variables_typs =
Var.Map.empty
(* We don't need to add the typ of the scope input var here
because it will never appear in an expression for which we
generate a verification conditions (the big struct is
destructured with a series of let bindings just after. )*);
}
in
let _, vcs, asserts =
generate_verification_conditions_scope_body_expr ctx
scope_body_expr
in
let combined_assert =
conjunction_exprs asserts
(Typed
{
pos = Pos.no_pos;
ty = Marked.mark Pos.no_pos (TLit TBool);
})
in
List.map (fun vc -> { vc with vc_asserts = combined_assert }) vcs
else []
in
let _, vcs, asserts =
generate_verification_conditions_scope_body_expr ctx scope_body_expr
in
let combined_assert =
conjunction_exprs asserts
(Typed
{ pos = Pos.no_pos; ty = Marked.mark Pos.no_pos (TLit TBool) })
in
List.map (fun vc -> { vc with vc_asserts = combined_assert }) vcs
else []
in
let _scope_var, next = Bindlib.unbind scope_def.scope_next in
generate_verification_conditions_scopes decl_ctx next s @ vcs
new_vcs @ vcs)
~init:[] code_items
let generate_verification_conditions (p : 'm program) (s : ScopeName.t option) :
verification_condition list =
let vcs = generate_verification_conditions_scopes p.decl_ctx p.scopes s in
let vcs =
generate_verification_conditions_code_items p.decl_ctx p.code_items s
in
(* We sort this list by scope name and then variable name to ensure consistent
output for testing*)
List.sort

2
compiler/verification/z3backend.real.ml
View File

@ -676,6 +676,8 @@ and translate_expr (ctx : context) (vc : typed expr) : context * Expr.expr =
in
let ctx, s = translate_expr ctx e in
ctx, Expr.mk_app ctx.ctx_z3 accessor [s]
| ETuple _ -> failwith "[Z3 encoding] ETuple unsupported"
| ETupleAccess _ -> failwith "[Z3 encoding] ETupleAccess unsupported"
| EInj { e; cons; name } ->
(* This node corresponds to creating a value for the enumeration [en], by
calling the [idx]-th constructor of enum [en], with argument [e] *)

BIN
doc/syntax/syntax.pdf
View File

Binary file not shown.

9
doc/syntax/syntax_en.tex
View File

@ -358,6 +358,7 @@
match expr with pattern
-- Case1 of x: ...
-- Case2 : ...
-- anything : ...
```
\end{catala}
\\
@ -389,7 +390,7 @@
\\
Direct scope call & \begin{catala}
```catala
outut of Scope1
output of Scope1
with { -- fld1: 9 -- fld2: true }
```
\end{catala}
@ -444,9 +445,9 @@
\\
State transitions declaration & \begin{catala}
```catala
internal var1 content ...
state before
state after
internal var1 content ...
state before
state after
```
\end{catala}
\\

9
doc/syntax/syntax_fr.tex
View File

@ -364,6 +364,7 @@
selon expr sous forme
-- Cas1 de x: ...
-- Cas2 : ...
-- n'importe quel : ...
```
\end{catala}
\\
@ -422,7 +423,7 @@
\\
Déclaration d'énumération & \begin{catala}
```catala
déclaration énumeration Énum1:
déclaration énumération Énum1:
-- Cas1 contenu entier
-- Cas2
```
@ -450,9 +451,9 @@
\\
Transitions d'état & \begin{catala}
```catala
interne var1 contenu ...
état avant
état après
interne var1 contenu ...
état avant
état après
```
\end{catala}
\\

8
examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en
View File

@ -29,7 +29,7 @@ scope Test1:
```catala-test-inline
$ catala Interpret -s Test1
[ERROR] Syntax error at token "scope"
Message: unexpected token
Message: expected either 'condition', or 'content' followed by the expected variable type
Autosuggestion: did you mean "content", or maybe "condition"?
Error token:
@ -73,7 +73,7 @@ scope Test2:
```catala-test-inline
$ catala Interpret -s Test2
[ERROR] Syntax error at token "scope"
Message: unexpected token
Message: expected either 'condition', or 'content' followed by the expected variable type
Autosuggestion: did you mean "content", or maybe "condition"?
Error token:
@ -117,7 +117,7 @@ scope Test3:
```catala-test-inline
$ catala Interpret -s Test3
[ERROR] Syntax error at token "scope"
Message: unexpected token
Message: expected either 'condition', or 'content' followed by the expected variable type
Autosuggestion: did you mean "content", or maybe "condition"?
Error token:
@ -163,7 +163,7 @@ scope Test4:
```catala-test-inline
$ catala Interpret -s Test4
[ERROR] Syntax error at token "scope"
Message: unexpected token
Message: expected either 'condition', or 'content' followed by the expected variable type
Autosuggestion: did you mean "content", or maybe "condition"?
Error token:

6900
french_law/js/french_law.js generated
View File

File diff suppressed because one or more lines are too long

386
french_law/ocaml/law_source/aides_logement.ml generated
View File

@ -2201,7 +2201,7 @@ let calcul_equivalence_loyer_minimale (calcul_equivalence_loyer_minimale_in: Cal
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2676; start_column=14; end_line=2676; end_column=41;
start_line=2685; start_column=14; end_line=2685; end_column=41;
law_headings=["Article 31";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -2239,8 +2239,8 @@ let calcul_equivalence_loyer_minimale (calcul_equivalence_loyer_minimale_in: Cal
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2641; start_column=5;
end_line=2641; end_column=26;
start_line=2650; start_column=5;
end_line=2650; end_column=26;
law_headings=["Article 31";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -2275,7 +2275,7 @@ let calcul_equivalence_loyer_minimale (calcul_equivalence_loyer_minimale_in: Cal
TrancheRevenu.taux = (decimal_of_string "0.328")})|]))|])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2592; start_column=14; end_line=2592; end_column=38;
start_line=2601; start_column=14; end_line=2601; end_column=38;
law_headings=["Article 31";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -7166,7 +7166,7 @@ let calcul_aide_personnalisee_logement_foyer (calcul_aide_personnalisee_logement
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2556; start_column=14; end_line=2556; end_column=35;
start_line=2565; start_column=14; end_line=2565; end_column=35;
law_headings=["Article 30";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -7192,7 +7192,7 @@ let calcul_aide_personnalisee_logement_foyer (calcul_aide_personnalisee_logement
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2531; start_column=14; end_line=2531; end_column=41;
start_line=2540; start_column=14; end_line=2540; end_column=41;
law_headings=["Article 28";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -7218,7 +7218,7 @@ let calcul_aide_personnalisee_logement_foyer (calcul_aide_personnalisee_logement
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2542; start_column=14; end_line=2542; end_column=42;
start_line=2551; start_column=14; end_line=2551; end_column=42;
law_headings=["Article 29";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -7343,8 +7343,8 @@ let calcul_aide_personnalisee_logement_foyer (calcul_aide_personnalisee_logement
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2477; start_column=14;
end_line=2477; end_column=48;
start_line=2486; start_column=14;
end_line=2486; end_column=48;
law_headings=["Article 27";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -7876,7 +7876,7 @@ let calcul_aide_personnalisee_logement_foyer (calcul_aide_personnalisee_logement
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2705; start_column=14; end_line=2705; end_column=41;
start_line=2714; start_column=14; end_line=2714; end_column=41;
law_headings=["Article 32";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -7905,7 +7905,7 @@ let calcul_aide_personnalisee_logement_foyer (calcul_aide_personnalisee_logement
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2566; start_column=14; end_line=2566; end_column=48;
start_line=2575; start_column=14; end_line=2575; end_column=48;
law_headings=["Article 30";
"Chapitre V : Calcul de l'aide personnalisée au logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -8791,7 +8791,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2335; start_column=14; end_line=2335; end_column=41;
start_line=2344; start_column=14; end_line=2344; end_column=41;
law_headings=["Article 20"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
true)) (fun (_: unit) -> money_of_cents_string "500"))
@ -8816,7 +8816,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2346; start_column=14; end_line=2346; end_column=42;
start_line=2355; start_column=14; end_line=2355; end_column=42;
law_headings=["Article 21"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
true)) (fun (_: unit) -> money_of_cents_string "1000"))
@ -8841,7 +8841,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2355; start_column=15; end_line=2355; end_column=49;
start_line=2364; start_column=15; end_line=2364; end_column=49;
law_headings=["Article 22"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
true)) (fun (_: unit) -> money_of_cents_string "2211133"))
@ -8866,7 +8866,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2448; start_column=14; end_line=2448; end_column=48;
start_line=2457; start_column=14; end_line=2457; end_column=48;
law_headings=["Article 26"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
true)) (fun (_: unit) -> decimal_of_string "16.25"))
@ -8891,7 +8891,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2370; start_column=14; end_line=2370; end_column=47;
start_line=2379; start_column=14; end_line=2379; end_column=47;
law_headings=["Article 23"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
true)) (fun (_: unit) -> money_of_cents_string "560085"))
@ -8916,7 +8916,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2371; start_column=14; end_line=2371; end_column=47;
start_line=2380; start_column=14; end_line=2380; end_column=47;
law_headings=["Article 23"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
true)) (fun (_: unit) -> decimal_of_string "0.208"))
@ -8941,7 +8941,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2372; start_column=14; end_line=2372; end_column=47;
start_line=2381; start_column=14; end_line=2381; end_column=47;
law_headings=["Article 23"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
true)) (fun (_: unit) -> decimal_of_string "0.416"))
@ -9081,7 +9081,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2430; start_column=14; end_line=2430; end_column=50;
start_line=2439; start_column=14; end_line=2439; end_column=50;
law_headings=["Article 25"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
true))
@ -9182,8 +9182,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2403; start_column=7;
end_line=2403; end_column=18;
start_line=2412; start_column=7;
end_line=2412; end_column=18;
law_headings=["Article 24"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -9291,8 +9291,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2324; start_column=29;
end_line=2324; end_column=64;
start_line=2333; start_column=29;
end_line=2333; end_column=64;
law_headings=["Article 19"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_gte_dat_dat date_courante_
@ -9506,7 +9506,7 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=806; start_column=5;
end_line=812; end_column=36;
end_line=821; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -9516,23 +9516,27 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
(o_gte_dat_dat param_
(date_of_numbers (1992) (6) (30)))
(o_and
(match anciennete_logement_
with
| NeufOuAncien.Neuf _ -> false
| NeufOuAncien.Ancien ameliore_par_occupant_ ->
(match ameliore_par_occupant_
with
| AmelioreParOccupant.Oui _ ->
true
| AmelioreParOccupant.Non _ ->
false))
(match type_pret_
with
| TypePret.D331_32 _ -> false
| TypePret.D331_63_64 _ -> true
| TypePret.D331_59_8 _ -> false
| TypePret.D331_76_1 _ -> false
| TypePret.Autre _ -> false))))))
(o_lte_dat_dat param_
(date_of_numbers (1994) (11) (27)))
(o_and
(match anciennete_logement_
with
| NeufOuAncien.Neuf _ -> false
| NeufOuAncien.Ancien ameliore_par_occupant_ ->
(match
ameliore_par_occupant_
with
| AmelioreParOccupant.Oui _ ->
true
| AmelioreParOccupant.Non _ ->
false))
(match type_pret_
with
| TypePret.D331_32 _ -> false
| TypePret.D331_63_64 _ -> true
| TypePret.D331_59_8 _ -> false
| TypePret.D331_76_1 _ -> false
| TypePret.Autre _ -> false)))))))
(fun (_: unit) ->
o_mult_mon_rat
( if
@ -9576,8 +9580,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1052; start_column=5;
end_line=1056; end_column=36;
start_line=1061; start_column=5;
end_line=1065; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -9703,8 +9707,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1085; start_column=5;
end_line=1089; end_column=36;
start_line=1094; start_column=5;
end_line=1098; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -9830,8 +9834,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1118; start_column=5;
end_line=1122; end_column=36;
start_line=1127; start_column=5;
end_line=1131; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -9957,8 +9961,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1151; start_column=5;
end_line=1155; end_column=36;
start_line=1160; start_column=5;
end_line=1164; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -10084,8 +10088,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1184; start_column=5;
end_line=1188; end_column=36;
start_line=1193; start_column=5;
end_line=1197; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -10211,8 +10215,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1217; start_column=5;
end_line=1221; end_column=36;
start_line=1226; start_column=5;
end_line=1230; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -10338,8 +10342,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1250; start_column=5;
end_line=1254; end_column=36;
start_line=1259; start_column=5;
end_line=1263; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -10465,8 +10469,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1283; start_column=5;
end_line=1287; end_column=36;
start_line=1292; start_column=5;
end_line=1296; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -10584,8 +10588,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1316; start_column=5;
end_line=1320; end_column=36;
start_line=1325; start_column=5;
end_line=1329; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -10711,8 +10715,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1349; start_column=5;
end_line=1353; end_column=36;
start_line=1358; start_column=5;
end_line=1362; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -10830,8 +10834,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1382; start_column=5;
end_line=1386; end_column=36;
start_line=1391; start_column=5;
end_line=1395; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -10949,8 +10953,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1415; start_column=5;
end_line=1419; end_column=36;
start_line=1424; start_column=5;
end_line=1428; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -11068,8 +11072,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1448; start_column=5;
end_line=1452; end_column=36;
start_line=1457; start_column=5;
end_line=1461; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -11187,8 +11191,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1481; start_column=5;
end_line=1485; end_column=36;
start_line=1490; start_column=5;
end_line=1494; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -11306,8 +11310,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1514; start_column=5;
end_line=1518; end_column=36;
start_line=1523; start_column=5;
end_line=1527; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -11425,8 +11429,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1547; start_column=5;
end_line=1551; end_column=36;
start_line=1556; start_column=5;
end_line=1560; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -11544,8 +11548,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1580; start_column=5;
end_line=1584; end_column=36;
start_line=1589; start_column=5;
end_line=1593; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -11663,8 +11667,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1613; start_column=5;
end_line=1617; end_column=36;
start_line=1622; start_column=5;
end_line=1626; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -11782,8 +11786,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1646; start_column=5;
end_line=1650; end_column=36;
start_line=1655; start_column=5;
end_line=1659; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -11901,8 +11905,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1679; start_column=5;
end_line=1683; end_column=36;
start_line=1688; start_column=5;
end_line=1692; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12020,8 +12024,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1712; start_column=5;
end_line=1716; end_column=36;
start_line=1721; start_column=5;
end_line=1725; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12139,8 +12143,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1745; start_column=5;
end_line=1749; end_column=36;
start_line=1754; start_column=5;
end_line=1758; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12258,8 +12262,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1778; start_column=5;
end_line=1782; end_column=36;
start_line=1787; start_column=5;
end_line=1791; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12377,8 +12381,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1811; start_column=5;
end_line=1815; end_column=36;
start_line=1820; start_column=5;
end_line=1824; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12496,8 +12500,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1844; start_column=5;
end_line=1848; end_column=36;
start_line=1853; start_column=5;
end_line=1857; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12615,8 +12619,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1877; start_column=5;
end_line=1881; end_column=36;
start_line=1886; start_column=5;
end_line=1890; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12734,8 +12738,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1910; start_column=5;
end_line=1914; end_column=36;
start_line=1919; start_column=5;
end_line=1923; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12853,8 +12857,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1943; start_column=5;
end_line=1947; end_column=36;
start_line=1952; start_column=5;
end_line=1956; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -12972,8 +12976,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=1976; start_column=5;
end_line=1980; end_column=36;
start_line=1985; start_column=5;
end_line=1989; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -13091,8 +13095,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2009; start_column=5;
end_line=2013; end_column=36;
start_line=2018; start_column=5;
end_line=2022; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -13210,8 +13214,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2042; start_column=5;
end_line=2046; end_column=36;
start_line=2051; start_column=5;
end_line=2055; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -13329,8 +13333,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2075; start_column=5;
end_line=2079; end_column=36;
start_line=2084; start_column=5;
end_line=2088; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -13448,8 +13452,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2108; start_column=5;
end_line=2112; end_column=36;
start_line=2117; start_column=5;
end_line=2121; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -13567,8 +13571,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2141; start_column=5;
end_line=2145; end_column=36;
start_line=2150; start_column=5;
end_line=2154; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -13686,8 +13690,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2174; start_column=5;
end_line=2178; end_column=36;
start_line=2183; start_column=5;
end_line=2187; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -13805,8 +13809,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2207; start_column=5;
end_line=2211; end_column=36;
start_line=2216; start_column=5;
end_line=2220; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -13924,8 +13928,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2240; start_column=5;
end_line=2243; end_column=36;
start_line=2249; start_column=5;
end_line=2252; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -14037,8 +14041,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2272; start_column=5;
end_line=2275; end_column=36;
start_line=2281; start_column=5;
end_line=2284; end_column=36;
law_headings=["Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_and
@ -15123,8 +15127,8 @@ let calcul_aide_personnalisee_logement_accession_propriete (calcul_aide_personna
plafond_mensualite_d832_10_3_base_))|])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2384; start_column=14;
end_line=2384; end_column=42;
start_line=2393; start_column=14;
end_line=2393; end_column=42;
law_headings=["Article 24"; "Article 18";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
(o_gte_dat_dat date_courante_
@ -18606,7 +18610,7 @@ let calcul_allocation_logement_foyer (calcul_allocation_logement_foyer_in: Calcu
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4091; start_column=14; end_line=4091; end_column=42;
start_line=4100; start_column=14; end_line=4100; end_column=42;
law_headings=["Article 42";
"Chapitre VII : Calcul des allocations de logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -18630,7 +18634,7 @@ let calcul_allocation_logement_foyer (calcul_allocation_logement_foyer_in: Calcu
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4080; start_column=14; end_line=4080; end_column=41;
start_line=4089; start_column=14; end_line=4089; end_column=41;
law_headings=["Article 41";
"Chapitre VII : Calcul des allocations de logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -18654,7 +18658,7 @@ let calcul_allocation_logement_foyer (calcul_allocation_logement_foyer_in: Calcu
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4182; start_column=14; end_line=4182; end_column=51;
start_line=4191; start_column=14; end_line=4191; end_column=51;
law_headings=["Article 44";
"Chapitre VII : Calcul des allocations de logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -19099,8 +19103,8 @@ let calcul_allocation_logement_foyer (calcul_allocation_logement_foyer_in: Calcu
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4067; start_column=14;
end_line=4067; end_column=41;
start_line=4076; start_column=14;
end_line=4076; end_column=41;
law_headings=["Article 40";
"Chapitre VII : Calcul des allocations de logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -19167,8 +19171,8 @@ let calcul_allocation_logement_foyer (calcul_allocation_logement_foyer_in: Calcu
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4109; start_column=6;
end_line=4109; end_column=79;
start_line=4118; start_column=6;
end_line=4118; end_column=79;
law_headings=["Article 43";
"Chapitre VII : Calcul des allocations de logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -19202,8 +19206,8 @@ let calcul_allocation_logement_foyer (calcul_allocation_logement_foyer_in: Calcu
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4144; start_column=6;
end_line=4145; end_column=38;
start_line=4153; start_column=6;
end_line=4154; end_column=38;
law_headings=["Article 43";
"Chapitre VII : Calcul des allocations de logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -19246,8 +19250,8 @@ let calcul_allocation_logement_foyer (calcul_allocation_logement_foyer_in: Calcu
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4162; start_column=6;
end_line=4163; end_column=24;
start_line=4171; start_column=6;
end_line=4172; end_column=24;
law_headings=["Article 43";
"Chapitre VII : Calcul des allocations de logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -19273,8 +19277,8 @@ let calcul_allocation_logement_foyer (calcul_allocation_logement_foyer_in: Calcu
(money_of_cents_string "27365")))|])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4126; start_column=6;
end_line=4127; end_column=46;
start_line=4135; start_column=6;
end_line=4136; end_column=46;
law_headings=["Article 43";
"Chapitre VII : Calcul des allocations de logement en secteur logement-foyer";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20124,7 +20128,7 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3954; start_column=14; end_line=3954; end_column=40;
start_line=3963; start_column=14; end_line=3963; end_column=40;
law_headings=["Article 35";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20174,7 +20178,7 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3964; start_column=14; end_line=3964; end_column=41;
start_line=3973; start_column=14; end_line=3973; end_column=41;
law_headings=["Article 36";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20198,7 +20202,7 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4018; start_column=14; end_line=4018; end_column=41;
start_line=4027; start_column=14; end_line=4027; end_column=41;
law_headings=["Article 38";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20222,7 +20226,7 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4043; start_column=14; end_line=4043; end_column=41;
start_line=4052; start_column=14; end_line=4052; end_column=41;
law_headings=["Article 39";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20246,7 +20250,7 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4025; start_column=14; end_line=4025; end_column=33;
start_line=4034; start_column=14; end_line=4034; end_column=33;
law_headings=["Article 38";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20270,7 +20274,7 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4036; start_column=14; end_line=4036; end_column=33;
start_line=4045; start_column=14; end_line=4045; end_column=33;
law_headings=["Article 39";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20492,8 +20496,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3996; start_column=5;
end_line=3996; end_column=16;
start_line=4005; start_column=5;
end_line=4005; end_column=16;
law_headings=["Article 37";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20513,8 +20517,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
(o_torat_int nombre_personnes_a_charge_))))|])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3942; start_column=31;
end_line=3942; end_column=58;
start_line=3951; start_column=31;
end_line=3951; end_column=58;
law_headings=["Article 34";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20609,8 +20613,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2904; start_column=5;
end_line=2904; end_column=62;
start_line=2913; start_column=5;
end_line=2913; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20788,8 +20792,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2950; start_column=5;
end_line=2950; end_column=62;
start_line=2959; start_column=5;
end_line=2959; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -20967,8 +20971,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=2996; start_column=5;
end_line=2996; end_column=62;
start_line=3005; start_column=5;
end_line=3005; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -21146,8 +21150,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3042; start_column=5;
end_line=3042; end_column=62;
start_line=3051; start_column=5;
end_line=3051; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -21325,8 +21329,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3088; start_column=5;
end_line=3088; end_column=62;
start_line=3097; start_column=5;
end_line=3097; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -21504,8 +21508,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3134; start_column=5;
end_line=3134; end_column=62;
start_line=3143; start_column=5;
end_line=3143; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -21683,8 +21687,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3180; start_column=5;
end_line=3180; end_column=62;
start_line=3189; start_column=5;
end_line=3189; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -21862,8 +21866,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3226; start_column=5;
end_line=3226; end_column=62;
start_line=3235; start_column=5;
end_line=3235; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -22024,8 +22028,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3271; start_column=5;
end_line=3271; end_column=62;
start_line=3280; start_column=5;
end_line=3280; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -22186,8 +22190,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3316; start_column=5;
end_line=3316; end_column=62;
start_line=3325; start_column=5;
end_line=3325; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -22348,8 +22352,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3361; start_column=5;
end_line=3361; end_column=62;
start_line=3370; start_column=5;
end_line=3370; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -22510,8 +22514,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3406; start_column=5;
end_line=3406; end_column=62;
start_line=3415; start_column=5;
end_line=3415; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -22672,8 +22676,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3451; start_column=5;
end_line=3451; end_column=62;
start_line=3460; start_column=5;
end_line=3460; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -22834,8 +22838,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3496; start_column=5;
end_line=3496; end_column=62;
start_line=3505; start_column=5;
end_line=3505; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -22996,8 +23000,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3541; start_column=5;
end_line=3541; end_column=62;
start_line=3550; start_column=5;
end_line=3550; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -23158,8 +23162,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3586; start_column=5;
end_line=3586; end_column=62;
start_line=3595; start_column=5;
end_line=3595; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -23320,8 +23324,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3631; start_column=5;
end_line=3631; end_column=62;
start_line=3640; start_column=5;
end_line=3640; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -23482,8 +23486,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3676; start_column=5;
end_line=3676; end_column=62;
start_line=3685; start_column=5;
end_line=3685; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -23644,8 +23648,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3721; start_column=5;
end_line=3721; end_column=62;
start_line=3730; start_column=5;
end_line=3730; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -23806,8 +23810,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3766; start_column=5;
end_line=3766; end_column=62;
start_line=3775; start_column=5;
end_line=3775; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -23968,8 +23972,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3811; start_column=5;
end_line=3811; end_column=62;
start_line=3820; start_column=5;
end_line=3820; end_column=62;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -24130,8 +24134,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3856; start_column=5;
end_line=3856; end_column=32;
start_line=3865; start_column=5;
end_line=3865; end_column=32;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -24536,8 +24540,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
param_)))))))))|])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3976; start_column=24;
end_line=3976; end_column=56;
start_line=3985; start_column=24;
end_line=3985; end_column=56;
law_headings=["Article 37";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -24580,8 +24584,8 @@ let calcul_allocation_logement_accession_propriete (calcul_allocation_logement_a
(fun (_: unit) -> raise EmptyError))|])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=3900; start_column=14;
end_line=3900; end_column=46;
start_line=3909; start_column=14;
end_line=3909; end_column=46;
law_headings=["Article 33";
"Chapitre IV : Calcul des allocations de logement en secteur accession";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}
@ -26917,7 +26921,7 @@ let eligibilite_prime_de_demenagement (eligibilite_prime_de_demenagement_in: Eli
"Prologue : aides au logement"]} ([||])
(fun (_: unit) -> (log_decision_taken
{filename = "examples/aides_logement/arrete_2019-09-27.catala_fr";
start_line=4197; start_column=14; end_line=4197; end_column=29;
start_line=4206; start_column=14; end_line=4206; end_column=29;
law_headings=["Article 45";
"Chapitre VIII : Prime de déménagement";
"Arrêté du 27 septembre 2019 relatif au calcul des aides personnelles au logement et de la prime de déménagement"]}

25834
french_law/python/src/aides_logement.py generated
View File

File diff suppressed because it is too large Load Diff

130
french_law/python/src/allocations_familiales.py generated
View File

@ -551,16 +551,70 @@ def smic(smic_in:SmicIn):
def temp_brut_horaire_1(_:Unit):
return False
def temp_brut_horaire_2(_:Unit):
if ((date_courante >= date_of_numbers(2022,5,1)) and
if ((date_courante >= date_of_numbers(2023,1,1)) and
((date_courante <= date_of_numbers(2023,12,31)) and
(residence == Collectivite(Collectivite_Code.Mayotte,
Unit())))):
return money_of_cents_string("851")
else:
raise EmptyError
def temp_brut_horaire_3(_:Unit):
if ((date_courante >= date_of_numbers(2023,1,1)) and
((date_courante <= date_of_numbers(2023,12,31)) and
((residence == Collectivite(Collectivite_Code.Metropole,
Unit())) or ((residence ==
Collectivite(Collectivite_Code.Guadeloupe, Unit())) or
((residence == Collectivite(Collectivite_Code.Guyane,
Unit())) or ((residence ==
Collectivite(Collectivite_Code.Martinique, Unit())) or
((residence == Collectivite(Collectivite_Code.LaReunion,
Unit())) or ((residence ==
Collectivite(Collectivite_Code.SaintBarthelemy, Unit())) or
((residence == Collectivite(Collectivite_Code.SaintMartin,
Unit())) or (residence ==
Collectivite(Collectivite_Code.SaintPierreEtMiquelon,
Unit()))))))))))):
return money_of_cents_string("1127")
else:
raise EmptyError
def temp_brut_horaire_4(_:Unit):
if ((date_courante >= date_of_numbers(2022,8,1)) and
((date_courante <= date_of_numbers(2022,12,31)) and
(residence == Collectivite(Collectivite_Code.Mayotte,
Unit())))):
return money_of_cents_string("835")
else:
raise EmptyError
def temp_brut_horaire_5(_:Unit):
if ((date_courante >= date_of_numbers(2022,8,1)) and
((date_courante <= date_of_numbers(2022,12,31)) and
((residence == Collectivite(Collectivite_Code.Metropole,
Unit())) or ((residence ==
Collectivite(Collectivite_Code.Guadeloupe, Unit())) or
((residence == Collectivite(Collectivite_Code.Guyane,
Unit())) or ((residence ==
Collectivite(Collectivite_Code.Martinique, Unit())) or
((residence == Collectivite(Collectivite_Code.LaReunion,
Unit())) or ((residence ==
Collectivite(Collectivite_Code.SaintBarthelemy, Unit())) or
((residence == Collectivite(Collectivite_Code.SaintMartin,
Unit())) or (residence ==
Collectivite(Collectivite_Code.SaintPierreEtMiquelon,
Unit()))))))))))):
return money_of_cents_string("1107")
else:
raise EmptyError
def temp_brut_horaire_6(_:Unit):
if ((date_courante >= date_of_numbers(2022,5,1)) and
((date_courante <= date_of_numbers(2022,7,31)) and
(residence == Collectivite(Collectivite_Code.Mayotte,
Unit())))):
return money_of_cents_string("819")
else:
raise EmptyError
def temp_brut_horaire_3(_:Unit):
def temp_brut_horaire_7(_:Unit):
if ((date_courante >= date_of_numbers(2022,5,1)) and
((date_courante <= date_of_numbers(2022,12,31)) and
((date_courante <= date_of_numbers(2022,7,31)) and
((residence == Collectivite(Collectivite_Code.Metropole,
Unit())) or ((residence ==
Collectivite(Collectivite_Code.Guadeloupe, Unit())) or
@ -577,7 +631,7 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("1085")
else:
raise EmptyError
def temp_brut_horaire_4(_:Unit):
def temp_brut_horaire_8(_:Unit):
if ((date_courante >= date_of_numbers(2022,1,1)) and
((date_courante <= date_of_numbers(2022,4,30)) and
(residence == Collectivite(Collectivite_Code.Mayotte,
@ -585,7 +639,7 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("798")
else:
raise EmptyError
def temp_brut_horaire_5(_:Unit):
def temp_brut_horaire_9(_:Unit):
if ((date_courante >= date_of_numbers(2022,1,1)) and
((date_courante <= date_of_numbers(2022,4,30)) and
((residence == Collectivite(Collectivite_Code.Metropole,
@ -604,7 +658,7 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("1057")
else:
raise EmptyError
def temp_brut_horaire_6(_:Unit):
def temp_brut_horaire_10(_:Unit):
if ((date_courante >= date_of_numbers(2021,1,1)) and
((date_courante <= date_of_numbers(2021,12,31)) and
(residence == Collectivite(Collectivite_Code.Mayotte,
@ -612,7 +666,7 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("774")
else:
raise EmptyError
def temp_brut_horaire_7(_:Unit):
def temp_brut_horaire_11(_:Unit):
if ((date_courante >= date_of_numbers(2021,1,1)) and
((date_courante <= date_of_numbers(2021,12,31)) and
((residence == Collectivite(Collectivite_Code.Metropole,
@ -631,7 +685,7 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("1025")
else:
raise EmptyError
def temp_brut_horaire_8(_:Unit):
def temp_brut_horaire_12(_:Unit):
if ((date_courante >= date_of_numbers(2020,1,1)) and
((date_courante <= date_of_numbers(2020,12,31)) and
(residence == Collectivite(Collectivite_Code.Mayotte,
@ -639,7 +693,7 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("766")
else:
raise EmptyError
def temp_brut_horaire_9(_:Unit):
def temp_brut_horaire_13(_:Unit):
if ((date_courante >= date_of_numbers(2020,1,1)) and
((date_courante <= date_of_numbers(2020,12,31)) and
((residence == Collectivite(Collectivite_Code.Metropole,
@ -658,7 +712,7 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("1015")
else:
raise EmptyError
def temp_brut_horaire_10(_:Unit):
def temp_brut_horaire_14(_:Unit):
if ((date_courante >= date_of_numbers(2019,1,1)) and
((date_courante <= date_of_numbers(2019,12,31)) and
(residence == Collectivite(Collectivite_Code.Mayotte,
@ -666,7 +720,7 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("757")
else:
raise EmptyError
def temp_brut_horaire_11(_:Unit):
def temp_brut_horaire_15(_:Unit):
if ((date_courante >= date_of_numbers(2019,1,1)) and
((date_courante <= date_of_numbers(2019,12,31)) and
((residence == Collectivite(Collectivite_Code.Metropole,
@ -685,11 +739,15 @@ def smic(smic_in:SmicIn):
return money_of_cents_string("1003")
else:
raise EmptyError
temp_brut_horaire_12 = handle_default(SourcePosition(filename="examples/allocations_familiales/../smic/smic.catala_fr",
temp_brut_horaire_16 = handle_default(SourcePosition(filename="examples/allocations_familiales/../smic/smic.catala_fr",
start_line=11, start_column=12,
end_line=11, end_column=24,
law_headings=["Prologue",
"Montant du salaire minimum de croissance"]), [temp_brut_horaire_11,
"Montant du salaire minimum de croissance"]), [temp_brut_horaire_15,
temp_brut_horaire_14,
temp_brut_horaire_13,
temp_brut_horaire_12,
temp_brut_horaire_11,
temp_brut_horaire_10,
temp_brut_horaire_9,
temp_brut_horaire_8,
@ -702,13 +760,13 @@ def smic(smic_in:SmicIn):
temp_brut_horaire_1,
temp_brut_horaire)
except EmptyError:
temp_brut_horaire_12 = dead_value
temp_brut_horaire_16 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/../smic/smic.catala_fr",
start_line=11, start_column=12,
end_line=11, end_column=24,
law_headings=["Prologue",
"Montant du salaire minimum de croissance"]))
brut_horaire = temp_brut_horaire_12
brut_horaire = temp_brut_horaire_16
return Smic(brut_horaire = brut_horaire)
def base_mensuelle_allocations_familiales(base_mensuelle_allocations_familiales_in:BaseMensuelleAllocationsFamilialesIn):
@ -1374,8 +1432,8 @@ def allocations_familiales(allocations_familiales_in:AllocationsFamilialesIn):
except EmptyError:
temp_enfant_le_plus_age_dot_enfants = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=32, start_column=14,
end_line=32, end_column=40,
start_line=33, start_column=14,
end_line=33, end_column=40,
law_headings=["Règles diverses",
"Épilogue"]))
enfant_le_plus_age_dot_enfants = temp_enfant_le_plus_age_dot_enfants
@ -2996,8 +3054,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_enfants_a_charge_2 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=75, start_column=11,
end_line=75, end_column=27,
start_line=76, start_column=11,
end_line=76, end_column=27,
law_headings=["Interface du programme",
"Épilogue"]))
enfants_a_charge_1 = temp_enfants_a_charge_2
@ -3014,8 +3072,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_personne_charge_effective_permanente_est_parent_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=91, start_column=5,
end_line=91, end_column=75,
start_line=92, start_column=5,
end_line=92, end_column=75,
law_headings=["Interface du programme",
"Épilogue"]))
allocations_familiales_dot_personne_charge_effective_permanente_est_parent = temp_allocations_familiales_dot_personne_charge_effective_permanente_est_parent_1
@ -3032,8 +3090,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_personne_charge_effective_permanente_remplit_titre__i_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=95, start_column=5,
end_line=95, end_column=80,
start_line=96, start_column=5,
end_line=96, end_column=80,
law_headings=["Interface du programme",
"Épilogue"]))
allocations_familiales_dot_personne_charge_effective_permanente_remplit_titre__i = temp_allocations_familiales_dot_personne_charge_effective_permanente_remplit_titre__i_1
@ -3042,8 +3100,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_ressources_menage = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=87, start_column=14,
end_line=87, end_column=54,
start_line=88, start_column=14,
end_line=88, end_column=54,
law_headings=["Interface du programme",
"Épilogue"]))
allocations_familiales_dot_ressources_menage = temp_allocations_familiales_dot_ressources_menage
@ -3052,8 +3110,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_residence = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=88, start_column=14,
end_line=88, end_column=46,
start_line=89, start_column=14,
end_line=89, end_column=46,
law_headings=["Interface du programme",
"Épilogue"]))
allocations_familiales_dot_residence = temp_allocations_familiales_dot_residence
@ -3062,8 +3120,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_date_courante = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=85, start_column=14,
end_line=85, end_column=50,
start_line=86, start_column=14,
end_line=86, end_column=50,
law_headings=["Interface du programme",
"Épilogue"]))
allocations_familiales_dot_date_courante = temp_allocations_familiales_dot_date_courante
@ -3072,8 +3130,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_enfants_a_charge = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=86, start_column=14,
end_line=86, end_column=53,
start_line=87, start_column=14,
end_line=87, end_column=53,
law_headings=["Interface du programme",
"Épilogue"]))
allocations_familiales_dot_enfants_a_charge = temp_allocations_familiales_dot_enfants_a_charge
@ -3090,8 +3148,8 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_allocations_familiales_dot_avait_enfant_a_charge_avant_1er_janvier_2012_1 = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=99, start_column=5,
end_line=99, end_column=72,
start_line=100, start_column=5,
end_line=100, end_column=72,
law_headings=["Interface du programme",
"Épilogue"]))
allocations_familiales_dot_avait_enfant_a_charge_avant_1er_janvier_2012 = temp_allocations_familiales_dot_avait_enfant_a_charge_avant_1er_janvier_2012_1
@ -3108,9 +3166,9 @@ def interface_allocations_familiales(interface_allocations_familiales_in:Interfa
except EmptyError:
temp_i_montant_verse = dead_value
raise NoValueProvided(SourcePosition(filename="examples/allocations_familiales/epilogue.catala_fr",
start_line=79, start_column=12,
end_line=79, end_column=27,
start_line=80, start_column=12,
end_line=80, end_column=27,
law_headings=["Interface du programme",
"Épilogue"]))
i_montant_verse = temp_i_montant_verse
return InterfaceAllocationsFamiliales(i_montant_verse = i_montant_verse)
return InterfaceAllocationsFamiliales(i_montant_verse = i_montant_verse)

24
tests/test_name_resolution/bad/toplevel_defs.catala_en Normal file
View File

@ -0,0 +1,24 @@
## Scope calls are not allowed outside of scopes
```catala
declaration scope S1:
output a content decimal
scope S1:
definition a equals 44.2
declaration glob5 content decimal
equals (output of S1).a
```
```catala-test-inline
$ catala typecheck
[ERROR] Scope calls are not allowed outside of a scope
┌─⯈ tests/test_name_resolution/bad/toplevel_defs.catala_en:11.10-22:
└──┐
11 │ equals (output of S1).a
│ ‾‾‾‾‾‾‾‾‾‾‾‾
└─ Scope calls are not allowed outside of scopes
#return code 255#
```

194
tests/test_name_resolution/good/toplevel_defs.catala_en Normal file
View File

@ -0,0 +1,194 @@
## Test basic toplevel values defs
```catala
declaration glob1 content decimal equals 44.12
declaration scope S:
output a content decimal
output b content A
declaration structure A:
data y content boolean
data z content decimal
declaration glob2 content A equals
A { --y: glob1 >= 30. --z: 123. * 17. }
scope S:
definition a equals glob1 * glob1
definition b equals glob2
```
```catala-test-inline
$ catala Interpret -s S
[RESULT] Computation successful! Results:
[RESULT] a = 1946.5744
[RESULT] b = A { "y"= true; "z"= 2091. }
```
## Test toplevel function defs
```catala
declaration glob3 content decimal
depends on x content money
equals decimal of x + 10.
declaration scope S2:
output a content decimal
scope S2:
definition a equals glob3 of $44 + 100.
```
```catala-test-inline
$ catala Interpret -s S2
[RESULT] Computation successful! Results:
[RESULT] a = 154.
```
## Test function def with two args
```catala
declaration glob4 content decimal
depends on x content money, y content decimal
equals decimal of x * y + 10.
declaration scope S3:
output a content decimal
scope S3:
definition a equals 50. + glob4 of $44, 55.
```
```catala-test-inline
$ catala Interpret -s S3
[RESULT] Computation successful! Results:
[RESULT] a = 2480.
```
## Test inline defs in toplevel defs
(can't define inline functions yet)
```catala
declaration glob5 content decimal equals
let x equals decimal of 2 * 3. in
let y equals 1000. in
x * y
declaration scope S4:
output a content decimal
scope S4:
definition a equals glob5 + 1.
```
```catala-test-inline
$ catala Interpret -s S4
[RESULT] Computation successful! Results:
[RESULT] a = 6001.
```
```catala-test-inline
$ catala scalc
let glob1_2 = 44.12
let glob3_3 (x_3: money) = return to_rat_mon x_3 +. 10.
let glob4_4 (x_4: money) (y_5: decimal) = return to_rat_mon x_4 *. y_5 +. 10.
let glob5_aux_5 =
decl glob5_7 : any;
let glob5_7 (x_8 : decimal) =
decl y_9 : decimal;
y_9 = 1000.;
return x_8 *. y_9;
return glob5_7 to_rat_int 2 *. 3.
let glob5_6 = glob5_aux_5 ()
let glob2_10 = A {"y": glob1_2 >=. 30., "z": 123. *. 17.}
let S2_6 (S2_in_11: S2_in {}) =
decl temp_a_13 : any;
try:
decl temp_a_16 : any;
let temp_a_16 (__17 : unit) =
return glob3_3 $44.00 +. 100.;
decl temp_a_14 : any;
let temp_a_14 (__15 : unit) =
return true;
temp_a_13 = handle_default_1 [] temp_a_14 temp_a_16
with EmptyError:
temp_a_13 = dead_value_1;
raise NoValueProvided;
decl a_12 : decimal;
a_12 = temp_a_13;
return S2 {"a": a_12}
let S3_7 (S3_in_18: S3_in {}) =
decl temp_a_20 : any;
try:
decl temp_a_23 : any;
let temp_a_23 (__24 : unit) =
return 50. +. glob4_4 $44.00 55.;
decl temp_a_21 : any;
let temp_a_21 (__22 : unit) =
return true;
temp_a_20 = handle_default_1 [] temp_a_21 temp_a_23
with EmptyError:
temp_a_20 = dead_value_1;
raise NoValueProvided;
decl a_19 : decimal;
a_19 = temp_a_20;
return S3 {"a": a_19}
let S4_8 (S4_in_25: S4_in {}) =
decl temp_a_27 : any;
try:
decl temp_a_30 : any;
let temp_a_30 (__31 : unit) =
return glob5_6 +. 1.;
decl temp_a_28 : any;
let temp_a_28 (__29 : unit) =
return true;
temp_a_27 = handle_default_1 [] temp_a_28 temp_a_30
with EmptyError:
temp_a_27 = dead_value_1;
raise NoValueProvided;
decl a_26 : decimal;
a_26 = temp_a_27;
return S4 {"a": a_26}
let S_9 (S_in_32: S_in {}) =
decl temp_a_40 : any;
try:
decl temp_a_43 : any;
let temp_a_43 (__44 : unit) =
return glob1_2 *. glob1_2;
decl temp_a_41 : any;
let temp_a_41 (__42 : unit) =
return true;
temp_a_40 = handle_default_1 [] temp_a_41 temp_a_43
with EmptyError:
temp_a_40 = dead_value_1;
raise NoValueProvided;
decl a_33 : decimal;
a_33 = temp_a_40;
decl temp_b_35 : any;
try:
decl temp_b_38 : any;
let temp_b_38 (__39 : unit) =
return glob2_10;
decl temp_b_36 : any;
let temp_b_36 (__37 : unit) =
return true;
temp_b_35 = handle_default_1 [] temp_b_36 temp_b_38
with EmptyError:
temp_b_35 = dead_value_1;
raise NoValueProvided;
decl b_34 : A {"y": bool; "z": decimal};
b_34 = temp_b_35;
return S {"a": a_33, "b": b_34}
```

3
tests/test_scope/good/nothing.catala_en
View File

@ -7,11 +7,12 @@ declaration scope Foo2:
```catala-test-inline
$ catala Scalc -s Foo2 -O -t
let Foo2 (Foo2_in_2 : Foo2_in {}) =
let Foo2_3 (Foo2_in_2: Foo2_in {}) =
decl temp_bar_4 : any;
temp_bar_4 = dead_value_1;
raise NoValueProvided;
decl bar_3 : integer;
bar_3 = temp_bar_4;
return Foo2 {"bar": bar_3}
```