diff options
Diffstat (limited to 'engine')
| -rw-r--r-- | engine/evar_kinds.ml | 1 | ||||
| -rw-r--r-- | engine/evar_kinds.mli | 1 | ||||
| -rw-r--r-- | engine/evd.ml | 5 | ||||
| -rw-r--r-- | engine/evd.mli | 4 | ||||
| -rw-r--r-- | engine/termops.ml | 7 | ||||
| -rw-r--r-- | engine/uState.ml | 14 | ||||
| -rw-r--r-- | engine/uState.mli | 3 | ||||
| -rw-r--r-- | engine/univNames.ml | 8 | ||||
| -rw-r--r-- | engine/univNames.mli | 6 |
9 files changed, 37 insertions, 12 deletions
diff --git a/engine/evar_kinds.ml b/engine/evar_kinds.ml index 71d68f739e..fb41c4491e 100644 --- a/engine/evar_kinds.ml +++ b/engine/evar_kinds.ml @@ -40,6 +40,7 @@ type t = | ImplicitArg of GlobRef.t * (int * Id.t option) * bool (** Force inference *) | BinderType of Name.t + | EvarType of Id.t option * Evar.t (* type of an optionally named evar *) | NamedHole of Id.t (* coming from some ?[id] syntax *) | QuestionMark of question_mark | CasesType of bool (* true = a subterm of the type *) diff --git a/engine/evar_kinds.mli b/engine/evar_kinds.mli index ffc57cfd15..b2b39d49be 100644 --- a/engine/evar_kinds.mli +++ b/engine/evar_kinds.mli @@ -39,6 +39,7 @@ type t = | ImplicitArg of GlobRef.t * (int * Id.t option) * bool (** Force inference *) | BinderType of Name.t + | EvarType of Id.t option * Evar.t (* type of an optionally named evar *) | NamedHole of Id.t (* coming from some ?[id] syntax *) | QuestionMark of question_mark | CasesType of bool (* true = a subterm of the type *) diff --git a/engine/evd.ml b/engine/evd.ml index 498a9d9825..59eea97ce9 100644 --- a/engine/evd.ml +++ b/engine/evd.ml @@ -1231,6 +1231,11 @@ let restrict evk filter ?candidates ?src evd = let evd = declare_future_goal evk' evd in (evd, evk') +let update_source evd evk src = + let evar_info = EvMap.find evk evd.undf_evars in + let evar_info' = { evar_info with evar_source = src } in + { evd with undf_evars = EvMap.add evk evar_info' evd.undf_evars } + (**********************************************************) (* Accessing metas *) diff --git a/engine/evd.mli b/engine/evd.mli index 1c5c65924c..911e00c23a 100644 --- a/engine/evd.mli +++ b/engine/evd.mli @@ -290,6 +290,10 @@ val restrict : Evar.t-> Filter.t -> ?candidates:econstr list -> possibly limiting the instances to a set of candidates (candidates are filtered according to the filter) *) +val update_source : evar_map -> Evar.t -> Evar_kinds.t located -> evar_map +(** To update the source a posteriori, e.g. when an evar type of + another evar has to refer to this other evar, with a mutual dependency *) + val get_aliased_evars : evar_map -> Evar.t Evar.Map.t (** The map of aliased evars *) diff --git a/engine/termops.ml b/engine/termops.ml index 693945d5ac..ccd49ca495 100644 --- a/engine/termops.ml +++ b/engine/termops.ml @@ -123,6 +123,13 @@ let pr_evar_source env sigma = function str "subterm of pattern-matching return predicate" | Evar_kinds.BinderType (Name id) -> str "type of " ++ Id.print id | Evar_kinds.BinderType Anonymous -> str "type of anonymous binder" + | Evar_kinds.EvarType (ido,evk) -> + let pp = match ido with + | Some id -> str "?" ++ Id.print id + | None -> + try pr_existential_key sigma evk + with (* defined *) Not_found -> str "an internal placeholder" in + str "type of " ++ pp | Evar_kinds.ImplicitArg (c,(n,ido),b) -> let open Globnames in let print_constr = print_kconstr in diff --git a/engine/uState.ml b/engine/uState.ml index 103b552d86..0c994dfea0 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -341,12 +341,16 @@ let constrain_variables diff uctx = in { uctx with local = (univs, local); univ_variables = vars } -let qualid_of_level uctx = +let id_of_level uctx l = + try Some (Option.get (LMap.find l (snd uctx.names)).uname) + with Not_found | Option.IsNone -> + None + +let qualid_of_level uctx l = let map, map_rev = uctx.names in - fun l -> - try Some (Libnames.qualid_of_ident (Option.get (LMap.find l map_rev).uname)) - with Not_found | Option.IsNone -> - UnivNames.qualid_of_level l + try Some (Libnames.qualid_of_ident (Option.get (LMap.find l map_rev).uname)) + with Not_found | Option.IsNone -> + UnivNames.qualid_of_level map l let pr_uctx_level uctx l = match qualid_of_level uctx l with diff --git a/engine/uState.mli b/engine/uState.mli index bd3aac0d8b..442c29180c 100644 --- a/engine/uState.mli +++ b/engine/uState.mli @@ -209,4 +209,7 @@ val update_sigma_univs : t -> UGraph.t -> t val pr_uctx_level : t -> Univ.Level.t -> Pp.t val qualid_of_level : t -> Univ.Level.t -> Libnames.qualid option +(** Only looks in the local names, not in the nametab. *) +val id_of_level : t -> Univ.Level.t -> Id.t option + val pr_weak : (Univ.Level.t -> Pp.t) -> t -> Pp.t diff --git a/engine/univNames.ml b/engine/univNames.ml index 2e15558db2..f5542cc0f7 100644 --- a/engine/univNames.ml +++ b/engine/univNames.ml @@ -12,15 +12,15 @@ open Names open Univ -let qualid_of_level l = +let qualid_of_level ctx l = match Level.name l with | Some qid -> - (try Some (Nametab.shortest_qualid_of_universe qid) + (try Some (Nametab.shortest_qualid_of_universe (Id.Map.domain ctx) qid) with Not_found -> None) | None -> None -let pr_with_global_universes l = - match qualid_of_level l with +let pr_with_global_universes ctx l = + match qualid_of_level ctx l with | Some qid -> Libnames.pr_qualid qid | None -> Level.pr l diff --git a/engine/univNames.mli b/engine/univNames.mli index 5f69d199b3..875c043032 100644 --- a/engine/univNames.mli +++ b/engine/univNames.mli @@ -10,9 +10,6 @@ open Univ -val pr_with_global_universes : Level.t -> Pp.t -val qualid_of_level : Level.t -> Libnames.qualid option - (** Local universe name <-> level mapping *) type universe_binders = Univ.Level.t Names.Id.Map.t @@ -20,3 +17,6 @@ type universe_binders = Univ.Level.t Names.Id.Map.t val empty_binders : universe_binders type univ_name_list = Names.lname list + +val pr_with_global_universes : universe_binders -> Level.t -> Pp.t +val qualid_of_level : universe_binders -> Level.t -> Libnames.qualid option |