diff options
| author | Pierre-Marie Pédrot | 2018-10-17 15:29:47 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2018-10-17 15:29:47 +0200 |
| commit | 15998894ff76b1fa9354085ea0bddae4f8f23ddf (patch) | |
| tree | 254cc3a53b6aa344f49a10cba32e14acf97d2905 /pretyping | |
| parent | 063cf49f40511730c8c60c45332e92823ce4c78f (diff) | |
| parent | 6aa0aa37e19457a8c0c3ad36f7bbead058442344 (diff) | |
Merge PR #8694: Various cleanups of universe apis
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/evarsolve.ml | 2 | ||||
| -rw-r--r-- | pretyping/pretyping.ml | 33 | ||||
| -rw-r--r-- | pretyping/typeclasses.ml | 2 |
3 files changed, 15 insertions, 22 deletions
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index 62d719034c..22f438c00c 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -457,7 +457,7 @@ let free_vars_and_rels_up_alias_expansion env sigma aliases c = | Rel n -> if n >= depth+1 then acc1 := Int.Set.add (n-depth) !acc1 | _ -> frec (aliases,depth) c end | Const _ | Ind _ | Construct _ -> - acc2 := Id.Set.union (vars_of_global env (EConstr.to_constr sigma c)) !acc2 + acc2 := Id.Set.union (vars_of_global env (fst @@ EConstr.destRef sigma c)) !acc2 | _ -> iter_with_full_binders sigma (fun d (aliases,depth) -> (extend_alias sigma d aliases,depth+1)) diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 495f5c0660..f2881e4a19 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -405,32 +405,25 @@ let interp_glob_level ?loc evd : glob_level -> _ = function | GSet -> evd, Univ.Level.set | GType s -> interp_level_info ?loc evd s -let interp_instance ?loc evd ~len l = - if len != List.length l then +let interp_instance ?loc evd l = + let evd, l' = + List.fold_left + (fun (evd, univs) l -> + let evd, l = interp_glob_level ?loc evd l in + (evd, l :: univs)) (evd, []) + l + in + if List.exists (fun l -> Univ.Level.is_prop l) l' then user_err ?loc ~hdr:"pretype" - (str "Universe instance should have length " ++ int len) - else - let evd, l' = - List.fold_left - (fun (evd, univs) l -> - let evd, l = interp_glob_level ?loc evd l in - (evd, l :: univs)) (evd, []) - l - in - if List.exists (fun l -> Univ.Level.is_prop l) l' then - user_err ?loc ~hdr:"pretype" - (str "Universe instances cannot contain Prop, polymorphic" ++ - str " universe instances must be greater or equal to Set."); - evd, Some (Univ.Instance.of_array (Array.of_list (List.rev l'))) + (str "Universe instances cannot contain Prop, polymorphic" ++ + str " universe instances must be greater or equal to Set."); + evd, Some (Univ.Instance.of_array (Array.of_list (List.rev l'))) let pretype_global ?loc rigid env evd gr us = let evd, instance = match us with | None -> evd, None - | Some l -> - let _, ctx = Global.constr_of_global_in_context !!env gr in - let len = Univ.AUContext.size ctx in - interp_instance ?loc evd ~len l + | Some l -> interp_instance ?loc evd l in Evd.fresh_global ?loc ~rigid ?names:instance !!env evd gr diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index 7e5815acd1..ce12aaeeb0 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -320,7 +320,7 @@ let build_subclasses ~check env sigma glob { hint_priority = pri } = hints @ (path', info, body) :: rest in List.fold_left declare_proj [] projs in - let term = UnivGen.constr_of_global_univ (glob, inst) in + let term = Constr.mkRef (glob, inst) in (*FIXME subclasses should now get substituted for each particular instance of the polymorphic superclass *) aux pri term ty [glob] |
