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

Scopelang: add list of definitions's positions to scope var def

Browse Source
This commit is contained in:
vbot 2024-07-17 15:17:57 +02:00
parent d78f004848
commit 2b8d6676d5
No known key found for this signature in database
GPG Key ID: A2CE1BDBED95DA38
4 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/dcalc/from_scopelang.ml
View File

@ -589,20 +589,21 @@ let translate_rule
match rule with
| S.ScopeVarDefinition { var; typ; e; _ }
| S.SubScopeVarDefinition { var; typ; e; _ } ->
let scope_var = Mark.remove var in
let decl_pos = Mark.get (ScopeVar.get_info scope_var) in
let pos_mark, _ = pos_mark_mk e in
let scope_let_kind, io =
match rule with
| S.ScopeVarDefinition { io; _ } -> ScopeVarDefinition, io
| S.SubScopeVarDefinition _ ->
let pos = Mark.get var in
( SubScopeVarDefinition,
{ io_input = NoInput, pos; io_output = false, pos } )
{ io_input = NoInput, decl_pos; io_output = false, decl_pos } )
| S.Assertion _ -> assert false
in
let a_name = ScopeVar.get_info (Mark.remove var) in
let a_var = Var.make (Mark.remove a_name) in
let new_e = translate_expr ctx e in
let a_expr = Expr.make_var a_var (pos_mark (Mark.get var)) in
let a_expr = Expr.make_var a_var (pos_mark decl_pos) in
let is_func = match Mark.remove typ with TArrow _ -> true | _ -> false in
let merged_expr =
match Mark.remove io.io_input with
@ -629,7 +630,7 @@ let translate_rule
scope_let_typ = typ;
scope_let_expr = merged_expr;
scope_let_kind;
scope_let_pos = Mark.get var;
scope_let_pos = decl_pos;
},
next ))
(Bindlib.bind_var a_var next)

4
compiler/scopelang/ast.ml
View File

@ -40,13 +40,13 @@ let rec locations_used (e : 'm expr) : LocationSet.t =
type 'm rule =
| ScopeVarDefinition of {
var : ScopeVar.t Mark.pos;
var : (ScopeVar.t, Pos.t list) Mark.ed;
typ : typ;
io : Desugared.Ast.io;
e : 'm expr;
}
| SubScopeVarDefinition of {
var : ScopeVar.t Mark.pos;
var : (ScopeVar.t, Pos.t list) Mark.ed;
var_within_origin_scope : ScopeVar.t;
typ : typ;
e : 'm expr;

8
compiler/scopelang/ast.mli
View File

@ -33,16 +33,14 @@ val locations_used : 'm expr -> LocationSet.t
type 'm rule =
| ScopeVarDefinition of {
var : ScopeVar.t Mark.pos;
var : ScopeVar.t * Pos.t list;
(** Scope variable and its list of definitions' positions *)
typ : typ;
io : Desugared.Ast.io;
e : 'm expr;
}
| SubScopeVarDefinition of {
var : ScopeVar.t Mark.pos; (** Variable within the current scope *)
(* scope: ScopeVar.t Mark.pos; (\** Variable pointing to the *\) *)
(* origin_var: ScopeVar.t Mark.pos;
* reentrant: bool; *)
var : ScopeVar.t * Pos.t list; (** Variable within the current scope *)
var_within_origin_scope : ScopeVar.t;
typ : typ; (* non-thunked at this point for reentrant vars *)
e : 'm expr;

17
compiler/scopelang/from_desugared.ml
View File

@ -598,15 +598,16 @@ let translate_rule
(exc_graphs :
Desugared.Dependency.ExceptionsDependencies.t D.ScopeDef.Map.t) = function
| Desugared.Dependency.Vertex.Var (var, state) -> (
let decl_pos = Mark.get (ScopeVar.get_info var) in
let scope_def =
D.ScopeDef.Map.find
((var, Pos.no_pos), D.ScopeDef.Var state)
scope.scope_defs
in
let pos =
match RuleName.Map.choose_opt scope_def.scope_def_rules with
| None -> Mark.get (ScopeVar.get_info var)
| Some (r, _) -> Mark.get (RuleName.get_info r)
let all_def_pos =
List.map
(fun r -> Mark.get (RuleName.get_info r))
(RuleName.Map.keys scope_def.scope_def_rules)
in
match ScopeVar.Map.find_opt var scope.scope_sub_scopes with
| None -> (
@ -620,7 +621,7 @@ let translate_rule
| OnlyInput -> []
(* we do not provide any definition for an input-only variable *)
| _ ->
let scope_def_key = (var, pos), D.ScopeDef.Var state in
let scope_def_key = (var, decl_pos), D.ScopeDef.Var state in
let expr_def =
translate_def ctx scope_def_key var_def var_params var_typ
scope_def.D.scope_def_io
@ -636,7 +637,7 @@ let translate_rule
[
Ast.ScopeVarDefinition
{
var = scope_var, pos;
var = Mark.add all_def_pos scope_var;
typ = var_typ;
io = scope_def.D.scope_def_io;
e = Expr.unbox expr_def;
@ -702,7 +703,7 @@ let translate_rule
in
let subscope_expr =
Expr.escopecall ~scope:subscope ~args:subscope_param_map
(Untyped { pos })
(Untyped { pos = decl_pos })
in
assert (RuleName.Map.is_empty scope_def.D.scope_def_rules);
(* The subscope will be defined by its inputs, it's not supposed to have
@ -716,7 +717,7 @@ let translate_rule
let subscope_def =
Ast.ScopeVarDefinition
{
var = subscope_var_dcalc, pos;
var = Mark.add all_def_pos subscope_var_dcalc;
typ =
( TStruct scope_info.out_struct_name,
Mark.get (ScopeVar.get_info var) );