From 2b8d6676d54ddfbe39a6ec082073dd64c0e7f2bb Mon Sep 17 00:00:00 2001 From: vbot Date: Wed, 17 Jul 2024 15:17:57 +0200 Subject: [PATCH] Scopelang: add list of definitions's positions to scope var def --- compiler/dcalc/from_scopelang.ml | 9 +++++---- compiler/scopelang/ast.ml | 4 ++-- compiler/scopelang/ast.mli | 8 +++----- compiler/scopelang/from_desugared.ml | 17 +++++++++-------- 4 files changed, 19 insertions(+), 19 deletions(-) diff --git a/compiler/dcalc/from_scopelang.ml b/compiler/dcalc/from_scopelang.ml index 3f7ce22b..8761ca4a 100644 --- a/compiler/dcalc/from_scopelang.ml +++ b/compiler/dcalc/from_scopelang.ml @@ -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) diff --git a/compiler/scopelang/ast.ml b/compiler/scopelang/ast.ml index 2b6ed625..4dd9a99d 100644 --- a/compiler/scopelang/ast.ml +++ b/compiler/scopelang/ast.ml @@ -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; diff --git a/compiler/scopelang/ast.mli b/compiler/scopelang/ast.mli index d44f6ef0..30489e90 100644 --- a/compiler/scopelang/ast.mli +++ b/compiler/scopelang/ast.mli @@ -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; diff --git a/compiler/scopelang/from_desugared.ml b/compiler/scopelang/from_desugared.ml index 0211dd8c..5537f4ae 100644 --- a/compiler/scopelang/from_desugared.ml +++ b/compiler/scopelang/from_desugared.ml @@ -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) );