aboutsummaryrefslogtreecommitdiff
path: root/plugins/ltac
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/ltac')
-rw-r--r--plugins/ltac/extratactics.ml434
-rw-r--r--plugins/ltac/rewrite.ml7
2 files changed, 10 insertions, 31 deletions
diff --git a/plugins/ltac/extratactics.ml4 b/plugins/ltac/extratactics.ml4
index d6cfa3cf9a..982fc7cc3c 100644
--- a/plugins/ltac/extratactics.ml4
+++ b/plugins/ltac/extratactics.ml4
@@ -313,10 +313,10 @@ let project_hint pri l2r r =
let id =
Nameops.add_suffix (Nametab.basename_of_global gr) ("_proj_" ^ (if l2r then "l2r" else "r2l"))
in
- let ctx = Evd.universe_context_set sigma in
- let c = EConstr.to_constr sigma c in
let poly = Flags.use_polymorphic_flag () in
- let c = Declare.declare_definition ~poly ~internal:Declare.InternalTacticRequest id (c,ctx) in
+ let ctx = Evd.const_univ_entry ~poly sigma in
+ let c = EConstr.to_constr sigma c in
+ let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in
let info = {Vernacexpr.hint_priority = pri; hint_pattern = None} in
(info,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c))
@@ -873,34 +873,12 @@ TACTIC EXTEND is_evar
]
END
-let has_evar sigma c =
-let rec has_evar x =
- match EConstr.kind sigma x with
- | Evar _ -> true
- | Rel _ | Var _ | Meta _ | Sort _ | Const _ | Ind _ | Construct _ ->
- false
- | Cast (t1, _, t2) | Prod (_, t1, t2) | Lambda (_, t1, t2) ->
- has_evar t1 || has_evar t2
- | LetIn (_, t1, t2, t3) ->
- has_evar t1 || has_evar t2 || has_evar t3
- | App (t1, ts) ->
- has_evar t1 || has_evar_array ts
- | Case (_, t1, t2, ts) ->
- has_evar t1 || has_evar t2 || has_evar_array ts
- | Fix ((_, tr)) | CoFix ((_, tr)) ->
- has_evar_prec tr
- | Proj (p, c) -> has_evar c
-and has_evar_array x =
- Array.exists has_evar x
-and has_evar_prec (_, ts1, ts2) =
- Array.exists has_evar ts1 || Array.exists has_evar ts2
-in
-has_evar c
-
TACTIC EXTEND has_evar
| [ "has_evar" constr(x) ] -> [
Proofview.tclEVARMAP >>= fun sigma ->
- if has_evar sigma x then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (str "No evars")
+ if Evarutil.has_undefined_evars sigma x
+ then Proofview.tclUNIT ()
+ else Tacticals.New.tclFAIL 0 (str "No evars")
]
END
diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml
index 14b0742a76..c0060c5a7c 100644
--- a/plugins/ltac/rewrite.ml
+++ b/plugins/ltac/rewrite.ml
@@ -1884,11 +1884,11 @@ let declare_projection n instance_id r =
in it_mkProd_or_LetIn ccl ctx
in
let typ = it_mkProd_or_LetIn typ ctx in
- let pl, ctx = Evd.universe_context ~names:[] ~extensible:true sigma in
+ let univs = Evd.const_univ_entry ~poly sigma in
let typ = EConstr.to_constr sigma typ in
let term = EConstr.to_constr sigma term in
let cst =
- Declare.definition_entry ~types:typ ~poly ~univs:ctx term
+ Declare.definition_entry ~types:typ ~univs term
in
ignore(Declare.declare_constant n
(Entries.DefinitionEntry cst, Decl_kinds.IsDefinition Decl_kinds.Definition))
@@ -1972,9 +1972,10 @@ let add_morphism_infer glob m n =
let evd = Evd.from_env env in
let uctx, instance = build_morphism_signature env evd m in
if Lib.is_modtype () then
+ let uctx = UState.const_univ_entry ~poly uctx in
let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest instance_id
(Entries.ParameterEntry
- (None,poly,(instance,UState.context uctx),None),
+ (None,(instance,uctx),None),
Decl_kinds.IsAssumption Decl_kinds.Logical)
in
add_instance (Typeclasses.new_instance