aboutsummaryrefslogtreecommitdiff
path: root/vernac
diff options
context:
space:
mode:
Diffstat (limited to 'vernac')
-rw-r--r--vernac/auto_ind_decl.ml28
-rw-r--r--vernac/classes.ml4
-rw-r--r--vernac/comAssumption.ml2
-rw-r--r--vernac/comAssumption.mli2
-rw-r--r--vernac/comDefinition.ml4
-rw-r--r--vernac/comFixpoint.ml4
-rw-r--r--vernac/comInductive.ml73
-rw-r--r--vernac/comInductive.mli4
-rw-r--r--vernac/comProgramFixpoint.ml6
-rw-r--r--vernac/declareDef.mli4
-rw-r--r--vernac/explainErr.ml2
-rw-r--r--vernac/himsg.ml8
-rw-r--r--vernac/indschemes.ml2
-rw-r--r--vernac/lemmas.ml4
-rw-r--r--vernac/mltop.ml9
-rw-r--r--vernac/mltop.mli3
-rw-r--r--vernac/obligations.ml16
-rw-r--r--vernac/record.ml10
-rw-r--r--vernac/record.mli2
-rw-r--r--vernac/vernacentries.ml10
20 files changed, 123 insertions, 74 deletions
diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index 5e602289ba..3de7fe06bd 100644
--- a/vernac/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -59,15 +59,15 @@ exception NonSingletonProp of inductive
exception DecidabilityMutualNotSupported
exception NoDecidabilityCoInductive
-let constr_of_global g = lazy (Universes.constr_of_global g)
+let constr_of_global g = lazy (UnivGen.constr_of_global g)
(* Some pre declaration of constant we are going to use *)
let bb = constr_of_global Coqlib.glob_bool
-let andb_prop = fun _ -> Universes.constr_of_global (Coqlib.build_bool_type()).Coqlib.andb_prop
+let andb_prop = fun _ -> UnivGen.constr_of_global (Coqlib.build_bool_type()).Coqlib.andb_prop
let andb_true_intro = fun _ ->
- Universes.constr_of_global
+ UnivGen.constr_of_global
(Coqlib.build_bool_type()).Coqlib.andb_true_intro
let tt = constr_of_global Coqlib.glob_true
@@ -76,9 +76,9 @@ let ff = constr_of_global Coqlib.glob_false
let eq = constr_of_global Coqlib.glob_eq
-let sumbool () = Universes.constr_of_global (Coqlib.build_coq_sumbool ())
+let sumbool () = UnivGen.constr_of_global (Coqlib.build_coq_sumbool ())
-let andb = fun _ -> Universes.constr_of_global (Coqlib.build_bool_type()).Coqlib.andb
+let andb = fun _ -> UnivGen.constr_of_global (Coqlib.build_bool_type()).Coqlib.andb
let induct_on c = induction false None c None None
@@ -400,9 +400,9 @@ let do_replace_lb mode lb_scheme_key aavoid narg p q =
lb_type_of_p >>= fun (lb_type_of_p,eff) ->
Proofview.tclEVARMAP >>= fun sigma ->
let lb_args = Array.append (Array.append
- (Array.map (fun x -> x) v)
- (Array.map (fun x -> do_arg sigma x 1) v))
- (Array.map (fun x -> do_arg sigma x 2) v)
+ v
+ (Array.Smart.map (fun x -> do_arg sigma x 1) v))
+ (Array.Smart.map (fun x -> do_arg sigma x 2) v)
in let app = if Array.is_empty lb_args
then lb_type_of_p else mkApp (lb_type_of_p,lb_args)
in
@@ -471,9 +471,9 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
user_err err_msg
in let bl_args =
Array.append (Array.append
- (Array.map (fun x -> x) v)
- (Array.map (fun x -> do_arg sigma x 1) v))
- (Array.map (fun x -> do_arg sigma x 2) v )
+ v
+ (Array.Smart.map (fun x -> do_arg sigma x 1) v))
+ (Array.Smart.map (fun x -> do_arg sigma x 2) v )
in
let app = if Array.is_empty bl_args
then bl_t1 else mkApp (bl_t1,bl_args)
@@ -863,7 +863,7 @@ let compute_dec_goal ind lnamesparrec nparrec =
create_input (
mkNamedProd n (mkFullInd ind (2*nparrec)) (
mkNamedProd m (mkFullInd ind (2*nparrec+1)) (
- mkApp(sumbool(),[|eqnm;mkApp (Universes.constr_of_global @@ Coqlib.build_coq_not(),[|eqnm|])|])
+ mkApp(sumbool(),[|eqnm;mkApp (UnivGen.constr_of_global @@ Coqlib.build_coq_not(),[|eqnm|])|])
)
)
)
@@ -923,7 +923,7 @@ let compute_dec_tact ind lnamesparrec nparrec =
(* left *)
Tacticals.New.tclTHENLIST [
simplest_left;
- apply (EConstr.of_constr (mkApp(blI,Array.map(fun x->mkVar x) xargs)));
+ apply (EConstr.of_constr (mkApp(blI,Array.map mkVar xargs)));
Auto.default_auto
]
;
@@ -939,7 +939,7 @@ let compute_dec_tact ind lnamesparrec nparrec =
assert_by (Name freshH3)
(EConstr.of_constr (mkApp(eq,[|bb;mkApp(eqI,[|mkVar freshm;mkVar freshm|]);tt|])))
(Tacticals.New.tclTHENLIST [
- apply (EConstr.of_constr (mkApp(lbI,Array.map (fun x->mkVar x) xargs)));
+ apply (EConstr.of_constr (mkApp(lbI,Array.map mkVar xargs)));
Auto.default_auto
]);
Equality.general_rewrite_bindings_in true
diff --git a/vernac/classes.ml b/vernac/classes.ml
index 1ac597695f..61ce5d6c4c 100644
--- a/vernac/classes.ml
+++ b/vernac/classes.ml
@@ -423,13 +423,13 @@ let context poly l =
let decl = (Discharge, poly, Definitional) in
let nstatus = match b with
| None ->
- pi3 (ComAssumption.declare_assumption false decl (t, univs) Universes.empty_binders [] impl
+ pi3 (ComAssumption.declare_assumption false decl (t, univs) UnivNames.empty_binders [] impl
Declaremods.NoInline (CAst.make id))
| Some b ->
let decl = (Discharge, poly, Definition) in
let entry = Declare.definition_entry ~univs ~types:t b in
let hook = Lemmas.mk_hook (fun _ gr -> gr) in
- let _ = DeclareDef.declare_definition id decl entry Universes.empty_binders [] hook in
+ let _ = DeclareDef.declare_definition id decl entry UnivNames.empty_binders [] hook in
Lib.sections_are_opened () || Lib.is_modtype_strict ()
in
status && nstatus
diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml
index 26a46a752e..722f21171f 100644
--- a/vernac/comAssumption.ml
+++ b/vernac/comAssumption.ml
@@ -174,7 +174,7 @@ let do_assumptions kind nl l =
let t = replace_vars subst t in
let refs, status' = declare_assumptions idl is_coe kind (t,uctx) ubinders imps nl in
let subst' = List.map2
- (fun {CAst.v=id} (c,u) -> (id, Universes.constr_of_global_univ (c,u)))
+ (fun {CAst.v=id} (c,u) -> (id, UnivGen.constr_of_global_univ (c,u)))
idl refs
in
subst'@subst, status' && status, next_uctx uctx)
diff --git a/vernac/comAssumption.mli b/vernac/comAssumption.mli
index 2f2c7c4e28..56932360a9 100644
--- a/vernac/comAssumption.mli
+++ b/vernac/comAssumption.mli
@@ -30,6 +30,6 @@ val do_assumptions : locality * polymorphic * assumption_object_kind ->
nor in a module type and meant to be instantiated. *)
val declare_assumption : coercion_flag -> assumption_kind ->
types in_constant_universes_entry ->
- Universes.universe_binders -> Impargs.manual_implicits ->
+ UnivNames.universe_binders -> Impargs.manual_implicits ->
bool (** implicit *) -> Declaremods.inline -> variable CAst.t ->
GlobRef.t * Univ.Instance.t * bool
diff --git a/vernac/comDefinition.ml b/vernac/comDefinition.ml
index 9aa61ab460..863adb0d14 100644
--- a/vernac/comDefinition.ml
+++ b/vernac/comDefinition.ml
@@ -90,7 +90,7 @@ let interp_definition pl bl poly red_option c ctypopt =
Note: in program mode some evars may remain. *)
let ctx = List.map Termops.(map_rel_decl (to_constr ~abort_on_undefined_evars:false evd)) ctx in
let c = Term.it_mkLambda_or_LetIn (EConstr.to_constr ~abort_on_undefined_evars:false evd c) ctx in
- let tyopt = Option.map (fun ty -> Term.it_mkProd_or_LetIn (EConstr.to_constr evd ty) ctx) tyopt in
+ let tyopt = Option.map (fun ty -> Term.it_mkProd_or_LetIn (EConstr.to_constr ~abort_on_undefined_evars:false evd ty) ctx) tyopt in
(* Keep only useful universes. *)
let uvars_fold uvars c =
Univ.LSet.union uvars (universes_of_constr env evd (of_constr c))
@@ -118,7 +118,7 @@ let do_definition ~program_mode ident k univdecl bl red_option c ctypopt hook =
assert(Univ.ContextSet.is_empty ctx);
let typ = match ce.const_entry_type with
| Some t -> t
- | None -> EConstr.to_constr evd (Retyping.get_type_of env evd (EConstr.of_constr c))
+ | None -> EConstr.to_constr ~abort_on_undefined_evars:false evd (Retyping.get_type_of env evd (EConstr.of_constr c))
in
Obligations.check_evars env evd;
let obls, _, c, cty =
diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
index 7b382dacc3..85c0699ea9 100644
--- a/vernac/comFixpoint.ml
+++ b/vernac/comFixpoint.ml
@@ -199,9 +199,7 @@ let interp_recursive ~program_mode ~cofix fixl notations =
try
let sigma, h_term = fix_proto sigma in
let app = mkApp (h_term, [|sort; t|]) in
- let _evd = ref sigma in
- let res = Typing.e_solve_evars env _evd app in
- !_evd, res
+ Typing.solve_evars env sigma app
with e when CErrors.noncritical e -> sigma, t
in
sigma, LocalAssum (id,fixprot) :: env'
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
index 101298ef4d..629fcce5a7 100644
--- a/vernac/comInductive.ml
+++ b/vernac/comInductive.ml
@@ -29,7 +29,6 @@ open Indtypes
open Pretyping
open Evarutil
open Indschemes
-open Misctypes
open Context.Rel.Declaration
open Entries
@@ -178,6 +177,72 @@ let is_flexible_sort evd u =
| Some l -> Evd.is_flexible_level evd l
| None -> false
+(**********************************************************************)
+(* Tools for template polymorphic inductive types *)
+
+(* Miscellaneous functions to remove or test local univ assumed to
+ occur only in the le constraints *)
+
+(*
+ Solve a system of universe constraint of the form
+
+ u_s11, ..., u_s1p1, w1 <= u1
+ ...
+ u_sn1, ..., u_snpn, wn <= un
+
+where
+
+ - the ui (1 <= i <= n) are universe variables,
+ - the sjk select subsets of the ui for each equations,
+ - the wi are arbitrary complex universes that do not mention the ui.
+*)
+
+let is_direct_sort_constraint s v = match s with
+ | Some u -> Univ.univ_level_mem u v
+ | None -> false
+
+let solve_constraints_system levels level_bounds =
+ let open Univ in
+ let levels =
+ Array.mapi (fun i o ->
+ match o with
+ | Some u ->
+ (match Universe.level u with
+ | Some u -> Some u
+ | _ -> level_bounds.(i) <- Universe.sup level_bounds.(i) u; None)
+ | None -> None)
+ levels in
+ let v = Array.copy level_bounds in
+ let nind = Array.length v in
+ let clos = Array.map (fun _ -> Int.Set.empty) levels in
+ (* First compute the transitive closure of the levels dependencies *)
+ for i=0 to nind-1 do
+ for j=0 to nind-1 do
+ if not (Int.equal i j) && is_direct_sort_constraint levels.(j) v.(i) then
+ clos.(i) <- Int.Set.add j clos.(i);
+ done;
+ done;
+ let rec closure () =
+ let continue = ref false in
+ Array.iteri (fun i deps ->
+ let deps' =
+ Int.Set.fold (fun j acc -> Int.Set.union acc clos.(j)) deps deps
+ in
+ if Int.Set.equal deps deps' then ()
+ else (clos.(i) <- deps'; continue := true))
+ clos;
+ if !continue then closure ()
+ else ()
+ in
+ closure ();
+ for i=0 to nind-1 do
+ for j=0 to nind-1 do
+ if not (Int.equal i j) && Int.Set.mem j clos.(i) then
+ (v.(i) <- Universe.sup v.(i) level_bounds.(j));
+ done;
+ done;
+ v
+
let inductive_levels env evd poly arities inds =
let destarities = List.map (fun x -> x, Reduction.dest_arity env x) arities in
let levels = List.map (fun (x,(ctx,a)) ->
@@ -206,8 +271,8 @@ let inductive_levels env evd poly arities inds =
in
(* Take the transitive closure of the system of constructors *)
(* level constraints and remove the recursive dependencies *)
- let levels' = Universes.solve_constraints_system (Array.of_list levels)
- (Array.of_list cstrs_levels) (Array.of_list min_levels)
+ let levels' = solve_constraints_system (Array.of_list levels)
+ (Array.of_list cstrs_levels)
in
let evd, arities =
CList.fold_left3 (fun (evd, arities) cu (arity,(ctx,du)) len ->
@@ -380,7 +445,7 @@ let extract_params indl =
let extract_inductive indl =
List.map (fun (({CAst.v=indname},pl),_,ar,lc) -> {
ind_name = indname; ind_univs = pl;
- ind_arity = Option.cata (fun x -> x) (CAst.make @@ CSort (GType [])) ar;
+ ind_arity = Option.cata (fun x -> x) (CAst.make @@ CSort (Glob_term.GType [])) ar;
ind_lc = List.map (fun (_,({CAst.v=id},t)) -> (id,t)) lc
}) indl
diff --git a/vernac/comInductive.mli b/vernac/comInductive.mli
index 8339357246..7ae8e8f716 100644
--- a/vernac/comInductive.mli
+++ b/vernac/comInductive.mli
@@ -37,7 +37,7 @@ type one_inductive_impls =
Impargs.manual_implicits list (** for constrs *)
val declare_mutual_inductive_with_eliminations :
- mutual_inductive_entry -> Universes.universe_binders -> one_inductive_impls list ->
+ mutual_inductive_entry -> UnivNames.universe_binders -> one_inductive_impls list ->
MutInd.t
(** Exported for Funind *)
@@ -64,4 +64,4 @@ val extract_mutual_inductive_declaration_components :
val interp_mutual_inductive :
structured_inductive_expr -> decl_notation list -> cumulative_inductive_flag ->
polymorphic -> private_flag -> Declarations.recursivity_kind ->
- mutual_inductive_entry * Universes.universe_binders * one_inductive_impls list
+ mutual_inductive_entry * UnivNames.universe_binders * one_inductive_impls list
diff --git a/vernac/comProgramFixpoint.ml b/vernac/comProgramFixpoint.ml
index 745f1df1d8..f41e0fc443 100644
--- a/vernac/comProgramFixpoint.ml
+++ b/vernac/comProgramFixpoint.ml
@@ -190,9 +190,7 @@ let build_wellfounded (recname,pl,n,bl,arityc,body) poly r measure notation =
~src:(Loc.tag @@ Evar_kinds.QuestionMark (Evar_kinds.Define false,Anonymous)) wf_proof in
sigma, mkApp (h_a_term, [| argtyp ; wf_rel ; h_e_term; prop |])
in
- let _evd = ref sigma in
- let def = Typing.e_solve_evars env _evd def in
- let sigma = !_evd in
+ let sigma, def = Typing.solve_evars env sigma def in
let sigma = Evarutil.nf_evar_map sigma in
let def = mkApp (def, [|intern_body_lam|]) in
let binders_rel = nf_evar_context sigma binders_rel in
@@ -214,7 +212,7 @@ let build_wellfounded (recname,pl,n,bl,arityc,body) poly r measure notation =
(** FIXME: include locality *)
let c = Declare.declare_constant recname (DefinitionEntry ce, IsDefinition Definition) in
let gr = ConstRef c in
- let () = Universes.register_universe_binders gr (Evd.universe_binders sigma) in
+ let () = UnivNames.register_universe_binders gr (Evd.universe_binders sigma) in
if Impargs.is_implicit_args () || not (List.is_empty impls) then
Impargs.declare_manual_implicits false gr [impls]
in
diff --git a/vernac/declareDef.mli b/vernac/declareDef.mli
index 12973f51be..c5e704a5e9 100644
--- a/vernac/declareDef.mli
+++ b/vernac/declareDef.mli
@@ -14,11 +14,11 @@ open Decl_kinds
val get_locality : Id.t -> kind:string -> Decl_kinds.locality -> bool
val declare_definition : Id.t -> definition_kind ->
- Safe_typing.private_constants Entries.definition_entry -> Universes.universe_binders -> Impargs.manual_implicits ->
+ Safe_typing.private_constants Entries.definition_entry -> UnivNames.universe_binders -> Impargs.manual_implicits ->
GlobRef.t Lemmas.declaration_hook -> GlobRef.t
val declare_fix : ?opaque:bool -> definition_kind ->
- Universes.universe_binders -> Entries.constant_universes_entry ->
+ UnivNames.universe_binders -> Entries.constant_universes_entry ->
Id.t -> Safe_typing.private_constants Entries.proof_output ->
Constr.types -> Impargs.manual_implicits ->
GlobRef.t
diff --git a/vernac/explainErr.ml b/vernac/explainErr.ml
index f9167f9691..f68dcae268 100644
--- a/vernac/explainErr.ml
+++ b/vernac/explainErr.ml
@@ -55,7 +55,7 @@ let process_vernac_interp_error exn = match fst exn with
let msg =
if !Constrextern.print_universes then
str "." ++ spc() ++
- Univ.explain_universe_inconsistency Universes.pr_with_global_universes i
+ Univ.explain_universe_inconsistency UnivNames.pr_with_global_universes i
else
mt() in
wrap_vernac_error exn (str "Universe inconsistency" ++ msg ++ str ".")
diff --git a/vernac/himsg.ml b/vernac/himsg.ml
index acb461cacd..1add1f4860 100644
--- a/vernac/himsg.ml
+++ b/vernac/himsg.ml
@@ -86,7 +86,7 @@ let j_nf_betaiotaevar env sigma j =
uj_type = Reductionops.nf_betaiota env sigma j.uj_type }
let jv_nf_betaiotaevar env sigma jl =
- Array.map (fun j -> j_nf_betaiotaevar env sigma j) jl
+ Array.Smart.map (fun j -> j_nf_betaiotaevar env sigma j) jl
(** Printers *)
@@ -197,7 +197,7 @@ let rec pr_disjunction pr = function
let pr_puniverses f env (c,u) =
f env c ++
(if Flags.is_universe_polymorphism () && not (Univ.Instance.is_empty u) then
- str"(*" ++ Univ.Instance.pr Universes.pr_with_global_universes u ++ str"*)"
+ str"(*" ++ Univ.Instance.pr UnivNames.pr_with_global_universes u ++ str"*)"
else mt())
let explain_elim_arity env sigma ind sorts c pj okinds =
@@ -314,7 +314,7 @@ let explain_unification_error env sigma p1 p2 = function
| UnifUnivInconsistency p ->
if !Constrextern.print_universes then
[str "universe inconsistency: " ++
- Univ.explain_universe_inconsistency Universes.pr_with_global_universes p]
+ Univ.explain_universe_inconsistency UnivNames.pr_with_global_universes p]
else
[str "universe inconsistency"]
| CannotSolveConstraint ((pb,env,t,u),e) ->
@@ -886,7 +886,7 @@ let explain_not_match_error = function
str"polymorphic universe instances do not match"
| IncompatibleUniverses incon ->
str"the universe constraints are inconsistent: " ++
- Univ.explain_universe_inconsistency Universes.pr_with_global_universes incon
+ Univ.explain_universe_inconsistency UnivNames.pr_with_global_universes incon
| IncompatiblePolymorphism (env, t1, t2) ->
str "conversion of polymorphic values generates additional constraints: " ++
quote (Printer.safe_pr_lconstr_env env Evd.empty t1) ++ spc () ++
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 32885ab88a..2deca1e069 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -380,7 +380,7 @@ let do_mutual_induction_scheme lnamedepindsort =
match inst with
| None ->
let _, ctx = Global.type_of_global_in_context env0 (IndRef ind) in
- let u, ctx = Universes.fresh_instance_from ctx None in
+ let u, ctx = UnivGen.fresh_instance_from ctx None in
let evd = Evd.from_ctx (UState.of_context_set ctx) in
evd, (ind,u), Some u
| Some ui -> evd, (ind, ui), inst
diff --git a/vernac/lemmas.ml b/vernac/lemmas.ml
index 3d627d2f6e..3c7ede3c99 100644
--- a/vernac/lemmas.ml
+++ b/vernac/lemmas.ml
@@ -334,8 +334,8 @@ let universe_proof_terminator compute_guard hook =
Feedback.feedback Feedback.AddedAxiom
| Proved (opaque,idopt,proof) ->
let is_opaque, export_seff = match opaque with
- | Vernacexpr.Transparent -> false, true
- | Vernacexpr.Opaque -> true, false
+ | Transparent -> false, true
+ | Opaque -> true, false
in
let proof = get_proof proof compute_guard
(hook (Some (proof.Proof_global.universes))) is_opaque in
diff --git a/vernac/mltop.ml b/vernac/mltop.ml
index 343b0925d9..d25dea1413 100644
--- a/vernac/mltop.ml
+++ b/vernac/mltop.ml
@@ -345,13 +345,6 @@ let load_ml_object mname ?path fname=
let dir_ml_load m = ignore(dir_ml_load m)
let add_known_module m = add_known_module m None
-let load_ml_object_raw fname = dir_ml_load (file_of_name fname)
-let load_ml_objects_raw_rex rex =
- List.iter (fun (_,fp) ->
- let name = file_of_name (Filename.basename fp) in
- try dir_ml_load name
- with e -> prerr_endline (Printexc.to_string e))
- (System.where_in_path_rex !coq_mlpath_copy rex)
(* Summary of declared ML Modules *)
@@ -396,8 +389,6 @@ let trigger_ml_object verb cache reinit ?path name =
if cache then perform_cache_obj name
end
-let load_ml_object n m = ignore(load_ml_object n m)
-
let unfreeze_ml_modules x =
reset_loaded_modules ();
List.iter
diff --git a/vernac/mltop.mli b/vernac/mltop.mli
index da195f4fce..ed1f9a12d8 100644
--- a/vernac/mltop.mli
+++ b/vernac/mltop.mli
@@ -68,9 +68,6 @@ val add_coq_path : coq_path -> unit
(** List of modules linked to the toplevel *)
val add_known_module : string -> unit
val module_is_known : string -> bool
-val load_ml_object : string -> string -> unit
-val load_ml_object_raw : string -> unit
-val load_ml_objects_raw_rex : Str.regexp -> unit
(** {5 Initialization functions} *)
diff --git a/vernac/obligations.ml b/vernac/obligations.ml
index ae1065ef50..3bf0ca0a87 100644
--- a/vernac/obligations.ml
+++ b/vernac/obligations.ml
@@ -259,7 +259,7 @@ let eterm_obligations env name evm fs ?status t ty =
let tactics_module = ["Program";"Tactics"]
let safe_init_constant md name () =
Coqlib.check_required_library ("Coq"::md);
- Universes.constr_of_global (Coqlib.coq_reference "Obligations" md name)
+ UnivGen.constr_of_global (Coqlib.coq_reference "Obligations" md name)
let hide_obligation = safe_init_constant tactics_module "obligation"
let pperror cmd = CErrors.user_err ~hdr:"Program" cmd
@@ -472,7 +472,7 @@ let subst_body expand prg =
let declare_definition prg =
let body, typ = subst_body true prg in
- let nf = Universes.nf_evars_and_universes_opt_subst (fun x -> None)
+ let nf = UnivSubst.nf_evars_and_universes_opt_subst (fun x -> None)
(UState.subst prg.prg_ctx) in
let opaque = prg.prg_opaque in
let fix_exn = Hook.get get_fix_exn () in
@@ -555,7 +555,7 @@ let declare_mutual_definition l =
(* Declare the recursive definitions *)
let univs = UState.const_univ_entry ~poly first.prg_ctx in
let fix_exn = Hook.get get_fix_exn () in
- let kns = List.map4 (DeclareDef.declare_fix ~opaque (local, poly, kind) Universes.empty_binders univs)
+ let kns = List.map4 (DeclareDef.declare_fix ~opaque (local, poly, kind) UnivNames.empty_binders univs)
fixnames fixdecls fixtypes fiximps in
(* Declare notations *)
List.iter (Metasyntax.add_notation_interpretation (Global.env())) first.prg_notations;
@@ -849,12 +849,12 @@ let obligation_terminator name num guard hook auto pf =
let obl = obls.(num) in
let status =
match obl.obl_status, opq with
- | (_, Evar_kinds.Expand), Vernacexpr.Opaque -> err_not_transp ()
- | (true, _), Vernacexpr.Opaque -> err_not_transp ()
- | (false, _), Vernacexpr.Opaque -> Evar_kinds.Define true
- | (_, Evar_kinds.Define true), Vernacexpr.Transparent ->
+ | (_, Evar_kinds.Expand), Opaque -> err_not_transp ()
+ | (true, _), Opaque -> err_not_transp ()
+ | (false, _), Opaque -> Evar_kinds.Define true
+ | (_, Evar_kinds.Define true), Transparent ->
Evar_kinds.Define false
- | (_, status), Vernacexpr.Transparent -> status
+ | (_, status), Transparent -> status
in
let obl = { obl with obl_status = false, status } in
let ctx =
diff --git a/vernac/record.ml b/vernac/record.ml
index b89c0060dc..bf6affd5f8 100644
--- a/vernac/record.ml
+++ b/vernac/record.ml
@@ -122,7 +122,7 @@ let typecheck_params_and_fields finite def id poly pl t ps nots fs =
let env = EConstr.push_rel_context newps env0 in
let poly =
match t with
- | { CAst.v = CSort (Misctypes.GType []) } -> true | _ -> false in
+ | { CAst.v = CSort (Glob_term.GType []) } -> true | _ -> false in
let sigma, s = interp_type_evars env sigma ~impls:empty_internalization_env t in
let sred = Reductionops.whd_allnolet env sigma s in
(match EConstr.kind sigma sred with
@@ -316,7 +316,7 @@ let declare_projections indsp ctx ?(kind=StructureComponent) binder_name coers u
let gr = Nametab.locate (Libnames.qualid_of_ident fid) in
let kn = destConstRef gr in
Declare.definition_message fid;
- Universes.register_universe_binders gr ubinders;
+ UnivNames.register_universe_binders gr ubinders;
kn, mkProj (Projection.make kn false,mkRel 1)
else
let ccl = subst_projection fid subst ti in
@@ -352,7 +352,7 @@ let declare_projections indsp ctx ?(kind=StructureComponent) binder_name coers u
applist (mkConstU (kn,u),proj_args)
in
Declare.definition_message fid;
- Universes.register_universe_binders (ConstRef kn) ubinders;
+ UnivNames.register_universe_binders (ConstRef kn) ubinders;
kn, constr_fip
with Type_errors.TypeError (ctx,te) ->
raise (NotDefinable (BadTypedProj (fid,ctx,te)))
@@ -465,9 +465,9 @@ let declare_class finite def cum ubinders univs id idbuild paramimpls params ari
in
let cref = ConstRef cst in
Impargs.declare_manual_implicits false cref [paramimpls];
- Universes.register_universe_binders cref ubinders;
+ UnivNames.register_universe_binders cref ubinders;
Impargs.declare_manual_implicits false (ConstRef proj_cst) [List.hd fieldimpls];
- Universes.register_universe_binders (ConstRef proj_cst) ubinders;
+ UnivNames.register_universe_binders (ConstRef proj_cst) ubinders;
Classes.set_typeclass_transparency (EvalConstRef cst) false false;
let sub = match List.hd coers with
| Some b -> Some ((if b then Backward else Forward), List.hd priorities)
diff --git a/vernac/record.mli b/vernac/record.mli
index 308c9e9b90..b2c039f0b5 100644
--- a/vernac/record.mli
+++ b/vernac/record.mli
@@ -20,7 +20,7 @@ val declare_projections :
?kind:Decl_kinds.definition_object_kind ->
Id.t ->
bool list ->
- Universes.universe_binders ->
+ UnivNames.universe_binders ->
Impargs.manual_implicits list ->
Context.Rel.t ->
(Name.t * bool) list * Constant.t option list
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index f0e41d27cc..e1ce4e194c 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -518,7 +518,7 @@ let vernac_exact_proof c =
(* spiwack: for simplicity I do not enforce that "Proof proof_term" is
called only at the begining of a proof. *)
let status = Pfedit.by (Tactics.exact_proof c) in
- save_proof (Vernacexpr.(Proved(Opaque,None)));
+ save_proof (Vernacexpr.(Proved(Proof_global.Opaque,None)));
if not status then Feedback.feedback Feedback.AddedAxiom
let vernac_assumption ~atts discharge kind l nl =
@@ -855,7 +855,7 @@ let vernac_identity_coercion ~atts id qids qidt =
let vernac_instance ~atts abst sup inst props pri =
let global = not (make_section_locality atts.locality) in
- Dumpglob.dump_constraint inst false "inst";
+ Dumpglob.dump_constraint (fst (pi1 inst)) false "inst";
let program_mode = Flags.is_program_mode () in
ignore(Classes.new_instance ~program_mode ~abstract:abst ~global atts.polymorphic sup inst props pri)
@@ -1268,7 +1268,7 @@ let vernac_reserve bl =
let vernac_generalizable ~atts =
let local = make_non_locality atts.locality in
- Implicit_quantifiers.declare_generalizable local
+ Implicit_quantifiers.declare_generalizable ~local
let _ =
declare_bool_option
@@ -1741,7 +1741,7 @@ let vernac_print ~atts env sigma =
else str"There may remain asynchronous universe constraints"
in
begin match dst with
- | None -> UGraph.pr_universes Universes.pr_with_global_universes univ ++ pr_remaining
+ | None -> UGraph.pr_universes UnivNames.pr_with_global_universes univ ++ pr_remaining
| Some s -> dump_universes_gen univ s
end
| PrintHint r -> Hints.pr_hint_ref env sigma (smart_global r)
@@ -2243,7 +2243,7 @@ let with_fail st b f =
| HasNotFailed ->
user_err ~hdr:"Fail" (str "The command has not failed!")
| HasFailed msg ->
- if not !Flags.quiet || !Flags.test_mode || !Flags.ide_slave then Feedback.msg_info
+ if not !Flags.quiet || !Flags.test_mode then Feedback.msg_info
(str "The command has indeed failed with message:" ++ fnl () ++ msg)
| _ -> assert false
end
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-01 15:16:08 +0000