diff options
| author | Pierre-Marie Pédrot | 2020-11-12 13:33:21 +0100 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2020-11-12 13:33:21 +0100 |
| commit | c53abd9bf4517ba66c732034fb5f9aedef6d0930 (patch) | |
| tree | b31f4b01a1e30edc1045c118c1f285b57583ea5e /vernac | |
| parent | 0245aa233e671372e9d3fb34f3b34706fd9f4bf7 (diff) | |
| parent | e7b39c73f48279980f8ea2238632bfbf6e3d4178 (diff) | |
Merge PR #13289: Cosmetic cleaning of uState.ml: a bit of doc, more unity in naming
Ack-by: gares
Reviewed-by: ppedrot
Diffstat (limited to 'vernac')
| -rw-r--r-- | vernac/classes.ml | 2 | ||||
| -rw-r--r-- | vernac/comAssumption.ml | 1 | ||||
| -rw-r--r-- | vernac/comDefinition.ml | 4 | ||||
| -rw-r--r-- | vernac/comFixpoint.ml | 2 | ||||
| -rw-r--r-- | vernac/comPrimitive.ml | 2 | ||||
| -rw-r--r-- | vernac/comProgramFixpoint.ml | 2 | ||||
| -rw-r--r-- | vernac/declare.ml | 36 | ||||
| -rw-r--r-- | vernac/prettyp.ml | 4 | ||||
| -rw-r--r-- | vernac/record.ml | 2 | ||||
| -rw-r--r-- | vernac/vernacentries.ml | 2 |
10 files changed, 28 insertions, 29 deletions
diff --git a/vernac/classes.ml b/vernac/classes.ml index a100352145..054addc542 100644 --- a/vernac/classes.ml +++ b/vernac/classes.ml @@ -503,7 +503,7 @@ let do_instance_program ~pm env env' sigma ?hook ~global ~poly cty k u ctx ctx' declare_instance_program pm env sigma ~global ~poly id pri imps decl term termtype let interp_instance_context ~program_mode env ctx ~generalize pl tclass = - let sigma, decl = Constrexpr_ops.interp_univ_decl_opt env pl in + let sigma, decl = interp_univ_decl_opt env pl in let tclass = if generalize then CAst.make @@ CGeneralization (Glob_term.MaxImplicit, Some AbsPi, tclass) else tclass diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml index 12194ea20c..9e850ff1c7 100644 --- a/vernac/comAssumption.ml +++ b/vernac/comAssumption.ml @@ -13,7 +13,6 @@ open Util open Vars open Names open Context -open Constrexpr_ops open Constrintern open Impargs open Pretyping diff --git a/vernac/comDefinition.ml b/vernac/comDefinition.ml index 3fc74cba5b..81154bbea9 100644 --- a/vernac/comDefinition.ml +++ b/vernac/comDefinition.ml @@ -114,7 +114,7 @@ let do_definition ?hook ~name ~scope ~poly ~kind ?using udecl bl red_option c ct let program_mode = false in let env = Global.env() in (* Explicitly bound universes and constraints *) - let evd, udecl = Constrexpr_ops.interp_univ_decl_opt env udecl in + let evd, udecl = interp_univ_decl_opt env udecl in let evd, (body, types), impargs = interp_definition ~program_mode env evd empty_internalization_env bl red_option c ctypopt in @@ -134,7 +134,7 @@ let do_definition_program ?hook ~pm ~name ~scope ~poly ~kind ?using udecl bl red let program_mode = true in let env = Global.env() in (* Explicitly bound universes and constraints *) - let evd, udecl = Constrexpr_ops.interp_univ_decl_opt env udecl in + let evd, udecl = interp_univ_decl_opt env udecl in let evd, (body, types), impargs = interp_definition ~program_mode env evd empty_internalization_env bl red_option c ctypopt in diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml index 29bf5fbcc2..dd6c985bf9 100644 --- a/vernac/comFixpoint.ml +++ b/vernac/comFixpoint.ml @@ -176,7 +176,7 @@ let interp_recursive ~program_mode ~cofix (fixl : 'a Vernacexpr.fix_expr_gen lis if not (CList.for_all2eq (fun x y -> Id.equal x.CAst.v y.CAst.v) lsu usu) then CErrors.user_err Pp.(str "(co)-recursive definitions should all have the same universe binders"); Some us) fixl None in - let sigma, decl = Constrexpr_ops.interp_univ_decl_opt env all_universes in + let sigma, decl = interp_univ_decl_opt env all_universes in let sigma, (fixctxs, fiximppairs, fixannots) = on_snd List.split3 @@ List.fold_left_map (fun sigma -> interp_fix_context ~program_mode env sigma ~cofix) sigma fixl in diff --git a/vernac/comPrimitive.ml b/vernac/comPrimitive.ml index eaa5271a73..a910cc6e8b 100644 --- a/vernac/comPrimitive.ml +++ b/vernac/comPrimitive.ml @@ -30,7 +30,7 @@ let do_primitive id udecl prim typopt = declare id {Entries.prim_entry_type = None; prim_entry_content = prim} | Some typ -> let env = Global.env () in - let evd, udecl = Constrexpr_ops.interp_univ_decl_opt env udecl in + let evd, udecl = Constrintern.interp_univ_decl_opt env udecl in let auctx = CPrimitives.op_or_type_univs prim in let evd, u = Evd.with_context_set UState.univ_flexible evd (UnivGen.fresh_instance auctx) in let expected_typ = EConstr.of_constr @@ Typeops.type_of_prim_or_type env u prim in diff --git a/vernac/comProgramFixpoint.ml b/vernac/comProgramFixpoint.ml index 9623317ddf..31f91979d3 100644 --- a/vernac/comProgramFixpoint.ml +++ b/vernac/comProgramFixpoint.ml @@ -115,7 +115,7 @@ let build_wellfounded pm (recname,pl,bl,arityc,body) poly ?using r measure notat let lift_rel_context n l = Termops.map_rel_context_with_binders (liftn n) l in Coqlib.check_required_library ["Coq";"Program";"Wf"]; let env = Global.env() in - let sigma, udecl = Constrexpr_ops.interp_univ_decl_opt env pl in + let sigma, udecl = interp_univ_decl_opt env pl in let sigma, (_, ((env', binders_rel), impls)) = interp_context_evars ~program_mode:true env sigma bl in let len = List.length binders_rel in let top_env = push_rel_context binders_rel env in diff --git a/vernac/declare.ml b/vernac/declare.ml index 367d0bf944..1e8771b641 100644 --- a/vernac/declare.ml +++ b/vernac/declare.ml @@ -1291,7 +1291,7 @@ let obligation_terminator ~pm ~entry ~uctx ~oinfo:{name; num; auto} = FIXME: There is duplication of this code with obligation_terminator and Obligations.admit_obligations *) -let obligation_admitted_terminator ~pm {name; num; auto} ctx' dref = +let obligation_admitted_terminator ~pm {name; num; auto} uctx' dref = let prg = Option.get (State.find pm name) in let {obls; remaining = rem} = prg.prg_obligations in let obl = obls.(num) in @@ -1303,21 +1303,21 @@ let obligation_admitted_terminator ~pm {name; num; auto} ctx' dref = if not transparent then err_not_transp () | _ -> () in - let inst, ctx' = + let inst, uctx' = if not prg.prg_info.Info.poly (* Not polymorphic *) then (* The universe context was declared globally, we continue from the new global environment. *) - let ctx = UState.from_env (Global.env ()) in - let ctx' = UState.merge_subst ctx (UState.subst ctx') in - (Univ.Instance.empty, ctx') + let uctx = UState.from_env (Global.env ()) in + let uctx' = UState.merge_subst uctx (UState.subst uctx') in + (Univ.Instance.empty, uctx') else (* We get the right order somehow, but surely it could be enforced in a clearer way. *) - let uctx = UState.context ctx' in - (Univ.UContext.instance uctx, ctx') + let uctx = UState.context uctx' in + (Univ.UContext.instance uctx, uctx') in let obl = {obl with obl_body = Some (DefinedObl (cst, inst))} in let () = if transparent then add_hint true prg cst in - update_program_decl_on_defined ~pm prg obls num obl ~uctx:ctx' rem ~auto + update_program_decl_on_defined ~pm prg obls num obl ~uctx:uctx' rem ~auto end @@ -1627,12 +1627,12 @@ let make_univs_deferred ~poly ~initial_euctx ~uctx ~udecl let make_univs_private_poly ~poly ~uctx ~udecl (used_univs_typ, typ) (used_univs_body, body) = let used_univs = Univ.LSet.union used_univs_body used_univs_typ in - let universes = UState.restrict uctx used_univs in - let typus = UState.restrict universes used_univs_typ in - let utyp = UState.check_univ_decl ~poly typus udecl in + let uctx = UState.restrict uctx used_univs in + let uctx' = UState.restrict uctx used_univs_typ in + let utyp = UState.check_univ_decl ~poly uctx' udecl in let ubody = Univ.ContextSet.diff - (UState.context_set universes) - (UState.context_set typus) + (UState.context_set uctx) + (UState.context_set uctx') in utyp, ubody @@ -1643,8 +1643,8 @@ let make_univs ~poly ~uctx ~udecl (used_univs_typ, typ) (used_univs_body, body) for the typ. We recheck the declaration after restricting with the actually used universes. TODO: check if restrict is really necessary now. *) - let ctx = UState.restrict uctx used_univs in - let utyp = UState.check_univ_decl ~poly ctx udecl in + let uctx = UState.restrict uctx used_univs in + let utyp = UState.check_univ_decl ~poly uctx udecl in utyp, Univ.ContextSet.empty let close_proof ~opaque ~keep_body_ucst_separate ps = @@ -1712,9 +1712,9 @@ let close_proof_delayed ~feedback_id ps (fpl : closed_proof_output Future.comput (Vars.universes_of_constr types) (Vars.universes_of_constr pt) in - let univs = UState.restrict uctx used_univs in - let univs = UState.check_mono_univ_decl univs udecl in - (pt,univs),eff) + let uctx = UState.restrict uctx used_univs in + let uctx = UState.check_mono_univ_decl uctx udecl in + (pt,uctx),eff) |> delayed_definition_entry ~opaque ~feedback_id ~using ~univs ~types in let entries = Future.map2 make_entry fpl (Proofview.initial_goals entry) in diff --git a/vernac/prettyp.ml b/vernac/prettyp.ml index 06f7c32cdc..840754ccc6 100644 --- a/vernac/prettyp.ml +++ b/vernac/prettyp.ml @@ -631,11 +631,11 @@ let print_constant with_values sep sp udecl = assert(ContextSet.is_empty body_uctxs); Polymorphic ctx in - let ctx = + let uctx = UState.of_binders (Printer.universe_binders_with_opt_names (Declareops.constant_polymorphic_context cb) udecl) in - let env = Global.env () and sigma = Evd.from_ctx ctx in + let env = Global.env () and sigma = Evd.from_ctx uctx in let pr_ltype = pr_ltype_env env sigma in hov 0 ( match val_0 with diff --git a/vernac/record.ml b/vernac/record.ml index acc97f61c1..2c56604d8f 100644 --- a/vernac/record.ml +++ b/vernac/record.ml @@ -124,7 +124,7 @@ let typecheck_params_and_fields def poly pl ps records = let is_template = List.exists (fun (_, arity, _, _) -> Option.cata check_anonymous_type true arity) records in let env0 = if not poly && is_template then Environ.set_universes_lbound env0 UGraph.Bound.Prop else env0 in - let sigma, decl = Constrexpr_ops.interp_univ_decl_opt env0 pl in + let sigma, decl = interp_univ_decl_opt env0 pl in let () = let error bk {CAst.loc; v=name} = match bk, name with diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index ef8631fbb6..824bf35b1d 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -550,7 +550,7 @@ let start_lemma_com ~program_mode ~poly ~scope ~kind ?using ?hook thms = let env0 = Global.env () in let flags = Pretyping.{ all_no_fail_flags with program_mode } in let decl = fst (List.hd thms) in - let evd, udecl = Constrexpr_ops.interp_univ_decl_opt env0 (snd decl) in + let evd, udecl = Constrintern.interp_univ_decl_opt env0 (snd decl) in let evd, thms = interp_lemma ~program_mode ~flags ~scope env0 evd thms in let mut_analysis = RecLemmas.look_for_possibly_mutual_statements evd thms in let evd = Evd.minimize_universes evd in |
