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

Rename 'IdentName' to 'Ident'

Browse Source
This commit is contained in:
Louis Gesbert 2023-04-18 14:39:38 +02:00
parent c4675e18a7
commit 2b7beeefb2
12 changed files with 110 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
compiler/desugared/from_surface.ml
View File

@ -132,7 +132,7 @@ let disambiguate_constructor
"The deep pattern matching syntactic sugar is not yet supported"
in
let possible_c_uids =
try IdentName.Map.find (Mark.remove constructor) ctxt.constructor_idmap
try Ident.Map.find (Mark.remove constructor) ctxt.constructor_idmap
with Not_found ->
Message.raise_spanned_error (Mark.get constructor)
"The name of this constructor has not been defined before, maybe it is \
@ -198,7 +198,7 @@ let rec translate_expr
(expr : Surface.Ast.expression) : Ast.expr boxed =
let scope_vars =
match scope with
| None -> IdentName.Map.empty
| None -> Ident.Map.empty
| Some s -> (ScopeName.Map.find s ctxt.scopes).var_idmap
in
let rec_helper = translate_expr scope inside_definition_of ctxt in
@ -302,12 +302,12 @@ let rec translate_expr
| Ident ([], (x, pos)) -> (
(* first we check whether this is a local var, then we resort to scope-wide
variables, then global variables *)
match IdentName.Map.find_opt x ctxt.local_var_idmap with
match Ident.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_vars with
match Ident.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.
@ -352,7 +352,7 @@ let rec translate_expr
(* 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
match Ident.Map.find_opt x ctxt.topdefs with
| Some v ->
Expr.elocation
(ToplevelVar (v, Mark.get (TopdefName.get_info v)))
@ -369,7 +369,7 @@ let rec translate_expr
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_vars with
match Ident.Map.find y scope_vars with
| SubScope (sub, sc) -> sub, sc
| ScopeVar _ -> assert false
in
@ -409,7 +409,7 @@ let rec translate_expr
(fun acc (fld_id, e) ->
let var =
match
IdentName.Map.find_opt (Mark.remove fld_id) scope_def.var_idmap
Ident.Map.find_opt (Mark.remove fld_id) scope_def.var_idmap
with
| Some (ScopeVar v) -> v
| Some (SubScope _) | None ->
@ -449,7 +449,7 @@ let rec translate_expr
Expr.eapp fn [rec_helper e1] emark
| StructLit ((([], s_name), _), fields) ->
let s_uid =
match IdentName.Map.find_opt (Mark.remove s_name) ctxt.typedefs with
match Ident.Map.find_opt (Mark.remove s_name) ctxt.typedefs with
| Some (Name_resolution.TStruct s_uid) -> s_uid
| _ ->
Message.raise_spanned_error (Mark.get s_name)
@ -462,7 +462,7 @@ let rec translate_expr
let f_uid =
try
StructName.Map.find s_uid
(IdentName.Map.find (Mark.remove f_name) ctxt.field_idmap)
(Ident.Map.find (Mark.remove f_name) ctxt.field_idmap)
with Not_found ->
Message.raise_spanned_error (Mark.get f_name)
"This identifier should refer to a field of struct %s"
@ -492,7 +492,7 @@ let rec translate_expr
Message.raise_spanned_error pos "Qualified paths are not supported yet"
| EnumInject (((path, (constructor, pos_constructor)), _), payload) -> (
let possible_c_uids =
try IdentName.Map.find constructor ctxt.constructor_idmap
try Ident.Map.find constructor ctxt.constructor_idmap
with Not_found ->
Message.raise_spanned_error pos_constructor
"The name of this constructor has not been defined before, maybe it \
@ -1028,7 +1028,7 @@ let process_def
match def.definition_label with
| Some (label_str, label_pos) ->
Ast.ExplicitlyLabeled
(IdentName.Map.find label_str scope_def_ctxt.label_idmap, label_pos)
(Ident.Map.find label_str scope_def_ctxt.label_idmap, label_pos)
| None -> Ast.Unlabeled
in
let exception_situation =
@ -1044,8 +1044,7 @@ let process_def
ExceptionToRule (name, pos))
| ExceptionToLabel label_str -> (
try
let label_id =
IdentName.Map.find (Mark.remove label_str)
let label_id = Ident.Map.find (Mark.remove label_str)
scope_def_ctxt.label_idmap
in
ExceptionToLabel (label_id, Mark.get label_str)
@ -1248,9 +1247,7 @@ let process_topdef
(prgm : Ast.program)
(def : S.top_def) : Ast.program =
let id =
IdentName.Map.find
(Mark.remove def.S.topdef_name)
ctxt.Name_resolution.topdefs
Ident.Map.find (Mark.remove def.S.topdef_name) ctxt.Name_resolution.topdefs
in
let translate_typ t = Name_resolution.process_type ctxt t in
let translate_tbase (tbase, m) = translate_typ (Base tbase, m) in
@ -1295,7 +1292,7 @@ let attribute_to_io (attr : Surface.Ast.scope_decl_context_io) : Ast.io =
let init_scope_defs
(ctxt : Name_resolution.context)
(scope_idmap : Name_resolution.scope_var_or_subscope IdentName.Map.t) :
(scope_idmap : Name_resolution.scope_var_or_subscope Ident.Map.t) :
Ast.scope_def Ast.ScopeDef.Map.t =
(* Initializing the definitions of all scopes and subscope vars, with no rules
yet inside *)
@ -1351,7 +1348,7 @@ let init_scope_defs
let sub_scope_def =
ScopeName.Map.find subscope_uid ctxt.Name_resolution.scopes
in
IdentName.Map.fold
Ident.Map.fold
(fun _ v scope_def_map ->
match v with
| Name_resolution.SubScope _ -> scope_def_map
@ -1373,7 +1370,7 @@ let init_scope_defs
scope_def_map)
sub_scope_def.Name_resolution.var_idmap scope_def_map
in
IdentName.Map.fold add_def scope_idmap Ast.ScopeDef.Map.empty
Ident.Map.fold add_def scope_idmap Ast.ScopeDef.Map.empty
(** Main function of this module *)
let translate_program
@ -1384,7 +1381,7 @@ let translate_program
ScopeName.Map.mapi
(fun s_uid s_context ->
let scope_vars =
IdentName.Map.fold
Ident.Map.fold
(fun _ v acc ->
match v with
| Name_resolution.SubScope _ -> acc
@ -1396,7 +1393,7 @@ let translate_program
s_context.Name_resolution.var_idmap ScopeVar.Map.empty
in
let scope_sub_scopes =
IdentName.Map.fold
Ident.Map.fold
(fun _ v acc ->
match v with
| Name_resolution.ScopeVar _ -> acc
@ -1421,7 +1418,7 @@ let translate_program
ctx_structs = ctxt.Name_resolution.structs;
ctx_enums = ctxt.Name_resolution.enums;
ctx_scopes =
IdentName.Map.fold
Ident.Map.fold
(fun _ def acc ->
match def with
| Name_resolution.TScope (scope, scope_out_struct) ->

2
compiler/desugared/linting.ml
View File

@ -109,7 +109,7 @@ let detect_unused_struct_fields (p : program) : unit =
| EDStructAccess { name_opt = Some name; e = e_struct; field } ->
let field =
StructName.Map.find name
(IdentName.Map.find field p.program_ctx.ctx_struct_fields)
(Ident.Map.find field p.program_ctx.ctx_struct_fields)
in
StructField.Set.add field
(structs_fields_used_expr e_struct struct_fields_used)

117
compiler/desugared/name_resolution.ml
View File

@ -27,7 +27,7 @@ type unique_rulename = Ambiguous of Pos.t list | Unique of RuleName.t Mark.pos
type scope_def_context = {
default_exception_rulename : unique_rulename option;
label_idmap : LabelName.t IdentName.Map.t;
label_idmap : LabelName.t Ident.Map.t;
}
type scope_var_or_subscope =
@ -35,7 +35,7 @@ type scope_var_or_subscope =
| SubScope of SubScopeName.t * ScopeName.t
type scope_context = {
var_idmap : scope_var_or_subscope IdentName.Map.t;
var_idmap : scope_var_or_subscope Ident.Map.t;
(** All variables, including scope variables and subscopes *)
scope_defs_contexts : scope_def_context Ast.ScopeDef.Map.t;
(** What is the default rule to refer to for unnamed exceptions, if any *)
@ -56,7 +56,7 @@ type var_sig = {
var_sig_parameters :
(Uid.MarkedString.info * Shared_ast.typ) list Mark.pos option;
var_sig_io : Surface.Ast.scope_decl_context_io;
var_sig_states_idmap : StateName.t IdentName.Map.t;
var_sig_states_idmap : StateName.t Ident.Map.t;
var_sig_states_list : StateName.t list;
}
@ -69,19 +69,19 @@ type typedef =
(** Implicitly defined output struct *)
type context = {
local_var_idmap : Ast.expr Var.t IdentName.Map.t;
local_var_idmap : Ast.expr Var.t Ident.Map.t;
(** Inside a definition, local variables can be introduced by functions
arguments or pattern matching *)
typedefs : typedef IdentName.Map.t;
typedefs : typedef Ident.Map.t;
(** Gathers the names of the scopes, structs and enums *)
field_idmap : StructField.t StructName.Map.t IdentName.Map.t;
field_idmap : StructField.t StructName.Map.t Ident.Map.t;
(** The names of the struct fields. Names of fields can be shared between
different structs *)
constructor_idmap : EnumConstructor.t EnumName.Map.t IdentName.Map.t;
constructor_idmap : EnumConstructor.t EnumName.Map.t Ident.Map.t;
(** 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 *)
topdefs : TopdefName.t Ident.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 *)
@ -99,7 +99,7 @@ let raise_unsupported_feature (msg : string) (pos : Pos.t) =
(** Function to call whenever an identifier used somewhere has not been declared
in the program previously *)
let raise_unknown_identifier (msg : string) (ident : IdentName.t Mark.pos) =
let raise_unknown_identifier (msg : string) (ident : Ident.t Mark.pos) =
Message.raise_spanned_error (Mark.get ident)
"@{<yellow>\"%s\"@}: unknown identifier %s" (Mark.remove ident) msg
@ -118,9 +118,9 @@ let get_var_io (ctxt : context) (uid : ScopeVar.t) :
let get_var_uid
(scope_uid : ScopeName.t)
(ctxt : context)
((x, pos) : IdentName.t Mark.pos) : ScopeVar.t =
((x, pos) : Ident.t Mark.pos) : ScopeVar.t =
let scope = ScopeName.Map.find scope_uid ctxt.scopes in
match IdentName.Map.find_opt x scope.var_idmap with
match Ident.Map.find_opt x scope.var_idmap with
| Some (ScopeVar uid) -> uid
| _ ->
raise_unknown_identifier
@ -131,18 +131,18 @@ let get_var_uid
let get_subscope_uid
(scope_uid : ScopeName.t)
(ctxt : context)
((y, pos) : IdentName.t Mark.pos) : SubScopeName.t =
((y, pos) : Ident.t Mark.pos) : SubScopeName.t =
let scope = ScopeName.Map.find scope_uid ctxt.scopes in
match IdentName.Map.find_opt y scope.var_idmap with
match Ident.Map.find_opt y scope.var_idmap with
| Some (SubScope (sub_uid, _sub_id)) -> sub_uid
| _ -> raise_unknown_identifier "for a subscope of this scope" (y, pos)
(** [is_subscope_uid scope_uid ctxt y] returns true if [y] belongs to the
subscopes of [scope_uid]. *)
let is_subscope_uid (scope_uid : ScopeName.t) (ctxt : context) (y : IdentName.t)
: bool =
let is_subscope_uid (scope_uid : ScopeName.t) (ctxt : context) (y : Ident.t) :
bool =
let scope = ScopeName.Map.find scope_uid ctxt.scopes in
match IdentName.Map.find_opt y scope.var_idmap with
match Ident.Map.find_opt y scope.var_idmap with
| Some (SubScope _) -> true
| _ -> false
@ -150,7 +150,7 @@ let is_subscope_uid (scope_uid : ScopeName.t) (ctxt : context) (y : IdentName.t)
let belongs_to (ctxt : context) (uid : ScopeVar.t) (scope_uid : ScopeName.t) :
bool =
let scope = ScopeName.Map.find scope_uid ctxt.scopes in
IdentName.Map.exists
Ident.Map.exists
(fun _ -> function
| ScopeVar var_uid -> ScopeVar.equal uid var_uid
| _ -> false)
@ -184,7 +184,7 @@ let is_def_cond (ctxt : context) (def : Ast.ScopeDef.t) : bool =
is_var_cond ctxt x
let get_enum ctxt id =
match IdentName.Map.find (Mark.remove id) ctxt.typedefs with
match Ident.Map.find (Mark.remove id) ctxt.typedefs with
| TEnum id -> id
| TStruct sid ->
Message.raise_multispanned_error
@ -205,7 +205,7 @@ let get_enum ctxt id =
(Mark.remove id)
let get_struct ctxt id =
match IdentName.Map.find (Mark.remove id) ctxt.typedefs with
match Ident.Map.find (Mark.remove id) ctxt.typedefs with
| TStruct id | TScope (_, { out_struct_name = id; _ }) -> id
| TEnum eid ->
Message.raise_multispanned_error
@ -219,7 +219,7 @@ let get_struct ctxt id =
(Mark.remove id)
let get_scope ctxt id =
match IdentName.Map.find (Mark.remove id) ctxt.typedefs with
match Ident.Map.find (Mark.remove id) ctxt.typedefs with
| TScope (id, _) -> id
| TEnum eid ->
Message.raise_multispanned_error
@ -249,7 +249,7 @@ let process_subscope_decl
let name, name_pos = decl.scope_decl_context_scope_name in
let subscope, s_pos = decl.scope_decl_context_scope_sub_scope in
let scope_ctxt = ScopeName.Map.find scope ctxt.scopes in
match IdentName.Map.find_opt subscope scope_ctxt.var_idmap with
match Ident.Map.find_opt subscope scope_ctxt.var_idmap with
| Some use ->
let info =
match use with
@ -268,7 +268,7 @@ let process_subscope_decl
{
scope_ctxt with
var_idmap =
IdentName.Map.add name
Ident.Map.add name
(SubScope (sub_scope_uid, original_subscope_uid))
scope_ctxt.var_idmap;
sub_scopes =
@ -304,7 +304,7 @@ let rec process_base_typ
| Surface.Ast.Boolean -> TLit TBool, typ_pos
| Surface.Ast.Text -> raise_unsupported_feature "text type" typ_pos
| Surface.Ast.Named ([], (ident, _pos)) -> (
match IdentName.Map.find_opt ident ctxt.typedefs with
match Ident.Map.find_opt ident ctxt.typedefs with
| Some (TStruct s_uid) -> TStruct s_uid, typ_pos
| Some (TEnum e_uid) -> TEnum e_uid, typ_pos
| Some (TScope (_, scope_str)) ->
@ -337,7 +337,7 @@ let process_data_decl
let is_cond = is_type_cond decl.scope_decl_context_item_typ in
let name, pos = decl.scope_decl_context_item_name in
let scope_ctxt = ScopeName.Map.find scope ctxt.scopes in
match IdentName.Map.find_opt name scope_ctxt.var_idmap with
match Ident.Map.find_opt name scope_ctxt.var_idmap with
| Some use ->
let info =
match use with
@ -352,15 +352,14 @@ let process_data_decl
let scope_ctxt =
{
scope_ctxt with
var_idmap = IdentName.Map.add name (ScopeVar uid) scope_ctxt.var_idmap;
var_idmap = Ident.Map.add name (ScopeVar uid) scope_ctxt.var_idmap;
}
in
let states_idmap, states_list =
List.fold_right
(fun state_id
((states_idmap : StateName.t IdentName.Map.t), states_list) ->
(fun state_id ((states_idmap : StateName.t Ident.Map.t), states_list) ->
let state_id_name = Mark.remove state_id in
if IdentName.Map.mem state_id_name states_idmap then
if Ident.Map.mem state_id_name states_idmap then
Message.raise_multispanned_error_full
[
( Some
@ -375,15 +374,15 @@ let process_data_decl
"Second instance of state @{<yellow>\"%s\"@}:"
state_id_name),
Mark.get
(IdentName.Map.find state_id_name states_idmap
(Ident.Map.find state_id_name states_idmap
|> StateName.get_info) );
]
"There are two states with the same name for the same variable: \
this is ambiguous. Please change the name of either states.";
let state_uid = StateName.fresh state_id in
( IdentName.Map.add state_id_name state_uid states_idmap,
( Ident.Map.add state_id_name state_uid states_idmap,
state_uid :: states_list ))
decl.scope_decl_context_item_states (IdentName.Map.empty, [])
decl.scope_decl_context_item_states (Ident.Map.empty, [])
in
let var_sig_parameters =
Option.map
@ -407,14 +406,13 @@ let process_data_decl
}
(** Adds a binding to the context *)
let add_def_local_var (ctxt : context) (name : IdentName.t) :
let add_def_local_var (ctxt : context) (name : Ident.t) :
context * Ast.expr Var.t =
let local_var_uid = Var.make name in
let ctxt =
{
ctxt with
local_var_idmap =
IdentName.Map.add name local_var_uid ctxt.local_var_idmap;
local_var_idmap = Ident.Map.add name local_var_uid ctxt.local_var_idmap;
}
in
ctxt, local_var_uid
@ -436,7 +434,7 @@ let process_struct_decl (ctxt : context) (sdecl : Surface.Ast.struct_decl) :
{
ctxt with
field_idmap =
IdentName.Map.update
Ident.Map.update
(Mark.remove fdecl.Surface.Ast.struct_decl_field_name)
(fun uids ->
match uids with
@ -481,7 +479,7 @@ let process_enum_decl (ctxt : context) (edecl : Surface.Ast.enum_decl) : context
{
ctxt with
constructor_idmap =
IdentName.Map.update
Ident.Map.update
(Mark.remove cdecl.Surface.Ast.enum_decl_case_name)
(fun uids ->
match uids with
@ -569,21 +567,21 @@ let process_scope_decl (ctxt : context) (decl : Surface.Ast.scope_decl) :
let out_struct_fields =
let sco = ScopeName.Map.find scope_uid ctxt.scopes in
let str = get_struct ctxt decl.scope_decl_name in
IdentName.Map.fold
Ident.Map.fold
(fun id var svmap ->
match var with
| SubScope _ -> svmap
| ScopeVar v -> (
try
let field =
StructName.Map.find str (IdentName.Map.find id ctxt.field_idmap)
StructName.Map.find str (Ident.Map.find id ctxt.field_idmap)
in
ScopeVar.Map.add v field svmap
with Not_found -> svmap))
sco.var_idmap ScopeVar.Map.empty
in
let typedefs =
IdentName.Map.update
Ident.Map.update
(Mark.remove decl.scope_decl_name)
(function
| Some (TScope (scope, { out_struct_name; _ })) ->
@ -617,13 +615,13 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
Option.iter
(fun use ->
raise_already_defined_error (typedef_info use) name pos "scope")
(IdentName.Map.find_opt name ctxt.typedefs);
(Ident.Map.find_opt name ctxt.typedefs);
let scope_uid = ScopeName.fresh (name, pos) in
let out_struct_uid = StructName.fresh (name, pos) in
{
ctxt with
typedefs =
IdentName.Map.add name
Ident.Map.add name
(TScope
( scope_uid,
{
@ -634,7 +632,7 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
scopes =
ScopeName.Map.add scope_uid
{
var_idmap = IdentName.Map.empty;
var_idmap = Ident.Map.empty;
scope_defs_contexts = Ast.ScopeDef.Map.empty;
sub_scopes = ScopeName.Set.empty;
}
@ -645,12 +643,12 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
Option.iter
(fun use ->
raise_already_defined_error (typedef_info use) name pos "struct")
(IdentName.Map.find_opt name ctxt.typedefs);
(Ident.Map.find_opt name ctxt.typedefs);
let s_uid = StructName.fresh sdecl.struct_decl_name in
{
ctxt with
typedefs =
IdentName.Map.add
Ident.Map.add
(Mark.remove sdecl.struct_decl_name)
(TStruct s_uid) ctxt.typedefs;
}
@ -659,12 +657,12 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
Option.iter
(fun use ->
raise_already_defined_error (typedef_info use) name pos "enum")
(IdentName.Map.find_opt name ctxt.typedefs);
(Ident.Map.find_opt name ctxt.typedefs);
let e_uid = EnumName.fresh edecl.enum_decl_name in
{
ctxt with
typedefs =
IdentName.Map.add
Ident.Map.add
(Mark.remove edecl.enum_decl_name)
(TEnum e_uid) ctxt.typedefs;
}
@ -675,9 +673,9 @@ let process_name_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
(fun use ->
raise_already_defined_error (TopdefName.get_info use) name pos
"toplevel definition")
(IdentName.Map.find_opt name ctxt.topdefs);
(Ident.Map.find_opt name ctxt.topdefs);
let uid = TopdefName.fresh def.topdef_name in
{ ctxt with topdefs = IdentName.Map.add name uid ctxt.topdefs }
{ ctxt with topdefs = Ident.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 Mark.pos) :
@ -731,8 +729,7 @@ let get_def_key
| Some state -> (
try
Some
(IdentName.Map.find (Mark.remove state)
var_sig.var_sig_states_idmap)
(Ident.Map.find (Mark.remove state) var_sig.var_sig_states_idmap)
with Not_found ->
Message.raise_multispanned_error
[
@ -742,7 +739,7 @@ let get_def_key
"This identifier is not a state declared for variable %a."
ScopeVar.format_t x_uid)
| None ->
if not (IdentName.Map.is_empty var_sig.var_sig_states_idmap) then
if not (Ident.Map.is_empty var_sig.var_sig_states_idmap) then
Message.raise_multispanned_error
[
None, Mark.get x;
@ -754,7 +751,7 @@ let get_def_key
else None )
| [y; x] ->
let (subscope_uid, subscope_real_uid) : SubScopeName.t * ScopeName.t =
match IdentName.Map.find_opt (Mark.remove y) scope_ctxt.var_idmap with
match Ident.Map.find_opt (Mark.remove y) scope_ctxt.var_idmap with
| Some (SubScope (v, u)) -> v, u
| Some _ ->
Message.raise_spanned_error pos
@ -782,7 +779,7 @@ let update_def_key_ctx
| None -> def_key_ctx
| Some label ->
let new_label_idmap =
IdentName.Map.update (Mark.remove label)
Ident.Map.update (Mark.remove label)
(fun existing_label ->
match existing_label with
| Some existing_label -> Some existing_label
@ -836,7 +833,7 @@ let empty_def_key_ctx =
(* Here, this is the first time we encounter a definition for this
definition key *)
default_exception_rulename = None;
label_idmap = IdentName.Map.empty;
label_idmap = Ident.Map.empty;
}
let process_definition
@ -885,7 +882,7 @@ let process_scope_use (ctxt : context) (suse : Surface.Ast.scope_use) : context
=
let s_name =
match
IdentName.Map.find_opt
Ident.Map.find_opt
(Mark.remove suse.Surface.Ast.scope_use_name)
ctxt.typedefs
with
@ -913,15 +910,15 @@ let process_use_item (ctxt : context) (item : Surface.Ast.code_item Mark.pos) :
let form_context (prgm : Surface.Ast.program) : context =
let empty_ctxt =
{
local_var_idmap = IdentName.Map.empty;
typedefs = IdentName.Map.empty;
local_var_idmap = Ident.Map.empty;
typedefs = Ident.Map.empty;
scopes = ScopeName.Map.empty;
topdefs = IdentName.Map.empty;
topdefs = Ident.Map.empty;
var_typs = ScopeVar.Map.empty;
structs = StructName.Map.empty;
field_idmap = IdentName.Map.empty;
field_idmap = Ident.Map.empty;
enums = EnumName.Map.empty;
constructor_idmap = IdentName.Map.empty;
constructor_idmap = Ident.Map.empty;
}
in
let ctxt =

32
compiler/desugared/name_resolution.mli
View File

@ -27,7 +27,7 @@ type unique_rulename = Ambiguous of Pos.t list | Unique of RuleName.t Mark.pos
type scope_def_context = {
default_exception_rulename : unique_rulename option;
label_idmap : LabelName.t IdentName.Map.t;
label_idmap : LabelName.t Ident.Map.t;
}
type scope_var_or_subscope =
@ -35,7 +35,7 @@ type scope_var_or_subscope =
| SubScope of SubScopeName.t * ScopeName.t
type scope_context = {
var_idmap : scope_var_or_subscope IdentName.Map.t;
var_idmap : scope_var_or_subscope Ident.Map.t;
(** All variables, including scope variables and subscopes *)
scope_defs_contexts : scope_def_context Ast.ScopeDef.Map.t;
(** What is the default rule to refer to for unnamed exceptions, if any *)
@ -56,7 +56,7 @@ type var_sig = {
var_sig_parameters :
(Uid.MarkedString.info * Shared_ast.typ) list Mark.pos option;
var_sig_io : Surface.Ast.scope_decl_context_io;
var_sig_states_idmap : StateName.t IdentName.Map.t;
var_sig_states_idmap : StateName.t Ident.Map.t;
var_sig_states_list : StateName.t list;
}
@ -69,19 +69,19 @@ type typedef =
(** Implicitly defined output struct *)
type context = {
local_var_idmap : Ast.expr Var.t IdentName.Map.t;
local_var_idmap : Ast.expr Var.t Ident.Map.t;
(** Inside a definition, local variables can be introduced by functions
arguments or pattern matching *)
typedefs : typedef IdentName.Map.t;
typedefs : typedef Ident.Map.t;
(** Gathers the names of the scopes, structs and enums *)
field_idmap : StructField.t StructName.Map.t IdentName.Map.t;
field_idmap : StructField.t StructName.Map.t Ident.Map.t;
(** The names of the struct fields. Names of fields can be shared between
different structs *)
constructor_idmap : EnumConstructor.t EnumName.Map.t IdentName.Map.t;
constructor_idmap : EnumConstructor.t EnumName.Map.t Ident.Map.t;
(** 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 *)
topdefs : TopdefName.t Ident.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 *)
@ -96,7 +96,7 @@ val raise_unsupported_feature : string -> Pos.t -> 'a
(** Temporary function raising an error message saying that a feature is not
supported yet *)
val raise_unknown_identifier : string -> IdentName.t Mark.pos -> 'a
val raise_unknown_identifier : string -> Ident.t Mark.pos -> 'a
(** Function to call whenever an identifier used somewhere has not been declared
in the program previously *)
@ -106,14 +106,14 @@ val get_var_typ : context -> ScopeVar.t -> typ
val is_var_cond : context -> ScopeVar.t -> bool
val get_var_io : context -> ScopeVar.t -> Surface.Ast.scope_decl_context_io
val get_var_uid : ScopeName.t -> context -> IdentName.t Mark.pos -> ScopeVar.t
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 -> IdentName.t Mark.pos -> SubScopeName.t
ScopeName.t -> context -> Ident.t Mark.pos -> SubScopeName.t
(** Get the subscope uid inside the scope given in argument *)
val is_subscope_uid : ScopeName.t -> context -> IdentName.t -> bool
val is_subscope_uid : ScopeName.t -> context -> Ident.t -> bool
(** [is_subscope_uid scope_uid ctxt y] returns true if [y] belongs to the
subscopes of [scope_uid]. *)
@ -131,7 +131,7 @@ val get_params :
val is_def_cond : context -> Ast.ScopeDef.t -> bool
val is_type_cond : Surface.Ast.typ -> bool
val add_def_local_var : context -> IdentName.t -> context * Ast.expr Var.t
val add_def_local_var : context -> Ident.t -> context * Ast.expr Var.t
(** Adds a binding to the context *)
val get_def_key :
@ -143,15 +143,15 @@ val get_def_key :
Ast.ScopeDef.t
(** Usage: [get_def_key var_name var_state scope_uid ctxt pos]*)
val get_enum : context -> IdentName.t Mark.pos -> EnumName.t
val get_enum : context -> Ident.t Mark.pos -> EnumName.t
(** Find an enum definition from the typedefs, failing if there is none or it
has a different kind *)
val get_struct : context -> IdentName.t Mark.pos -> StructName.t
val get_struct : context -> Ident.t Mark.pos -> StructName.t
(** Find a struct definition from the typedefs (possibly an implicit output
struct from a scope), failing if there is none or it has a different kind *)
val get_scope : context -> IdentName.t Mark.pos -> ScopeName.t
val get_scope : context -> Ident.t Mark.pos -> ScopeName.t
(** Find a scope definition from the typedefs, failing if there is none or it
has a different kind *)

12
compiler/driver.ml
View File

@ -31,18 +31,18 @@ let get_scope_uid
| None, _ ->
let _, scope =
try
Shared_ast.IdentName.Map.filter_map
Shared_ast.Ident.Map.filter_map
(fun _ -> function
| Desugared.Name_resolution.TScope (uid, _) -> Some uid
| _ -> None)
ctxt.typedefs
|> Shared_ast.IdentName.Map.choose
|> Shared_ast.Ident.Map.choose
with Not_found ->
Message.raise_error "There isn't any scope inside the program."
in
scope
| Some name, _ -> (
match Shared_ast.IdentName.Map.find_opt name ctxt.typedefs with
match Shared_ast.Ident.Map.find_opt name ctxt.typedefs with
| Some (Desugared.Name_resolution.TScope (uid, _)) -> uid
| _ ->
Message.raise_error
@ -75,7 +75,7 @@ let get_variable_uid
| Some groups -> Re.Group.get groups 1, Some (Re.Group.get groups 2)
in
match
Shared_ast.IdentName.Map.find_opt first_part
Shared_ast.Ident.Map.find_opt first_part
(Shared_ast.ScopeName.Map.find scope_uid ctxt.scopes).var_idmap
with
| None ->
@ -95,7 +95,7 @@ let get_variable_uid
Shared_ast.ScopeName.format_t scope_uid
| Some second_part -> (
match
Shared_ast.IdentName.Map.find_opt second_part
Shared_ast.Ident.Map.find_opt second_part
(Shared_ast.ScopeName.Map.find subscope_name ctxt.scopes).var_idmap
with
| Some (Desugared.Name_resolution.ScopeVar v) ->
@ -117,7 +117,7 @@ let get_variable_uid
(fun second_part ->
let var_sig = Shared_ast.ScopeVar.Map.find v ctxt.var_typs in
match
Shared_ast.IdentName.Map.find_opt second_part
Shared_ast.Ident.Map.find_opt second_part
var_sig.var_sig_states_idmap
with
| Some state -> state

2
compiler/scopelang/from_desugared.ml
View File

@ -84,7 +84,7 @@ let rec translate_expr (ctx : ctx) (e : Desugared.Ast.expr) :
let field =
try
StructName.Map.find name
(IdentName.Map.find field ctx.decl_ctx.ctx_struct_fields)
(Ident.Map.find field ctx.decl_ctx.ctx_struct_fields)
with Not_found ->
(* Should not happen after disambiguation *)
Message.raise_spanned_error (Expr.mark_pos m)

6
compiler/shared_ast/definitions.ml
View File

@ -36,7 +36,7 @@ module LabelName = Uid.Gen ()
(** Used for unresolved structs/maps in desugared *)
module IdentName = String
module Ident = String
(** Only used by desugared/scopelang *)
@ -424,7 +424,7 @@ and ('a, 'b, 'm) base_gexpr =
| EDStructAccess : {
name_opt : StructName.t option;
e : ('a, 'm) gexpr;
field : IdentName.t;
field : Ident.t;
}
-> ('a, < syntacticNames : yes ; .. >, 'm) base_gexpr
(** [desugared] has ambiguous struct fields *)
@ -549,7 +549,7 @@ type scope_out_struct = {
type decl_ctx = {
ctx_enums : enum_ctx;
ctx_structs : struct_ctx;
ctx_struct_fields : StructField.t StructName.Map.t IdentName.Map.t;
ctx_struct_fields : StructField.t StructName.Map.t Ident.Map.t;
(** needed for disambiguation (desugared -> scope) *)
ctx_scopes : scope_out_struct ScopeName.Map.t;
}

4
compiler/shared_ast/expr.ml
View File

@ -573,7 +573,7 @@ and equal : type a. (a, 't) gexpr -> (a, 't) gexpr -> bool =
StructName.equal s1 s2 && StructField.Map.equal equal fields1 fields2
| ( EDStructAccess { e = e1; field = f1; name_opt = s1 },
EDStructAccess { e = e2; field = f2; name_opt = s2 } ) ->
Option.equal StructName.equal s1 s2 && IdentName.equal f1 f2 && equal e1 e2
Option.equal StructName.equal s1 s2 && Ident.equal f1 f2 && equal e1 e2
| ( EStructAccess { e = e1; field = f1; name = s1 },
EStructAccess { e = e2; field = f2; name = s2 } ) ->
StructName.equal s1 s2 && StructField.equal f1 f2 && equal e1 e2
@ -633,7 +633,7 @@ let rec compare : type a. (a, _) gexpr -> (a, _) gexpr -> int =
| EDStructAccess {e=e1; field=field_name1; name_opt=struct_name1},
EDStructAccess {e=e2; field=field_name2; name_opt=struct_name2} ->
compare e1 e2 @@< fun () ->
IdentName.compare field_name1 field_name2 @@< fun () ->
Ident.compare field_name1 field_name2 @@< fun () ->
Option.compare StructName.compare struct_name1 struct_name2
| EStructAccess {e=e1; field=field_name1; name=struct_name1},
EStructAccess {e=e2; field=field_name2; name=struct_name2} ->

2
compiler/shared_ast/expr.mli
View File

@ -110,7 +110,7 @@ val estruct :
val edstructaccess :
('a, 'm) boxed_gexpr ->
IdentName.t ->
Ident.t ->
StructName.t option ->
'm mark ->
((< syntacticNames : yes ; .. > as 'a), 'm) boxed_gexpr

4
compiler/shared_ast/optimizations.ml
View File

@ -344,7 +344,7 @@ let test_iota_reduction_1 () =
{
ctx_enums = EnumName.Map.empty;
ctx_structs = StructName.Map.empty;
ctx_struct_fields = IdentName.Map.empty;
ctx_struct_fields = Ident.Map.empty;
ctx_scopes = ScopeName.Map.empty;
}
(Expr.unbox matchA))))
@ -414,7 +414,7 @@ let test_iota_reduction_2 () =
{
ctx_enums = EnumName.Map.empty;
ctx_structs = StructName.Map.empty;
ctx_struct_fields = IdentName.Map.empty;
ctx_struct_fields = Ident.Map.empty;
ctx_scopes = ScopeName.Map.empty;
}
(Expr.unbox matchA))))

2
compiler/shared_ast/print.ml
View File

@ -608,7 +608,7 @@ let rec expr_aux :
| ELocation loc -> location fmt loc
| EDStructAccess { e; field; _ } ->
Format.fprintf fmt "@[<hv 2>%a%a@,%a%a%a@]" (lhs exprc) e punctuation "."
punctuation "\"" IdentName.format_t field punctuation "\""
punctuation "\"" Ident.format_t field punctuation "\""
| EStruct { name; fields } ->
if StructField.Map.is_empty fields then (
punctuation fmt "{";

2
compiler/shared_ast/typing.ml
View File

@ -458,7 +458,7 @@ and typecheck_expr_top_down :
in
let field =
let candidate_structs =
try A.IdentName.Map.find field ctx.ctx_struct_fields
try A.Ident.Map.find field ctx.ctx_struct_fields
with Not_found ->
Message.raise_spanned_error
(Expr.mark_pos context_mark)