CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-09-19 00:15:39 +03:00
Code Issues Projects Releases Wiki Activity

Turn subscope-vars into scope vars

Browse Source 
They are to become citizens of the same class if we want to allow
output-subscopes (without unnecessary complications like deconstructing and
reconstructing the same structure). And it's reasonable to assume that they
share the same namespace.

With this we should shortly collapse the (internal) ambiguity between

- `subscope.subvar`: access to a variable within a subscope
- `subscope.subfield`: access to a field of the output structure contained in a
  subscope variable

With the subscope a variable, these should now become strictly equivalent, so
the plan is that the first could be removed.
This commit is contained in:
Louis Gesbert 2024-03-21 16:59:12 +01:00
parent eeaadef27c
commit 7951661981
17 changed files with 59 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/dcalc/from_scopelang.ml
View File

@ -56,7 +56,7 @@ type 'm ctx = {
('m Ast.expr Var.t * naked_typ * Desugared.Ast.io) ScopeVar.Map.t;
subscope_vars :
('m Ast.expr Var.t * naked_typ * Desugared.Ast.io) ScopeVar.Map.t
SubScopeName.Map.t;
ScopeVar.Map.t;
date_rounding : date_rounding;
}
@ -511,7 +511,7 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
retrieve_out_typ_or_any var ctx.scope_vars
| ELocation (SubScopeVar { alias; var; _ }) ->
ctx.subscope_vars
|> SubScopeName.Map.find (Mark.remove alias)
|> ScopeVar.Map.find (Mark.remove alias)
|> retrieve_out_typ_or_any var
| ELocation (ToplevelVar { name }) -> (
let typ =
@ -572,22 +572,22 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
try
let v, _, _ =
ScopeVar.Map.find (Mark.remove a)
(SubScopeName.Map.find (Mark.remove s) ctx.subscope_vars)
(ScopeVar.Map.find (Mark.remove s) ctx.subscope_vars)
in
Expr.evar v m
with ScopeVar.Map.Not_found _ | SubScopeName.Map.Not_found _ ->
with ScopeVar.Map.Not_found _ | ScopeVar.Map.Not_found _ ->
Message.raise_multispanned_error
[
Some "Incriminated variable usage:", Expr.pos e;
( Some "Incriminated subscope variable declaration:",
Mark.get (ScopeVar.get_info (Mark.remove a)) );
( Some "Incriminated subscope declaration:",
Mark.get (SubScopeName.get_info (Mark.remove s)) );
Mark.get (ScopeVar.get_info (Mark.remove s)) );
]
"The variable %a.%a cannot be used here, as it is not part of subscope \
%a's results. Maybe you forgot to qualify it as an output?"
SubScopeName.format (Mark.remove s) ScopeVar.format (Mark.remove a)
SubScopeName.format (Mark.remove s))
ScopeVar.format (Mark.remove s) ScopeVar.format (Mark.remove a)
ScopeVar.format (Mark.remove s))
| ELocation (ToplevelVar { name }) ->
let path = TopdefName.path (Mark.remove name) in
if path = [] then
@ -666,7 +666,7 @@ let translate_rule
Mark.map
(fun str ->
str ^ "." ^ Mark.remove (ScopeVar.get_info (Mark.remove subs_var)))
(SubScopeName.get_info (Mark.remove subs_index))
(ScopeVar.get_info (Mark.remove subs_index))
in
let a_var = Var.make (Mark.remove a_name) in
let new_e =
@ -704,7 +704,7 @@ let translate_rule
{
ctx with
subscope_vars =
SubScopeName.Map.update (Mark.remove subs_index)
ScopeVar.Map.update (Mark.remove subs_index)
(fun map ->
match map with
| Some map ->
@ -756,7 +756,7 @@ let translate_rule
else None)
all_subscope_vars
in
let pos_call = Mark.get (SubScopeName.get_info subindex) in
let pos_call = Mark.get (ScopeVar.get_info subindex) in
let scope_dcalc_ref =
let m = mark_tany m pos_call in
match subscope_sig.scope_sig_scope_ref with
@ -765,8 +765,8 @@ let translate_rule
Expr.eexternal ~name:(Mark.map (fun n -> External_scope n) name) m
in
let subscope_vars_defined =
try SubScopeName.Map.find subindex ctx.subscope_vars
with SubScopeName.Map.Not_found _ -> ScopeVar.Map.empty
try ScopeVar.Map.find subindex ctx.subscope_vars
with ScopeVar.Map.Not_found _ -> ScopeVar.Map.empty
in
let subscope_var_not_yet_defined subvar =
not (ScopeVar.Map.mem subvar subscope_vars_defined)
@ -804,7 +804,7 @@ let translate_rule
(fun (subvar : scope_var_ctx) ->
let sub_dcalc_var =
Var.make
(Mark.remove (SubScopeName.get_info subindex)
(Mark.remove (ScopeVar.get_info subindex)
^ "."
^ Mark.remove (ScopeVar.get_info subvar.scope_var_name))
in
@ -815,7 +815,7 @@ let translate_rule
tag_with_log_entry scope_dcalc_ref BeginCall
[
sigma_name, pos_sigma;
SubScopeName.get_info subindex;
ScopeVar.get_info subindex;
ScopeName.get_info subname;
]
in
@ -827,7 +827,7 @@ let translate_rule
EndCall
[
sigma_name, pos_sigma;
SubScopeName.get_info subindex;
ScopeVar.get_info subindex;
ScopeName.get_info subname;
]
in
@ -876,7 +876,7 @@ let translate_rule
{
ctx with
subscope_vars =
SubScopeName.Map.add subindex
ScopeVar.Map.add subindex
(List.fold_left
(fun acc (var_ctx, dvar) ->
ScopeVar.Map.add var_ctx.scope_var_name
@ -1173,7 +1173,7 @@ let translate_program (prgm : 'm Scopelang.Ast.program) : 'm Ast.program =
scope_name = None;
scopes_parameters;
scope_vars = ScopeVar.Map.empty;
subscope_vars = SubScopeName.Map.empty;
subscope_vars = ScopeVar.Map.empty;
toplevel_vars;
date_rounding = AbortOnRound;
}

10
compiler/desugared/ast.ml
View File

@ -27,7 +27,7 @@ module ScopeDef = struct
module Base = struct
type t =
| Var of ScopeVar.t * StateName.t option
| SubScopeVar of SubScopeName.t * ScopeVar.t * Pos.t
| SubScopeVar of ScopeVar.t * ScopeVar.t * Pos.t
(** In this case, the [ScopeVar.t] lives inside the context of the
subscope's original declaration *)
@ -38,7 +38,7 @@ module ScopeDef = struct
| 0 -> Option.compare StateName.compare stx sty
| n -> n)
| SubScopeVar (x', x, _), SubScopeVar (y', y, _) -> (
match SubScopeName.compare x' y' with
match ScopeVar.compare x' y' with
| 0 -> ScopeVar.compare x y
| n -> n)
| Var _, _ -> -1
@ -56,14 +56,14 @@ module ScopeDef = struct
| Var (v, Some sv) ->
Format.fprintf fmt "%a.%a" ScopeVar.format v StateName.format sv
| SubScopeVar (s, v, _) ->
Format.fprintf fmt "%a.%a" SubScopeName.format s ScopeVar.format v
Format.fprintf fmt "%a.%a" ScopeVar.format s ScopeVar.format v
let hash x =
match x with
| Var (v, None) -> ScopeVar.hash v
| Var (v, Some sv) -> Int.logxor (ScopeVar.hash v) (StateName.hash sv)
| SubScopeVar (w, v, _) ->
Int.logxor (SubScopeName.hash w) (ScopeVar.hash v)
Int.logxor (ScopeVar.hash w) (ScopeVar.hash v)
end
include Base
@ -220,7 +220,7 @@ type var_or_states = WholeVar | States of StateName.t list
type scope = {
scope_vars : var_or_states ScopeVar.Map.t;
scope_sub_scopes : ScopeName.t SubScopeName.Map.t;
scope_sub_scopes : ScopeName.t ScopeVar.Map.t;
scope_uid : ScopeName.t;
scope_defs : scope_def ScopeDef.Map.t;
scope_assertions : assertion AssertionName.Map.t;

4
compiler/desugared/ast.mli
View File

@ -24,7 +24,7 @@ open Shared_ast
module ScopeDef : sig
type t =
| Var of ScopeVar.t * StateName.t option
| SubScopeVar of SubScopeName.t * ScopeVar.t * Pos.t
| SubScopeVar of ScopeVar.t * ScopeVar.t * Pos.t
val compare : t -> t -> int
val get_position : t -> Pos.t
@ -105,7 +105,7 @@ type var_or_states = WholeVar | States of StateName.t list
type scope = {
scope_vars : var_or_states ScopeVar.Map.t;
scope_sub_scopes : ScopeName.t SubScopeName.Map.t;
scope_sub_scopes : ScopeName.t ScopeVar.Map.t;
scope_uid : ScopeName.t;
scope_defs : scope_def ScopeDef.Map.t;
scope_assertions : assertion AssertionName.Map.t;

20
compiler/desugared/dependency.ml
View File

@ -35,14 +35,14 @@ open Shared_ast
module Vertex = struct
type t =
| Var of ScopeVar.t * StateName.t option
| SubScope of SubScopeName.t
| SubScope of ScopeVar.t
| Assertion of Ast.AssertionName.t
let hash x =
match x with
| Var (x, None) -> ScopeVar.hash x
| Var (x, Some sx) -> Int.logxor (ScopeVar.hash x) (StateName.hash sx)
| SubScope x -> SubScopeName.hash x
| SubScope x -> ScopeVar.hash x
| Assertion a -> Ast.AssertionName.hash a
let compare x y =
@ -51,7 +51,7 @@ module Vertex = struct
match ScopeVar.compare x y with
| 0 -> Option.compare StateName.compare xst yst
| n -> n)
| SubScope x, SubScope y -> SubScopeName.compare x y
| SubScope x, SubScope y -> ScopeVar.compare x y
| Assertion a, Assertion b -> Ast.AssertionName.compare a b
| Var _, _ -> -1
| _, Var _ -> 1
@ -64,7 +64,7 @@ module Vertex = struct
match x, y with
| Var (x, sx), Var (y, sy) ->
ScopeVar.equal x y && Option.equal StateName.equal sx sy
| SubScope x, SubScope y -> SubScopeName.equal x y
| SubScope x, SubScope y -> ScopeVar.equal x y
| Assertion a, Assertion b -> Ast.AssertionName.equal a b
| (Var _ | SubScope _ | Assertion _), _ -> false
@ -73,13 +73,13 @@ module Vertex = struct
| Var (v, None) -> ScopeVar.format fmt v
| Var (v, Some sv) ->
Format.fprintf fmt "%a@%a" ScopeVar.format v StateName.format sv
| SubScope v -> SubScopeName.format fmt v
| SubScope v -> ScopeVar.format fmt v
| Assertion a -> Ast.AssertionName.format fmt a
let info = function
| Var (v, None) -> ScopeVar.get_info v
| Var (_, Some sv) -> StateName.get_info sv
| SubScope v -> SubScopeName.get_info v
| SubScope v -> ScopeVar.get_info v
| Assertion a -> Ast.AssertionName.get_info a
end
@ -177,8 +177,8 @@ let build_scope_dependencies (scope : Ast.scope) : ScopeDependencies.t =
scope.scope_vars g
in
let g =
SubScopeName.Map.fold
(fun (v : SubScopeName.t) _ g ->
ScopeVar.Map.fold
(fun (v : ScopeVar.t) _ g ->
ScopeDependencies.add_vertex g (Vertex.SubScope v))
scope.scope_sub_scopes g
in
@ -230,12 +230,12 @@ 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 SubScopeName.equal used defined then
if ScopeVar.equal used defined then
(* subscopes are not recursive functions *)
Message.raise_spanned_error fv_def_pos
"The subscope %a is used when defining one of its inputs, \
but recursion is forbidden in Catala"
SubScopeName.format defined
ScopeVar.format defined
else
let edge =
ScopeDependencies.E.create (Vertex.SubScope used) fv_def_pos

2
compiler/desugared/dependency.mli
View File

@ -36,7 +36,7 @@ open Shared_ast
module Vertex : sig
type t =
| Var of Shared_ast.ScopeVar.t * Shared_ast.StateName.t option
| SubScope of Shared_ast.SubScopeName.t
| SubScope of Shared_ast.ScopeVar.t
| Assertion of Ast.AssertionName.t
val format : Format.formatter -> t -> unit

4
compiler/desugared/from_surface.ml
View File

@ -1637,8 +1637,8 @@ let translate_program (ctxt : Name_resolution.context) (surface : S.program) :
match v with
| ScopeVar _ -> acc
| SubScope (sub_var, sub_scope) ->
SubScopeName.Map.add sub_var sub_scope acc)
s_context.Name_resolution.var_idmap SubScopeName.Map.empty
ScopeVar.Map.add sub_var sub_scope acc)
s_context.Name_resolution.var_idmap ScopeVar.Map.empty
in
{
Ast.scope_vars;

10
compiler/desugared/name_resolution.ml
View File

@ -136,7 +136,7 @@ let get_var_uid
let get_subscope_uid
(scope_uid : ScopeName.t)
(ctxt : context)
((y, pos) : Ident.t Mark.pos) : SubScopeName.t =
((y, pos) : Ident.t Mark.pos) : ScopeVar.t =
let scope = get_scope_context ctxt scope_uid in
match Ident.Map.find_opt y scope.var_idmap with
| Some (SubScope (sub_uid, _sub_id)) -> sub_uid
@ -274,13 +274,13 @@ let process_subscope_decl
let info =
match use with
| ScopeVar v -> ScopeVar.get_info v
| SubScope (ssc, _) -> SubScopeName.get_info ssc
| SubScope (ssc, _) -> ScopeVar.get_info ssc
in
Message.raise_multispanned_error
[Some "first use", Mark.get info; Some "second use", s_pos]
"Subscope name @{<yellow>\"%s\"@} already used" (Mark.remove subscope)
| None ->
let sub_scope_uid = SubScopeName.fresh (name, name_pos) in
let sub_scope_uid = ScopeVar.fresh (name, name_pos) in
let original_subscope_uid =
let ctxt = module_ctx ctxt path in
get_scope ctxt subscope
@ -377,7 +377,7 @@ let process_data_decl
let info =
match use with
| ScopeVar v -> ScopeVar.get_info v
| SubScope (ssc, _) -> SubScopeName.get_info ssc
| SubScope (ssc, _) -> ScopeVar.get_info ssc
in
Message.raise_multispanned_error
[Some "First use:", Mark.get info; Some "Second use:", pos]
@ -789,7 +789,7 @@ let get_def_key
ScopeVar.format x_uid
else None )
| [y; x] ->
let (subscope_uid, subscope_real_uid) : SubScopeName.t * ScopeName.t =
let (subscope_uid, subscope_real_uid) : ScopeVar.t * ScopeName.t =
match Ident.Map.find_opt (Mark.remove y) scope_ctxt.var_idmap with
| Some (SubScope (v, u)) -> v, u
| Some _ ->

2
compiler/desugared/name_resolution.mli
View File

@ -131,7 +131,7 @@ val get_var_uid : ScopeName.t -> context -> Ident.t Mark.pos -> ScopeVar.t
(** Get the variable uid inside the scope given in argument *)
val get_subscope_uid :
ScopeName.t -> context -> Ident.t Mark.pos -> SubScopeName.t
ScopeName.t -> context -> Ident.t Mark.pos -> ScopeVar.t
(** Get the subscope uid inside the scope given in argument *)
val is_subscope_uid : ScopeName.t -> context -> Ident.t -> bool

4
compiler/driver.ml
View File

@ -363,7 +363,7 @@ module Commands = struct
"Subscope @{<yellow>\"%a\"@} of scope @{<yellow>\"%a\"@} cannot be \
selected by itself, please add \".<var>\" where <var> is a subscope \
variable."
SubScopeName.format subscope_var_name ScopeName.format scope_uid
ScopeVar.format subscope_var_name ScopeName.format scope_uid
| Some second_part -> (
match
let ctxt =
@ -382,7 +382,7 @@ module Commands = struct
"Var @{<yellow>\"%s\"@} of subscope @{<yellow>\"%a\"@} in scope \
@{<yellow>\"%a\"@} does not exist, please check your command line \
arguments."
second_part SubScopeName.format subscope_var_name ScopeName.format
second_part ScopeVar.format subscope_var_name ScopeName.format
scope_uid))
| Some (ScopeVar v) ->
Desugared.Ast.ScopeDef.Var

2
compiler/scopelang/ast.ml
View File

@ -41,7 +41,7 @@ let rec locations_used (e : 'm expr) : LocationSet.t =
type 'm rule =
| Definition of location Mark.pos * typ * Desugared.Ast.io * 'm expr
| Assertion of 'm expr
| Call of ScopeName.t * SubScopeName.t * 'm mark
| Call of ScopeName.t * ScopeVar.t * 'm mark
type scope_var_ty = {
svar_in_ty : typ;

2
compiler/scopelang/ast.mli
View File

@ -34,7 +34,7 @@ val locations_used : 'm expr -> LocationSet.t
type 'm rule =
| Definition of location Mark.pos * typ * Desugared.Ast.io * 'm expr
| Assertion of 'm expr
| Call of ScopeName.t * SubScopeName.t * 'm mark
| Call of ScopeName.t * ScopeVar.t * 'm mark
type scope_var_ty = {
svar_in_ty : typ;

2
compiler/scopelang/dependency.ml
View File

@ -101,7 +101,7 @@ let rule_used_defs = function
| Ast.Call (subscope, subindex, _) ->
if ScopeName.path subscope = [] then
VMap.singleton (Scope subscope)
(Mark.get (SubScopeName.get_info subindex))
(Mark.get (ScopeVar.get_info subindex))
else VMap.empty
let build_program_dep_graph (prgm : 'm Ast.program) : SDependencies.t =

12
compiler/scopelang/from_desugared.ml
View File

@ -256,7 +256,7 @@ let rule_to_exception_graph (scope : D.scope) = function
| NoInput ->
Message.raise_multispanned_error
(( Some "Incriminated subscope:",
Mark.get (SubScopeName.get_info sscope) )
Mark.get (ScopeVar.get_info sscope) )
:: ( Some "Incriminated variable:",
Mark.get (ScopeVar.get_info sub_scope_var) )
:: List.map
@ -272,7 +272,7 @@ let rule_to_exception_graph (scope : D.scope) = function
Message.raise_multispanned_error
[
( Some "Incriminated subscope:",
Mark.get (SubScopeName.get_info sscope) );
Mark.get (ScopeVar.get_info sscope) );
Some "Incriminated variable:", pos;
]
"This subscope variable is a mandatory input but no definition \
@ -615,7 +615,7 @@ let translate_rule
(* Before calling the sub_scope, we need to include all the re-definitions
of subscope parameters*)
let sub_scope =
SubScopeName.Map.find sub_scope_index scope.scope_sub_scopes
ScopeVar.Map.find sub_scope_index scope.scope_sub_scopes
in
let sub_scope_vars_redefs_candidates =
D.ScopeDef.Map.filter
@ -662,7 +662,7 @@ let translate_rule
Scope.input_type def_typ scope_def.D.scope_def_io.D.io_input
in
let subscop_real_name =
SubScopeName.Map.find sub_scope_index scope.scope_sub_scopes
ScopeVar.Map.find sub_scope_index scope.scope_sub_scopes
in
Ast.Definition
( ( SubScopeVar
@ -691,7 +691,7 @@ let translate_rule
Ast.Call
( sub_scope,
sub_scope_index,
Untyped { pos = Mark.get (SubScopeName.get_info sub_scope_index) }
Untyped { pos = Mark.get (ScopeVar.get_info sub_scope_index) }
);
]
| Assertion a_name ->
@ -699,7 +699,7 @@ let translate_rule
D.AssertionName.Map.find a_name scope.scope_assertions
in
(* we unbox here because assertions do not have free variables (at this
point Bindlib variables are only for fuhnction parameters)*)
point Bindlib variables are only for function parameters)*)
let assertion_expr = translate_expr ctx (Expr.unbox assertion_expr) in
[Ast.Assertion (Expr.unbox assertion_expr)]

2
compiler/scopelang/print.ml
View File

@ -96,7 +96,7 @@ let scope ?debug ctx fmt (name, (decl, _pos)) =
| Call (scope_name, subscope_name, _) ->
Format.fprintf fmt "%a %a%a%a%a" Print.keyword "call"
ScopeName.format scope_name Print.punctuation "["
SubScopeName.format subscope_name Print.punctuation "]"))
ScopeVar.format subscope_name Print.punctuation "]"))
decl.scope_decl_rules
let print_topdef ctx ppf name (e, ty) =

11
compiler/shared_ast/definitions.ml
View File

@ -95,16 +95,9 @@ module ScopeVar =
end)
()
module SubScopeName =
Uid.Gen
(struct
let style = Ocolor_types.(Fg (C4 hi_magenta))
end)
()
type scope_var_or_subscope =
| ScopeVar of ScopeVar.t
| SubScope of SubScopeName.t * ScopeName.t
| SubScope of ScopeVar.t * ScopeName.t
module StateName =
Uid.Gen
@ -446,7 +439,7 @@ type 'a glocation =
-> < scopeVarSimpl : yes ; .. > glocation
| SubScopeVar : {
scope : ScopeName.t;
alias : SubScopeName.t Mark.pos;
alias : ScopeVar.t Mark.pos;
var : ScopeVar.t Mark.pos;
}
-> < explicitScopes : yes ; .. > glocation

2
compiler/shared_ast/expr.ml
View File

@ -552,7 +552,7 @@ let compare_location
ScopeVar.compare vx vy
| ( SubScopeVar { alias = xsubindex, _; var = xsubvar, _; _ },
SubScopeVar { alias = ysubindex, _; var = ysubvar, _; _ } ) ->
let c = SubScopeName.compare xsubindex ysubindex in
let c = ScopeVar.compare xsubindex ysubindex in
if c = 0 then ScopeVar.compare xsubvar ysubvar else c
| ToplevelVar { name = vx, _ }, ToplevelVar { name = vy, _ } ->
TopdefName.compare vx vy

2
compiler/shared_ast/print.ml
View File

@ -75,7 +75,7 @@ let location (type a) (fmt : Format.formatter) (l : a glocation) : unit =
| DesugaredScopeVar { name; _ } -> ScopeVar.format fmt (Mark.remove name)
| ScopelangScopeVar { name; _ } -> ScopeVar.format fmt (Mark.remove name)
| SubScopeVar { alias = subindex; var = subvar; _ } ->
Format.fprintf fmt "%a.%a" SubScopeName.format (Mark.remove subindex)
Format.fprintf fmt "%a.%a" ScopeVar.format (Mark.remove subindex)
ScopeVar.format (Mark.remove subvar)
| ToplevelVar { name } -> TopdefName.format fmt (Mark.remove name)