diff options
| author | Gaƫtan Gilbert | 2019-06-21 13:55:03 +0200 |
|---|---|---|
| committer | Emilio Jesus Gallego Arias | 2019-06-24 20:55:38 +0200 |
| commit | 5f190f9e12f42a0ff6b5275c8087852a87aff47b (patch) | |
| tree | 0b49ff38501f8bd75f36fcae6d83b4f4e626f0d8 /library | |
| parent | 6bed5c130c6368885967d1fdfd609bc72d708a7d (diff) | |
Use named records instead of tuples where `polymorphic` used to be.
Followup on "[api] Remove `polymorphic` type alias, use labels instead."
Diffstat (limited to 'library')
| -rw-r--r-- | library/decls.ml | 19 | ||||
| -rw-r--r-- | library/decls.mli | 9 | ||||
| -rw-r--r-- | library/lib.ml | 26 |
3 files changed, 34 insertions, 20 deletions
diff --git a/library/decls.ml b/library/decls.ml index 104eb37011..5cb35323dd 100644 --- a/library/decls.ml +++ b/library/decls.ml @@ -17,19 +17,24 @@ open Libnames (** Datas associated to section variables and local definitions *) -type variable_data = - DirPath.t * bool (* opacity *) * Univ.ContextSet.t * bool (* poly *) * logical_kind +type variable_data = { + path:DirPath.t; + opaque:bool; + univs:Univ.ContextSet.t; + poly:bool; + kind:logical_kind; +} let vartab = Summary.ref (Id.Map.empty : variable_data Id.Map.t) ~name:"VARIABLE" let add_variable_data id o = vartab := Id.Map.add id o !vartab -let variable_path id = let (p,_,_,_,_) = Id.Map.find id !vartab in p -let variable_opacity id = let (_,opaq,_,_,_) = Id.Map.find id !vartab in opaq -let variable_kind id = let (_,_,_,_,k) = Id.Map.find id !vartab in k -let variable_context id = let (_,_,ctx,_,_) = Id.Map.find id !vartab in ctx -let variable_polymorphic id = let (_,_,_,p,_) = Id.Map.find id !vartab in p +let variable_path id = let {path} = Id.Map.find id !vartab in path +let variable_opacity id = let {opaque} = Id.Map.find id !vartab in opaque +let variable_kind id = let {kind} = Id.Map.find id !vartab in kind +let variable_context id = let {univs} = Id.Map.find id !vartab in univs +let variable_polymorphic id = let {poly} = Id.Map.find id !vartab in poly let variable_secpath id = let dir = drop_dirpath_prefix (Lib.library_dp()) (variable_path id) in diff --git a/library/decls.mli b/library/decls.mli index 93298c0bc4..f88958bb04 100644 --- a/library/decls.mli +++ b/library/decls.mli @@ -18,8 +18,13 @@ open Decl_kinds (** Registration and access to the table of variable *) -type variable_data = - DirPath.t * bool (* opacity *) * Univ.ContextSet.t * bool (* poly *) * logical_kind +type variable_data = { + path:DirPath.t; + opaque:bool; + univs:Univ.ContextSet.t; + poly:bool; + kind:logical_kind; +} val add_variable_data : variable -> variable_data -> unit val variable_path : variable -> DirPath.t diff --git a/library/lib.ml b/library/lib.ml index e4054d58cc..3eb74808e4 100644 --- a/library/lib.ml +++ b/library/lib.ml @@ -411,8 +411,12 @@ type abstr_info = { type abstr_list = abstr_info Names.Cmap.t * abstr_info Names.Mindmap.t type secentry = - | Variable of (Names.Id.t * Decl_kinds.binding_kind * bool * Univ.ContextSet.t) - (** (name, kind, poly, univs) *) + | Variable of { + id:Names.Id.t; + kind:Decl_kinds.binding_kind; + poly:bool; + univs:Univ.ContextSet.t; + } | Context of Univ.ContextSet.t let sectab = @@ -424,16 +428,16 @@ let add_section () = (Names.Cmap.empty,Names.Mindmap.empty)) :: !sectab let check_same_poly p vars = - let pred = function Context _ -> p = false | Variable (_, _, poly, _) -> p != poly in + let pred = function Context _ -> p = false | Variable {poly} -> p != poly in if List.exists pred vars then user_err Pp.(str "Cannot mix universe polymorphic and monomorphic declarations in sections.") -let add_section_variable ~name ~kind ~poly ctx = +let add_section_variable ~name ~kind ~poly univs = match !sectab with | [] -> () (* because (Co-)Fixpoint temporarily uses local vars *) | (vars,repl,abs)::sl -> List.iter (fun tab -> check_same_poly poly (pi1 tab)) !sectab; - sectab := (Variable (name,kind,poly,ctx)::vars,repl,abs)::sl + sectab := (Variable {id=name;kind;poly;univs}::vars,repl,abs)::sl let add_section_context ctx = match !sectab with @@ -448,7 +452,7 @@ let is_polymorphic_univ u = let open Univ in List.iter (fun (vars,_,_) -> List.iter (function - | Variable (_,_,poly,(univs,_)) -> + | Variable {poly;univs=(univs,_)} -> if LSet.mem u univs then raise (PolyFound poly) | Context (univs,_) -> if LSet.mem u univs then raise (PolyFound true) @@ -459,12 +463,12 @@ let is_polymorphic_univ u = let extract_hyps (secs,ohyps) = let rec aux = function - | (Variable (id,impl,poly,ctx)::idl, decl::hyps) when Names.Id.equal id (NamedDecl.get_id decl) -> + | (Variable {id;kind;poly;univs}::idl, decl::hyps) when Names.Id.equal id (NamedDecl.get_id decl) -> let l, r = aux (idl,hyps) in - (decl,impl) :: l, if poly then Univ.ContextSet.union r ctx else r - | (Variable (_,_,poly,ctx)::idl,hyps) -> + (decl,kind) :: l, if poly then Univ.ContextSet.union r univs else r + | (Variable {poly;univs}::idl,hyps) -> let l, r = aux (idl,hyps) in - l, if poly then Univ.ContextSet.union r ctx else r + l, if poly then Univ.ContextSet.union r univs else r | (Context ctx :: idl, hyps) -> let l, r = aux (idl, hyps) in l, Univ.ContextSet.union r ctx @@ -543,7 +547,7 @@ let variable_section_segment_of_reference gr = let section_instance = function | VarRef id -> let eq = function - | Variable (id',_,_,_) -> Names.Id.equal id id' + | Variable {id=id'} -> Names.Id.equal id id' | Context _ -> false in if List.exists eq (pi1 (List.hd !sectab)) |
