diff options
156 files changed, 1630 insertions, 1582 deletions
diff --git a/.gitattributes b/.gitattributes index 51fa208a73..db179c8d20 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2,10 +2,18 @@ .gitignore export-ignore .mailmap export-ignore -*.out -whitespace +# Because our commit hook automatically does [apply whitespace=fix] we +# disable whitespace checking for all files except those where we want +# it. Otherwise rogue global configuration and forgotten local +# configuration can break commits. +* -whitespace +# tabs are allowed in Makefiles. +Makefile* whitespace=trailing-space +tools/CoqMakefile.in whitespace=trailing-space + +# in general we don't want tabs. *.asciidoc whitespace=trailing-space,tab-in-indent -*.bat whitespace=cr-at-eol,trailing-space,tab-in-indent *.bib whitespace=trailing-space,tab-in-indent *.c whitespace=trailing-space,tab-in-indent *.css whitespace=trailing-space,tab-in-indent @@ -36,3 +44,6 @@ *.v whitespace=trailing-space,tab-in-indent *.xml whitespace=trailing-space,tab-in-indent *.yml whitespace=trailing-space,tab-in-indent + +# CR is desired for these Windows files. +*.bat whitespace=cr-at-eol,trailing-space,tab-in-indent @@ -54,6 +54,9 @@ Tactics with let bindings in the parameters. - The tactic "dtauto" now handles some inductives such as "@sigT A (fun _ => B)" as non-dependent conjunctions. +- A bug fixed in "rewrite H in *" and "rewrite H in * |-" may cause a + few rare incompatibilities (it was unintendedly recursively + rewriting in the side conditions generated by H). Focusing @@ -108,6 +111,12 @@ Standard Library facts about them, and conversions between decimal numbers and nat, positive, N, Z, and string. +- Some deprecated aliases are now emitting warnings when used. + +Compatibility support + +- Support for compatibility with versions before 8.6 was dropped. + Changes from 8.7.1 to 8.7.2 =========================== diff --git a/dev/base_include b/dev/base_include index 350ccaa109..3320a2a942 100644 --- a/dev/base_include +++ b/dev/base_include @@ -196,7 +196,10 @@ let parse_tac = Pcoq.parse_string Ltac_plugin.Pltac.tactic;; (* build a term of type glob_constr without type-checking or resolution of implicit syntax *) -let e s = Constrintern.intern_constr (Global.env()) (parse_constr s);; +let e s = + let env = Global.env () in + let sigma = Evd.from_env env in + Constrintern.intern_constr env sigma (parse_constr s);; (* build a term of type constr with type-checking and resolution of implicit syntax *) @@ -229,7 +232,7 @@ let _ = Flags.in_toplevel := true let _ = Constrextern.set_extern_reference (fun ?loc _ r -> Libnames.Qualid (loc,Nametab.shortest_qualid_of_global Id.Set.empty r));; -let go () = Coqloop.loop ~time:false ~state:Option.(get !Coqtop.drop_last_doc) +let go () = Coqloop.loop ~time:false ~state:Option.(get !Coqloop.drop_last_doc) let _ = print_string diff --git a/dev/ci/user-overlays/06511-ejgallego-econstr+more_fix.sh b/dev/ci/user-overlays/06511-ejgallego-econstr+more_fix.sh new file mode 100644 index 0000000000..4b681909d6 --- /dev/null +++ b/dev/ci/user-overlays/06511-ejgallego-econstr+more_fix.sh @@ -0,0 +1,7 @@ + if [ "$CI_PULL_REQUEST" = "6511" ] || [ "$CI_BRANCH" = "econstr+more_fix" ]; then + ltac2_CI_BRANCH=econstr+more_fix + ltac2_CI_GITURL=https://github.com/ejgallego/ltac2 + + Equations_CI_BRANCH=econstr+more_fix + Equations_CI_GITURL=https://github.com/ejgallego/Coq-Equations +fi diff --git a/dev/ci/user-overlays/06676-gares-proofview-goals-come-with-a-state.sh b/dev/ci/user-overlays/06676-gares-proofview-goals-come-with-a-state.sh new file mode 100644 index 0000000000..2451657d43 --- /dev/null +++ b/dev/ci/user-overlays/06676-gares-proofview-goals-come-with-a-state.sh @@ -0,0 +1,6 @@ +if [ "$CI_PULL_REQUEST" = "6676" ] || [ "$CI_BRANCH" = "proofview/goal-w-state" ]; then + ltac2_CI_BRANCH=fix-for/6676 + ltac2_CI_GITURL=https://github.com/gares/ltac2.git + Equations_CI_BRANCH=fix-for/6676 + Equations_CI_GITURL=https://github.com/gares/Coq-Equations.git +fi diff --git a/dev/top_printers.ml b/dev/top_printers.ml index f99e2593d7..2c983fd8d2 100644 --- a/dev/top_printers.ml +++ b/dev/top_printers.ml @@ -313,6 +313,8 @@ let constr_display csr = in pp (str (term_display csr) ++fnl ()) +let econstr_display c = constr_display EConstr.Unsafe.(to_constr c) ;; + open Format;; let print_pure_constr csr = @@ -452,6 +454,8 @@ let print_pure_constr csr = print_string (Printexc.to_string e);print_flush (); raise e +let print_pure_econstr c = print_pure_constr EConstr.Unsafe.(to_constr c) ;; + let pploc x = let (l,r) = Loc.unloc x in print_string"(";print_int l;print_string",";print_int r;print_string")" @@ -505,7 +509,7 @@ let _ = (function [c] when genarg_tag c = unquote (topwit wit_constr) && true -> let c = out_gen (rawwit wit_constr) c in - (fun ~atts ~st -> in_current_context constr_display c; st) + (fun ~atts ~st -> in_current_context econstr_display c; st) | _ -> failwith "Vernac extension: cannot occur") with e -> pp (CErrors.print e) @@ -521,7 +525,7 @@ let _ = (function [c] when genarg_tag c = unquote (topwit wit_constr) && true -> let c = out_gen (rawwit wit_constr) c in - (fun ~atts ~st -> in_current_context print_pure_constr c; st) + (fun ~atts ~st -> in_current_context print_pure_econstr c; st) | _ -> failwith "Vernac extension: cannot occur") with e -> pp (CErrors.print e) diff --git a/dev/vm_printers.ml b/dev/vm_printers.ml index ca6269beeb..2ddf927d9b 100644 --- a/dev/vm_printers.ml +++ b/dev/vm_printers.ml @@ -65,7 +65,7 @@ and ppstack s = and ppatom a = match a with | Aid idk -> print_idkey idk - | Atype u -> print_string "Type(...)" + | Asort u -> print_string "Sort(...)" | Aind(sp,i) -> print_string "Ind("; print_string (MutInd.to_string sp); print_string ","; print_int i; @@ -73,7 +73,6 @@ and ppatom a = and ppwhd whd = match whd with - | Vsort s -> ppsort s | Vprod _ -> print_string "product" | Vfun _ -> print_string "function" | Vfix _ -> print_vfix() diff --git a/doc/refman/RefMan-oth.tex b/doc/refman/RefMan-oth.tex index 1cd23c9297..bef31d3fa5 100644 --- a/doc/refman/RefMan-oth.tex +++ b/doc/refman/RefMan-oth.tex @@ -513,6 +513,9 @@ This command loads the file named {\ident}{\tt .v}, searching successively in each of the directories specified in the {\em loadpath}. (see Section~\ref{loadpath}) +Files loaded this way cannot leave proofs open, and neither the {\tt + Load} command can be use inside a proof. + \begin{Variants} \item {\tt Load {\str}.}\label{Load-str}\\ Loads the file denoted by the string {\str}, where {\str} is any @@ -530,6 +533,8 @@ successively in each of the directories specified in the {\em \begin{ErrMsgs} \item \errindex{Can't find file {\ident} on loadpath} +\item \errindex{Load is not supported inside proofs} +\item \errindex{Files processed by Load cannot leave open proofs} \end{ErrMsgs} \section[Compiled files]{Compiled files\label{compiled}\index{Compiled files}} diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex index 9635b3ab1a..6dca314b4a 100644 --- a/doc/refman/RefMan-tac.tex +++ b/doc/refman/RefMan-tac.tex @@ -2904,7 +2904,7 @@ This happens if \term$_1$ does not occur in the goal. rewrite H in H2 at - 2}. In particular a failure will happen if any of these three simpler tactics fails. \item \texttt{rewrite H in * |- } will do \texttt{rewrite H in - H$_i$} for all hypothesis \texttt{H$_i$ <> H}. A success will happen + H$_i$} for all hypotheses \texttt{H$_i$} different from \texttt{H}. A success will happen as soon as at least one of these simpler tactics succeeds. \item \texttt{rewrite H in *} is a combination of \texttt{rewrite H} and \texttt{rewrite H in * |-} that succeeds if at diff --git a/doc/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template index 95e541f81d..a2739e457e 100644 --- a/doc/stdlib/index-list.html.template +++ b/doc/stdlib/index-list.html.template @@ -596,7 +596,6 @@ through the <tt>Require Import</tt> command.</p> </dt> <dd> theories/Compat/AdmitAxiom.v - theories/Compat/Coq85.v theories/Compat/Coq86.v theories/Compat/Coq87.v </dd> diff --git a/engine/proofview.ml b/engine/proofview.ml index c41b0b0dc5..77a884121e 100644 --- a/engine/proofview.ml +++ b/engine/proofview.ml @@ -33,7 +33,7 @@ type entry = (EConstr.constr * EConstr.types) list (* In this version: returns the list of focused goals together with the [evar_map] context. *) let proofview p = - p.comb , p.solution + List.map drop_state p.comb , p.solution let compact el ({ solution } as pv) = let nf c = Evarutil.nf_evar solution c in @@ -74,7 +74,7 @@ let dependent_init = let (gl, _) = EConstr.destEvar sigma econstr in let ret, { solution = sol; comb = comb } = aux (t sigma econstr) in let entry = (econstr, typ) :: ret in - entry, { solution = sol; comb = gl :: comb; shelf = [] } + entry, { solution = sol; comb = with_empty_state gl :: comb; shelf = [] } in fun t -> let entry, v = aux t in @@ -110,7 +110,7 @@ let partial_proof entry pv = CList.map (return_constr pv) (CList.map fst entry) (* First component is a reverse list of the goals which come before and second component is the list of the goals which go after (in the expected order). *) -type focus_context = Evar.t list * Evar.t list +type focus_context = goal_with_state list * goal_with_state list (** Returns a stylised view of a focus_context for use by, for @@ -120,7 +120,8 @@ type focus_context = Evar.t list * Evar.t list new nearly identical function everytime. Hence the generic name. *) (* In this version: the goals in the context, as a "zipper" (the first list is in reversed order). *) -let focus_context f = f +let focus_context (left,right) = + (List.map drop_state left, List.map drop_state right) (** This (internal) function extracts a sublist between two indices, and returns this sublist together with its context: if it returns @@ -149,21 +150,35 @@ let unfocus_sublist (left,right) s = proofview. It returns the focused proofview, and a context for the focus stack. *) let focus i j sp = - let (new_comb, context) = focus_sublist i j sp.comb in - ( { sp with comb = new_comb } , context ) + let (new_comb, (left, right)) = focus_sublist i j sp.comb in + ( { sp with comb = new_comb } , (left, right) ) + +let cleared_alias evd g = + let evk = drop_state g in + let state = get_state g in + Option.map (fun g -> goal_with_state g state) (Evarutil.advance evd evk) (** [undefined defs l] is the list of goals in [l] which are still unsolved (after advancing cleared goals). Note that order matters. *) -let undefined defs l = +let undefined_evars defs l = List.fold_right (fun evk l -> match Evarutil.advance defs evk with | Some evk -> List.add_set Evar.equal evk l | None -> l) l [] +let goal_with_state_equal x y = Evar.equal (drop_state x) (drop_state y) +let undefined defs l = + List.fold_right (fun evk l -> + match cleared_alias defs evk with + | Some evk -> List.add_set goal_with_state_equal evk l + | None -> l) l [] (** Unfocuses a proofview with respect to a context. *) -let unfocus c sp = - { sp with comb = undefined sp.solution (unfocus_sublist c sp.comb) } +let unfocus (left, right) sp = + { sp with comb = undefined sp.solution (unfocus_sublist (left, right) sp.comb) } +let with_empty_state = Proofview_monad.with_empty_state +let drop_state = Proofview_monad.drop_state +let goal_with_state = Proofview_monad.goal_with_state (** {6 The tactic monad} *) @@ -406,7 +421,8 @@ let tclFOCUSID id t = try let ev = Evd.evar_key id initial.solution in try - let n = CList.index Evar.equal ev initial.comb in + let comb = CList.map drop_state initial.comb in + let n = CList.index Evar.equal ev comb in (* goal is already under focus *) let (focused,context) = focus n n initial in Pv.set focused >> @@ -415,7 +431,7 @@ let tclFOCUSID id t = return result with Not_found -> (* otherwise, save current focus and work purely on the shelve *) - Comb.set [ev] >> + Comb.set [with_empty_state ev] >> t >>= fun result -> Comb.set initial.comb >> return result @@ -445,7 +461,7 @@ let iter_goal i = Comb.get >>= fun initial -> Proof.List.fold_left begin fun (subgoals as cur) goal -> Solution.get >>= fun step -> - match Evarutil.advance step goal with + match cleared_alias step goal with | None -> return cur | Some goal -> Comb.set [goal] >> @@ -462,7 +478,7 @@ let map_goal i = Comb.get >>= fun initial -> Proof.List.fold_left begin fun (acc, subgoals as cur) goal -> Solution.get >>= fun step -> - match Evarutil.advance step goal with + match cleared_alias step goal with | None -> return cur | Some goal -> Comb.set [goal] >> @@ -488,7 +504,7 @@ let fold_left2_goal i s l = in Proof.List.fold_left2 err begin fun ((r,subgoals) as cur) goal a -> Solution.get >>= fun step -> - match Evarutil.advance step goal with + match cleared_alias step goal with | None -> return cur | Some goal -> Comb.set [goal] >> @@ -532,7 +548,7 @@ let tclDISPATCHGEN0 join tacs = let open Proof in Pv.get >>= function | { comb=[goal] ; solution } -> - begin match Evarutil.advance solution goal with + begin match cleared_alias solution goal with | None -> tclUNIT (join []) | Some _ -> Proof.map (fun res -> join [res]) tac end @@ -624,12 +640,12 @@ let shelve = Comb.get >>= fun initial -> Comb.set [] >> InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve")) >> - Shelf.modify (fun gls -> gls @ initial) + Shelf.modify (fun gls -> gls @ CList.map drop_state initial) let shelve_goals l = let open Proof in Comb.get >>= fun initial -> - let comb = CList.filter (fun g -> not (CList.mem g l)) initial in + let comb = CList.filter (fun g -> not (CList.mem (drop_state g) l)) initial in Comb.set comb >> InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_goals")) >> Shelf.modify (fun gls -> gls @ l) @@ -656,9 +672,27 @@ let free_evars sigma l = in List.map map l +let free_evars_with_state sigma l = + let cache = Evarutil.create_undefined_evars_cache () in + let map ev = + (** Computes the set of evars appearing in the hypotheses, the conclusion or + the body of the evar_info [evi]. Note: since we want to use it on goals, + the body is actually supposed to be empty. *) + let ev = drop_state ev in + let evi = Evd.find sigma ev in + let fevs = lazy (Evarutil.filtered_undefined_evars_of_evar_info ~cache sigma evi) in + (ev, fevs) + in + List.map map l + + (** [unifiable sigma g l] checks whether [g] appears in another subgoal of [l]. The list [l] may contain [g], but it does not affect the result. *) +let unifiable_delayed_with_state sigma g l = + let g = drop_state g in + unifiable_delayed g l + let unifiable sigma g l = let l = free_evars sigma l in unifiable_delayed g l @@ -668,8 +702,8 @@ let unifiable sigma g l = whose definition other goals of [l] depend, and [n] are the non-unifiable goals. *) let partition_unifiable sigma l = - let fevs = free_evars sigma l in - CList.partition (fun g -> unifiable_delayed g fevs) l + let fevs = free_evars_with_state sigma l in + CList.partition (fun g -> unifiable_delayed_with_state sigma g fevs) l (** Shelves the unifiable goals under focus, i.e. the goals which appear in other goals under focus (the unfocused goals are not @@ -680,7 +714,7 @@ let shelve_unifiable = let (u,n) = partition_unifiable initial.solution initial.comb in Comb.set n >> InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_unifiable")) >> - Shelf.modify (fun gls -> gls @ u) + Shelf.modify (fun gls -> gls @ CList.map drop_state u) (** [guard_no_unifiable] returns the list of unifiable goals if some goals are unifiable (see {!shelve_unifiable}) in the current focus. *) @@ -691,13 +725,14 @@ let guard_no_unifiable = match u with | [] -> tclUNIT None | gls -> - let l = CList.map (fun g -> Evd.dependent_evar_ident g initial.solution) gls in + let l = CList.map (fun g -> Evd.dependent_evar_ident (drop_state g) initial.solution) gls in let l = CList.map (fun id -> Names.Name id) l in tclUNIT (Some l) (** [unshelve l p] adds all the goals in [l] at the end of the focused goals of p *) let unshelve l p = + let l = List.map with_empty_state l in (* advance the goals in case of clear *) let l = undefined p.solution l in { p with comb = p.comb@l } @@ -736,7 +771,7 @@ let with_shelf tac = let pgoal = Evd.principal_future_goal solution in let sigma = Evd.restore_future_goals sigma fgoals pgoal in (* Ensure we mark and return only unsolved goals *) - let gls' = undefined sigma (CList.rev_append gls' gls) in + let gls' = undefined_evars sigma (CList.rev_append gls' gls) in let sigma = CList.fold_left (mark_in_evm ~goal:false) sigma gls' in let npv = { npv with shelf; solution = sigma } in Pv.set npv >> tclUNIT (gls', ans) @@ -818,7 +853,7 @@ let give_up = Comb.set [] >> mark_as_unsafe >> InfoL.leaf (Info.Tactic (fun () -> Pp.str"give_up")) >> - Giveup.put initial + Giveup.put (CList.map drop_state initial) @@ -859,8 +894,8 @@ module Progress = struct (** Equality function on goals *) let goal_equal evars1 gl1 evars2 gl2 = - let evi1 = Evd.find evars1 gl1 in - let evi2 = Evd.find evars2 gl2 in + let evi1 = Evd.find evars1 (drop_state gl1) in + let evi2 = Evd.find evars2 (drop_state gl2) in eq_evar_info evars1 evars2 evi1 evi2 end @@ -1027,10 +1062,12 @@ module Goal = struct env : Environ.env; sigma : Evd.evar_map; concl : EConstr.constr ; + state : StateStore.t; self : Evar.t ; (* for compatibility with old-style definitions *) } let assume (gl : t) = (gl : t) + let state { state=state } = state let env {env} = env let sigma {sigma} = sigma @@ -1038,16 +1075,19 @@ module Goal = struct let concl {concl} = concl let extra {sigma; self} = goal_extra sigma self - let gmake_with info env sigma goal = + let gmake_with info env sigma goal state = { env = Environ.reset_with_named_context (Evd.evar_filtered_hyps info) env ; sigma = sigma ; concl = EConstr.of_constr (Evd.evar_concl info); + state = state ; self = goal } let nf_gmake env sigma goal = + let state = get_state goal in + let goal = drop_state goal in let info = Evarutil.nf_evar_info sigma (Evd.find sigma goal) in let sigma = Evd.add sigma goal info in - gmake_with info env sigma goal , sigma + gmake_with info env sigma goal state , sigma let nf_enter f = InfoL.tag (Info.Dispatch) begin @@ -1063,15 +1103,17 @@ module Goal = struct end end - let normalize { self } = + let normalize { self; state } = Env.get >>= fun env -> tclEVARMAP >>= fun sigma -> - let (gl,sigma) = nf_gmake env sigma self in + let (gl,sigma) = nf_gmake env sigma (goal_with_state self state) in tclTHEN (Unsafe.tclEVARS sigma) (tclUNIT gl) let gmake env sigma goal = + let state = get_state goal in + let goal = drop_state goal in let info = Evd.find sigma goal in - gmake_with info env sigma goal + gmake_with info env sigma goal state let enter f = let f gl = InfoL.tag (Info.DBranch) (f gl) in @@ -1104,7 +1146,7 @@ module Goal = struct Pv.get >>= fun step -> let sigma = step.solution in let map goal = - match Evarutil.advance sigma goal with + match cleared_alias sigma goal with | None -> None (** ppedrot: Is this check really necessary? *) | Some goal -> let gl = @@ -1164,18 +1206,22 @@ module V82 = struct let open Proof in Pv.get >>= fun ps -> try - let tac gl evd = + let tac g_w_s evd = + let g, w = drop_state g_w_s, get_state g_w_s in let glsigma = - tac { Evd.it = gl ; sigma = evd; } in + tac { Evd.it = g ; sigma = evd; } in let sigma = glsigma.Evd.sigma in - let g = glsigma.Evd.it in + let g = CList.map (fun g -> goal_with_state g w) glsigma.Evd.it in ( g, sigma ) in (* Old style tactics expect the goals normalized with respect to evars. *) - let (initgoals,initevd) = - Evd.Monad.List.map (fun g s -> goal_nf_evar s g) ps.comb ps.solution + let (initgoals_w_state, initevd) = + Evd.Monad.List.map (fun g_w_s s -> + let g, w = drop_state g_w_s, get_state g_w_s in + let g, s = goal_nf_evar s g in + goal_with_state g w, s) ps.comb ps.solution in - let (goalss,evd) = Evd.Monad.List.map tac initgoals initevd in + let (goalss,evd) = Evd.Monad.List.map tac initgoals_w_state initevd in let sgs = CList.flatten goalss in let sgs = undefined evd sgs in InfoL.leaf (Info.Tactic (fun () -> Pp.str"<unknown>")) >> @@ -1190,8 +1236,9 @@ module V82 = struct let nf_evar_goals = Pv.modify begin fun ps -> let map g s = goal_nf_evar s g in - let (goals,evd) = Evd.Monad.List.map map ps.comb ps.solution in - { ps with solution = evd; comb = goals; } + let comb = CList.map drop_state ps.comb in + let (_goals,evd) = Evd.Monad.List.map map comb ps.solution in + { ps with solution = evd; } end let has_unresolved_evar pv = @@ -1201,14 +1248,14 @@ module V82 = struct let grab pv = let undef = Evd.undefined_map pv.solution in let goals = CList.rev_map fst (Evar.Map.bindings undef) in - { pv with comb = goals } + { pv with comb = List.map with_empty_state goals } (* Returns the open goals of the proofview together with the evar_map to interpret them. *) let goals { comb = comb ; solution = solution; } = - { Evd.it = comb ; sigma = solution } + { Evd.it = List.map drop_state comb ; sigma = solution } let top_goals initial { solution=solution; } = let goals = CList.map (fun (t,_) -> fst (Constr.destEvar (EConstr.Unsafe.to_constr t))) initial in @@ -1222,9 +1269,9 @@ module V82 = struct let of_tactic t gls = try - let init = { shelf = []; solution = gls.Evd.sigma ; comb = [gls.Evd.it] } in + let init = { shelf = []; solution = gls.Evd.sigma ; comb = [with_empty_state gls.Evd.it] } in let (_,final,_,_) = apply (goal_env gls.Evd.sigma gls.Evd.it) t init in - { Evd.sigma = final.solution ; it = final.comb } + { Evd.sigma = final.solution ; it = CList.map drop_state final.comb } with Logic_monad.TacticFailure e as src -> let (_, info) = CErrors.push src in iraise (e, info) diff --git a/engine/proofview.mli b/engine/proofview.mli index 721ce507d4..77f30746d8 100644 --- a/engine/proofview.mli +++ b/engine/proofview.mli @@ -72,7 +72,15 @@ val return : proofview -> Evd.evar_map val partial_proof : entry -> proofview -> constr list val initial_goals : entry -> (constr * types) list +(** goal <-> goal_with_state *) +val with_empty_state : + Proofview_monad.goal -> Proofview_monad.goal_with_state +val drop_state : + Proofview_monad.goal_with_state -> Proofview_monad.goal +val goal_with_state : + Proofview_monad.goal -> Proofview_monad.StateStore.t -> + Proofview_monad.goal_with_state (** {6 Focusing commands} *) @@ -416,14 +424,14 @@ module Unsafe : sig (** [tclNEWGOALS gls] adds the goals [gls] to the ones currently being proved, appending them to the list of focused goals. If a goal is already solved, it is not added. *) - val tclNEWGOALS : Evar.t list -> unit tactic + val tclNEWGOALS : Proofview_monad.goal_with_state list -> unit tactic (** [tclSETGOALS gls] sets goals [gls] as the goals being under focus. If a goal is already solved, it is not set. *) - val tclSETGOALS : Evar.t list -> unit tactic + val tclSETGOALS : Proofview_monad.goal_with_state list -> unit tactic (** [tclGETGOALS] returns the list of goals under focus. *) - val tclGETGOALS : Evar.t list tactic + val tclGETGOALS : Proofview_monad.goal_with_state list tactic (** Sets the evar universe context. *) val tclEVARUNIVCONTEXT : UState.t -> unit tactic @@ -480,6 +488,7 @@ module Goal : sig val env : t -> Environ.env val sigma : t -> Evd.evar_map val extra : t -> Evd.Store.t + val state : t -> Proofview_monad.StateStore.t (** [nf_enter t] applies the goal-dependent tactic [t] in each goal independently, in the manner of {!tclINDEPENDENT} except that diff --git a/engine/proofview_monad.ml b/engine/proofview_monad.ml index d0f4712258..494765fc42 100644 --- a/engine/proofview_monad.ml +++ b/engine/proofview_monad.ml @@ -149,13 +149,25 @@ module Info = struct CList.map_append (collapse_tree n) f end +module StateStore = Store.Make(struct end) + +(* let (set_state, get_state) = StateDyn.Easy.make_dyn "goal_state" *) + +type goal = Evar.t +type goal_with_state = Evar.t * StateStore.t + +let drop_state = fst +let get_state = snd +let goal_with_state g s = (g, s) +let with_empty_state g = (g, StateStore.empty) +let map_goal_with_state f (g, s) = (f g, s) (** Type of proof views: current [evar_map] together with the list of focused goals. *) type proofview = { solution : Evd.evar_map; - comb : Evar.t list; - shelf : Evar.t list; + comb : goal_with_state list; + shelf : goal list; } (** {6 Instantiation of the logic monad} *) @@ -169,7 +181,7 @@ module P = struct type e = bool (** Status (safe/unsafe) * shelved goals * given up *) - type w = bool * Evar.t list + type w = bool * goal list let wunit = true , [] let wprod (b1, g1) (b2, g2) = b1 && b2 , g1@g2 @@ -209,9 +221,9 @@ module Solution : State with type t := Evd.evar_map = struct let modify f = Pv.modify (fun pv -> { pv with solution = f pv.solution }) end -module Comb : State with type t = Evar.t list = struct +module Comb : State with type t = goal_with_state list = struct (* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *) - type t = Evar.t list + type t = goal_with_state list let get = Logical.map (fun {comb} -> comb) Pv.get let set c = Pv.modify (fun pv -> { pv with comb = c }) let modify f = Pv.modify (fun pv -> { pv with comb = f pv.comb }) @@ -227,17 +239,17 @@ module Status : Writer with type t := bool = struct let put s = Logical.put (s, []) end -module Shelf : State with type t = Evar.t list = struct +module Shelf : State with type t = goal list = struct (* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *) - type t = Evar.t list + type t = goal list let get = Logical.map (fun {shelf} -> shelf) Pv.get let set c = Pv.modify (fun pv -> { pv with shelf = c }) let modify f = Pv.modify (fun pv -> { pv with shelf = f pv.shelf }) end -module Giveup : Writer with type t = Evar.t list = struct +module Giveup : Writer with type t = goal list = struct (* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *) - type t = Evar.t list + type t = goal list let put gs = Logical.put (true, gs) end diff --git a/engine/proofview_monad.mli b/engine/proofview_monad.mli index e7123218b1..d26816fa69 100644 --- a/engine/proofview_monad.mli +++ b/engine/proofview_monad.mli @@ -67,12 +67,21 @@ module Info : sig end +module StateStore : Store.S +type goal = Evar.t +type goal_with_state +val drop_state : goal_with_state -> goal +val get_state : goal_with_state -> StateStore.t +val goal_with_state : goal -> StateStore.t -> goal_with_state +val with_empty_state : goal -> goal_with_state +val map_goal_with_state : (goal -> goal) -> goal_with_state -> goal_with_state + (** Type of proof views: current [evar_map] together with the list of focused goals. *) type proofview = { solution : Evd.evar_map; - comb : Evar.t list; - shelf : Evar.t list; + comb : goal_with_state list; + shelf : goal list; } (** {6 Instantiation of the logic monad} *) @@ -81,7 +90,7 @@ module P : sig type s = proofview * Environ.env (** Status (safe/unsafe) * given up *) - type w = bool * Evar.t list + type w = bool * goal list val wunit : w val wprod : w -> w -> w @@ -118,7 +127,7 @@ module Pv : State with type t := proofview module Solution : State with type t := Evd.evar_map (** Lens to the list of focused goals. *) -module Comb : State with type t = Evar.t list +module Comb : State with type t = goal_with_state list (** Lens to the global environment. *) module Env : State with type t := Environ.env @@ -128,11 +137,11 @@ module Status : Writer with type t := bool (** Lens to the list of goals which have been shelved during the execution of the tactic. *) -module Shelf : State with type t = Evar.t list +module Shelf : State with type t = goal list (** Lens to the list of goals which were given up during the execution of the tactic. *) -module Giveup : Writer with type t = Evar.t list +module Giveup : Writer with type t = goal list (** Lens and utilies pertaining to the info trace *) module InfoL : sig diff --git a/engine/termops.ml b/engine/termops.ml index 40b3d0d8b6..668ae87774 100644 --- a/engine/termops.ml +++ b/engine/termops.ml @@ -797,9 +797,9 @@ let fold_constr_with_binders sigma g f n acc c = each binder traversal; it is not recursive and the order with which subterms are processed is not specified *) -let iter_constr_with_full_binders g f l c = +let iter_constr_with_full_binders sigma g f l c = let open RelDecl in - match kind c with + match EConstr.kind sigma c with | (Rel _ | Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _) -> () | Cast (c,_, t) -> f l c; f l t diff --git a/engine/termops.mli b/engine/termops.mli index a3559a693b..5aa6235f5c 100644 --- a/engine/termops.mli +++ b/engine/termops.mli @@ -76,9 +76,10 @@ val fold_constr_with_full_binders : Evd.evar_map -> (Context.Rel.Declaration.t -> 'a -> 'a) -> ('a -> 'b -> constr -> 'b) -> 'a -> 'b -> constr -> 'b -val iter_constr_with_full_binders : - (Context.Rel.Declaration.t -> 'a -> 'a) -> ('a -> Constr.constr -> unit) -> 'a -> - Constr.constr -> unit +val iter_constr_with_full_binders : Evd.evar_map -> + (rel_declaration -> 'a -> 'a) -> + ('a -> constr -> unit) -> 'a -> + constr -> unit (**********************************************************************) diff --git a/ide/ide_slave.ml b/ide/ide_slave.ml index fe86df0847..8f6ae97608 100644 --- a/ide/ide_slave.ml +++ b/ide/ide_slave.ml @@ -281,7 +281,7 @@ let pattern_of_string ?env s = | Some e -> e in let constr = Pcoq.parse_string Pcoq.Constr.lconstr_pattern s in - let (_, pat) = Constrintern.intern_constr_pattern env constr in + let (_, pat) = Constrintern.intern_constr_pattern env Evd.empty constr in pat let dirpath_of_string_list s = diff --git a/interp/constrintern.ml b/interp/constrintern.ml index d03aa35522..9053cdc249 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -184,14 +184,14 @@ let compute_explicitable_implicit imps = function (* Unable to know in advance what the implicit arguments will be *) [] -let compute_internalization_data env ty typ impl = - let impl = compute_implicits_with_manual env typ (is_implicit_args()) impl in +let compute_internalization_data env sigma ty typ impl = + let impl = compute_implicits_with_manual env sigma typ (is_implicit_args()) impl in let expls_impl = compute_explicitable_implicit impl ty in - (ty, expls_impl, impl, compute_arguments_scope typ) + (ty, expls_impl, impl, compute_arguments_scope sigma typ) -let compute_internalization_env env ?(impls=empty_internalization_env) ty = +let compute_internalization_env env sigma ?(impls=empty_internalization_env) ty = List.fold_left3 - (fun map id typ impl -> Id.Map.add id (compute_internalization_data env ty typ impl) map) + (fun map id typ impl -> Id.Map.add id (compute_internalization_data env sigma ty typ impl) map) impls (**********************************************************************) @@ -2207,9 +2207,9 @@ let extract_ids env = (Termops.ids_of_rel_context (Environ.rel_context env)) Id.Set.empty -let scope_of_type_kind = function +let scope_of_type_kind sigma = function | IsType -> Notation.current_type_scope_name () - | OfType typ -> compute_type_scope (EConstr.Unsafe.to_constr typ) + | OfType typ -> compute_type_scope sigma typ | WithoutTypeConstraint -> None let empty_ltac_sign = { @@ -2218,19 +2218,17 @@ let empty_ltac_sign = { ltac_extra = Genintern.Store.empty; } -let intern_gen kind env +let intern_gen kind env sigma ?(impls=empty_internalization_env) ?(pattern_mode=false) ?(ltacvars=empty_ltac_sign) c = - let tmp_scope = scope_of_type_kind kind in + let tmp_scope = scope_of_type_kind sigma kind in internalize env {ids = extract_ids env; unb = false; tmp_scope = tmp_scope; scopes = []; impls = impls} pattern_mode (ltacvars, Id.Map.empty) c -let intern_constr env c = intern_gen WithoutTypeConstraint env c - -let intern_type env c = intern_gen IsType env c - +let intern_constr env sigma c = intern_gen WithoutTypeConstraint env sigma c +let intern_type env sigma c = intern_gen IsType env sigma c let intern_pattern globalenv patt = try intern_cases_pattern globalenv Id.Map.empty (None,[]) empty_alias patt @@ -2245,7 +2243,7 @@ let intern_pattern globalenv patt = (* All evars resolved *) let interp_gen kind env sigma ?(impls=empty_internalization_env) c = - let c = intern_gen kind ~impls env c in + let c = intern_gen kind ~impls env sigma c in understand ~expected_type:kind env sigma c let interp_constr env sigma ?(impls=empty_internalization_env) c = @@ -2260,13 +2258,13 @@ let interp_casted_constr env sigma ?(impls=empty_internalization_env) c typ = (* Not all evars expected to be resolved *) let interp_open_constr env sigma c = - understand_tcc env sigma (intern_constr env c) + understand_tcc env sigma (intern_constr env sigma c) (* Not all evars expected to be resolved and computation of implicit args *) let interp_constr_evars_gen_impls env sigma ?(impls=empty_internalization_env) expected_type c = - let c = intern_gen expected_type ~impls env c in + let c = intern_gen expected_type ~impls env sigma c in let imps = Implicit_quantifiers.implicits_of_glob_constr ~with_products:(expected_type == IsType) c in let sigma, c = understand_tcc env sigma ~expected_type c in sigma, (c, imps) @@ -2283,7 +2281,7 @@ let interp_type_evars_impls env sigma ?(impls=empty_internalization_env) c = (* Not all evars expected to be resolved, with side-effect on evars *) let interp_constr_evars_gen env sigma ?(impls=empty_internalization_env) expected_type c = - let c = intern_gen expected_type ~impls env c in + let c = intern_gen expected_type ~impls env sigma c in understand_tcc env sigma ~expected_type c let interp_constr_evars env evdref ?(impls=empty_internalization_env) c = @@ -2297,9 +2295,9 @@ let interp_type_evars env sigma ?(impls=empty_internalization_env) c = (* Miscellaneous *) -let intern_constr_pattern env ?(as_type=false) ?(ltacvars=empty_ltac_sign) c = +let intern_constr_pattern env sigma ?(as_type=false) ?(ltacvars=empty_ltac_sign) c = let c = intern_gen (if as_type then IsType else WithoutTypeConstraint) - ~pattern_mode:true ~ltacvars env c in + ~pattern_mode:true ~ltacvars env sigma c in pattern_of_glob_constr c let interp_notation_constr env ?(impls=empty_internalization_env) nenv a = @@ -2323,16 +2321,14 @@ let interp_notation_constr env ?(impls=empty_internalization_env) nenv a = (* Interpret binders and contexts *) let interp_binder env sigma na t = - let t = intern_gen IsType env t in + let t = intern_gen IsType env sigma t in let t' = locate_if_hole ?loc:(loc_of_glob_constr t) na t in understand ~expected_type:IsType env sigma t' -let interp_binder_evars env evdref na t = - let t = intern_gen IsType env t in +let interp_binder_evars env sigma na t = + let t = intern_gen IsType env sigma t in let t' = locate_if_hole ?loc:(loc_of_glob_constr t) na t in - let evd, c = understand_tcc env !evdref ~expected_type:IsType t' in - evdref := evd; - c + understand_tcc env sigma ~expected_type:IsType t' let my_intern_constr env lvar acc c = internalize env acc false lvar c diff --git a/interp/constrintern.mli b/interp/constrintern.mli index 7411fb84bb..563230b59a 100644 --- a/interp/constrintern.mli +++ b/interp/constrintern.mli @@ -7,17 +7,17 @@ (************************************************************************) open Names -open Constr open Evd open Environ +open Misctypes open Libnames open Globnames open Glob_term open Pattern +open EConstr open Constrexpr open Notation_term open Pretyping -open Misctypes (** Translation from front abstract syntax of term to untyped terms (glob_constr) *) @@ -58,10 +58,10 @@ type internalization_env = var_internalization_data Id.Map.t val empty_internalization_env : internalization_env -val compute_internalization_data : env -> var_internalization_type -> +val compute_internalization_data : env -> evar_map -> var_internalization_type -> types -> Impargs.manual_explicitation list -> var_internalization_data -val compute_internalization_env : env -> ?impls:internalization_env -> var_internalization_type -> +val compute_internalization_env : env -> evar_map -> ?impls:internalization_env -> var_internalization_type -> Id.t list -> types list -> Impargs.manual_explicitation list list -> internalization_env @@ -78,11 +78,10 @@ val empty_ltac_sign : ltac_sign (** {6 Internalization performs interpretation of global names and notations } *) -val intern_constr : env -> constr_expr -> glob_constr - -val intern_type : env -> constr_expr -> glob_constr +val intern_constr : env -> evar_map -> constr_expr -> glob_constr +val intern_type : env -> evar_map -> constr_expr -> glob_constr -val intern_gen : typing_constraint -> env -> +val intern_gen : typing_constraint -> env -> evar_map -> ?impls:internalization_env -> ?pattern_mode:bool -> ?ltacvars:ltac_sign -> constr_expr -> glob_constr @@ -100,7 +99,7 @@ val interp_constr : env -> evar_map -> ?impls:internalization_env -> constr_expr -> constr Evd.in_evar_universe_context val interp_casted_constr : env -> evar_map -> ?impls:internalization_env -> - constr_expr -> EConstr.types -> constr Evd.in_evar_universe_context + constr_expr -> types -> constr Evd.in_evar_universe_context val interp_type : env -> evar_map -> ?impls:internalization_env -> constr_expr -> types Evd.in_evar_universe_context @@ -108,37 +107,37 @@ val interp_type : env -> evar_map -> ?impls:internalization_env -> (** Main interpretation function expecting all postponed problems to be resolved, but possibly leaving evars. *) -val interp_open_constr : env -> evar_map -> constr_expr -> evar_map * EConstr.constr +val interp_open_constr : env -> evar_map -> constr_expr -> evar_map * constr (** Accepting unresolved evars *) val interp_constr_evars : env -> evar_map -> - ?impls:internalization_env -> constr_expr -> evar_map * EConstr.constr + ?impls:internalization_env -> constr_expr -> evar_map * constr val interp_casted_constr_evars : env -> evar_map -> - ?impls:internalization_env -> constr_expr -> EConstr.types -> evar_map * EConstr.constr + ?impls:internalization_env -> constr_expr -> types -> evar_map * constr val interp_type_evars : env -> evar_map -> - ?impls:internalization_env -> constr_expr -> evar_map * EConstr.types + ?impls:internalization_env -> constr_expr -> evar_map * types (** Accepting unresolved evars and giving back the manual implicit arguments *) val interp_constr_evars_impls : env -> evar_map -> ?impls:internalization_env -> constr_expr -> - evar_map * (EConstr.constr * Impargs.manual_implicits) + evar_map * (constr * Impargs.manual_implicits) val interp_casted_constr_evars_impls : env -> evar_map -> - ?impls:internalization_env -> constr_expr -> EConstr.types -> - evar_map * (EConstr.constr * Impargs.manual_implicits) + ?impls:internalization_env -> constr_expr -> types -> + evar_map * (constr * Impargs.manual_implicits) val interp_type_evars_impls : env -> evar_map -> ?impls:internalization_env -> constr_expr -> - evar_map * (EConstr.types * Impargs.manual_implicits) + evar_map * (types * Impargs.manual_implicits) (** Interprets constr patterns *) val intern_constr_pattern : - env -> ?as_type:bool -> ?ltacvars:ltac_sign -> + env -> evar_map -> ?as_type:bool -> ?ltacvars:ltac_sign -> constr_pattern_expr -> patvar list * constr_pattern (** Raise Not_found if syndef not bound to a name and error if unexisting ref *) @@ -152,14 +151,14 @@ val interp_reference : ltac_sign -> reference -> glob_constr val interp_binder : env -> evar_map -> Name.t -> constr_expr -> types Evd.in_evar_universe_context -val interp_binder_evars : env -> evar_map ref -> Name.t -> constr_expr -> EConstr.types +val interp_binder_evars : env -> evar_map -> Name.t -> constr_expr -> evar_map * types (** Interpret contexts: returns extended env and context *) val interp_context_evars : ?global_level:bool -> ?impl_env:internalization_env -> ?shift:int -> env -> evar_map -> local_binder_expr list -> - evar_map * (internalization_env * ((env * EConstr.rel_context) * Impargs.manual_implicits)) + evar_map * (internalization_env * ((env * rel_context) * Impargs.manual_implicits)) (* val interp_context_gen : (env -> glob_constr -> unsafe_type_judgment Evd.in_evar_universe_context) -> *) (* (env -> Evarutil.type_constraint -> glob_constr -> unsafe_judgment Evd.in_evar_universe_context) -> *) diff --git a/interp/declare.ml b/interp/declare.ml index dfa84f278e..f6d7b45c3c 100644 --- a/interp/declare.ml +++ b/interp/declare.ml @@ -135,7 +135,7 @@ let set_declare_scheme f = declare_scheme := f let update_tables c = declare_constant_implicits c; Heads.declare_head (EvalConstRef c); - Notation.declare_ref_arguments_scope (ConstRef c) + Notation.declare_ref_arguments_scope Evd.empty (ConstRef c) let register_side_effect (c, role) = let o = inConstant { @@ -275,7 +275,7 @@ let inVariable : variable_obj -> obj = let declare_variable id obj = let oname = add_leaf id (inVariable (Inr (id,obj))) in declare_var_implicits id; - Notation.declare_ref_arguments_scope (VarRef id); + Notation.declare_ref_arguments_scope Evd.empty (VarRef id); Heads.declare_head (EvalVarRef id); oname @@ -283,9 +283,9 @@ let declare_variable id obj = let declare_inductive_argument_scopes kn mie = List.iteri (fun i {mind_entry_consnames=lc} -> - Notation.declare_ref_arguments_scope (IndRef (kn,i)); + Notation.declare_ref_arguments_scope Evd.empty (IndRef (kn,i)); for j=1 to List.length lc do - Notation.declare_ref_arguments_scope (ConstructRef ((kn,i),j)); + Notation.declare_ref_arguments_scope Evd.empty (ConstructRef ((kn,i),j)); done) mie.mind_entry_inds let inductive_names sp kn mie = diff --git a/interp/impargs.ml b/interp/impargs.ml index ed1cd5276c..6767af6d8d 100644 --- a/interp/impargs.ml +++ b/interp/impargs.ml @@ -7,21 +7,20 @@ (************************************************************************) open CErrors +open Pp open Util open Names -open Globnames open Constr -open Reduction +open Globnames open Declarations -open Environ -open Libobject +open Decl_kinds open Lib -open Pp -open Constrexpr +open Libobject +open EConstr open Termops +open Reductionops +open Constrexpr open Namegen -open Decl_kinds -open Context.Named.Declaration module NamedDecl = Context.Named.Declaration @@ -165,8 +164,8 @@ let update pos rig (na,st) = in na, Some e (* modified is_rigid_reference with a truncated env *) -let is_flexible_reference env bound depth f = - match kind f with +let is_flexible_reference env sigma bound depth f = + match kind sigma f with | Rel n when n >= bound+depth -> (* inductive type *) false | Rel n when n >= depth -> (* previous argument *) true | Rel n -> (* since local definitions have been expanded *) false @@ -174,102 +173,101 @@ let is_flexible_reference env bound depth f = let cb = Environ.lookup_constant kn env in (match cb.const_body with Def _ -> true | _ -> false) | Var id -> - env |> Environ.lookup_named id |> is_local_def + env |> Environ.lookup_named id |> NamedDecl.is_local_def | Ind _ | Construct _ -> false | _ -> true let push_lift d (e,n) = (push_rel d e,n+1) -let is_reversible_pattern bound depth f l = - isRel f && let n = destRel f in (n < bound+depth) && (n >= depth) && - Array.for_all (fun c -> isRel c && destRel c < depth) l && +let is_reversible_pattern sigma bound depth f l = + isRel sigma f && let n = destRel sigma f in (n < bound+depth) && (n >= depth) && + Array.for_all (fun c -> isRel sigma c && destRel sigma c < depth) l && Array.distinct l (* Precondition: rels in env are for inductive types only *) -let add_free_rels_until strict strongly_strict revpat bound env m pos acc = +let add_free_rels_until strict strongly_strict revpat bound env sigma m pos acc = let rec frec rig (env,depth as ed) c = - let hd = if strict then whd_all env c else c in + let hd = if strict then whd_all env sigma c else c in let c = if strongly_strict then hd else c in - match kind hd with + match kind sigma hd with | Rel n when (n < bound+depth) && (n >= depth) -> let i = bound + depth - n - 1 in acc.(i) <- update pos rig acc.(i) - | App (f,l) when revpat && is_reversible_pattern bound depth f l -> - let i = bound + depth - destRel f - 1 in + | App (f,l) when revpat && is_reversible_pattern sigma bound depth f l -> + let i = bound + depth - EConstr.destRel sigma f - 1 in acc.(i) <- update pos rig acc.(i) - | App (f,_) when rig && is_flexible_reference env bound depth f -> + | App (f,_) when rig && is_flexible_reference env sigma bound depth f -> if strict then () else - iter_constr_with_full_binders push_lift (frec false) ed c + iter_constr_with_full_binders sigma push_lift (frec false) ed c | Proj (p,c) when rig -> if strict then () else - iter_constr_with_full_binders push_lift (frec false) ed c + iter_constr_with_full_binders sigma push_lift (frec false) ed c | Case _ when rig -> if strict then () else - iter_constr_with_full_binders push_lift (frec false) ed c + iter_constr_with_full_binders sigma push_lift (frec false) ed c | Evar _ -> () | _ -> - iter_constr_with_full_binders push_lift (frec rig) ed c + iter_constr_with_full_binders sigma push_lift (frec rig) ed c in - let () = if not (Vars.noccur_between 1 bound m) then frec true (env,1) m in + let () = if not (Vars.noccur_between sigma 1 bound m) then frec true (env,1) m in acc -let rec is_rigid_head t = match kind t with +let rec is_rigid_head sigma t = match kind sigma t with | Rel _ | Evar _ -> false | Ind _ | Const _ | Var _ | Sort _ -> true - | Case (_,_,f,_) -> is_rigid_head f + | Case (_,_,f,_) -> is_rigid_head sigma f | Proj (p,c) -> true | App (f,args) -> - (match kind f with - | Fix ((fi,i),_) -> is_rigid_head (args.(fi.(i))) - | _ -> is_rigid_head f) + (match kind sigma f with + | Fix ((fi,i),_) -> is_rigid_head sigma (args.(fi.(i))) + | _ -> is_rigid_head sigma f) | Lambda _ | LetIn _ | Construct _ | CoFix _ | Fix _ | Prod _ | Meta _ | Cast _ -> assert false (* calcule la liste des arguments implicites *) let find_displayed_name_in all avoid na (env, b) = - let b = EConstr.of_constr b in let envnames_b = (env, b) in let flag = RenamingElsewhereFor envnames_b in if all then compute_and_force_displayed_name_in Evd.empty flag avoid na b else compute_displayed_name_in Evd.empty flag avoid na b -let compute_implicits_gen strict strongly_strict revpat contextual all env t = +let compute_implicits_gen strict strongly_strict revpat contextual all env sigma (t : EConstr.t) = let rigid = ref true in let open Context.Rel.Declaration in - let rec aux env avoid n names t = - let t = whd_all env t in - match kind t with + let rec aux env avoid n names (t : EConstr.t) = + let t = whd_all env sigma t in + match kind sigma t with | Prod (na,a,b) -> let na',avoid' = find_displayed_name_in all avoid na (names,b) in - add_free_rels_until strict strongly_strict revpat n env a (Hyp (n+1)) + add_free_rels_until strict strongly_strict revpat n env sigma a (Hyp (n+1)) (aux (push_rel (LocalAssum (na',a)) env) avoid' (n+1) (na'::names) b) | _ -> - rigid := is_rigid_head t; + rigid := is_rigid_head sigma t; let names = List.rev names in let v = Array.map (fun na -> na,None) (Array.of_list names) in if contextual then - add_free_rels_until strict strongly_strict revpat n env t Conclusion v + add_free_rels_until strict strongly_strict revpat n env sigma t Conclusion v else v in - match kind (whd_all env t) with + match kind sigma (whd_all env sigma t) with | Prod (na,a,b) -> let na',avoid = find_displayed_name_in all Id.Set.empty na ([],b) in let v = aux (push_rel (LocalAssum (na',a)) env) avoid 1 [na'] b in !rigid, Array.to_list v | _ -> true, [] -let compute_implicits_flags env f all t = +let compute_implicits_flags env sigma f all t = compute_implicits_gen (f.strict || f.strongly_strict) f.strongly_strict - f.reversible_pattern f.contextual all env t + f.reversible_pattern f.contextual all env sigma t -let compute_auto_implicits env flags enriching t = - if enriching then compute_implicits_flags env flags true t - else compute_implicits_gen false false false true true env t +let compute_auto_implicits env sigma flags enriching t = + if enriching then compute_implicits_flags env sigma flags true t + else compute_implicits_gen false false false true true env sigma t -let compute_implicits_names env t = - let _, impls = compute_implicits_gen false false false false true env t in +let compute_implicits_names env sigma t = + let _, impls = compute_implicits_gen false false false false true env sigma t in List.map fst impls (* Extra information about implicit arguments *) @@ -398,24 +396,25 @@ let set_manual_implicits env flags enriching autoimps l = in merge 1 l autoimps -let compute_semi_auto_implicits env f manual t = +let compute_semi_auto_implicits env sigma f manual t = match manual with | [] -> if not f.auto then [DefaultImpArgs, []] - else let _,l = compute_implicits_flags env f false t in + else let _,l = compute_implicits_flags env sigma f false t in [DefaultImpArgs, prepare_implicits f l] | _ -> - let _,autoimpls = compute_auto_implicits env f f.auto t in + let _,autoimpls = compute_auto_implicits env sigma f f.auto t in [DefaultImpArgs, set_manual_implicits env f f.auto autoimpls manual] (*s Constants. *) let compute_constant_implicits flags manual cst = let env = Global.env () in + let sigma = Evd.from_env env in let cb = Environ.lookup_constant cst env in - let ty = cb.const_type in - let impls = compute_semi_auto_implicits env flags manual ty in - impls + let ty = of_constr cb.const_type in + let impls = compute_semi_auto_implicits env sigma flags manual ty in + impls (*s Inductives and constructors. Their implicit arguments are stored in an array, indexed by the inductive number, of pairs $(i,v)$ where @@ -424,7 +423,8 @@ let compute_constant_implicits flags manual cst = let compute_mib_implicits flags manual kn = let env = Global.env () in - let mib = lookup_mind kn env in + let sigma = Evd.from_env env in + let mib = Environ.lookup_mind kn env in let ar = Array.to_list (Array.mapi (* No need to lift, arities contain no de Bruijn *) @@ -433,14 +433,14 @@ let compute_mib_implicits flags manual kn = let ty, _ = Global.type_of_global_in_context env (IndRef (kn,i)) in Context.Rel.Declaration.LocalAssum (Name mip.mind_typename, ty)) mib.mind_packets) in - let env_ar = push_rel_context ar env in + let env_ar = Environ.push_rel_context ar env in let imps_one_inductive i mip = let ind = (kn,i) in let ar, _ = Global.type_of_global_in_context env (IndRef ind) in - ((IndRef ind,compute_semi_auto_implicits env flags manual ar), + ((IndRef ind,compute_semi_auto_implicits env sigma flags manual (of_constr ar)), Array.mapi (fun j c -> - (ConstructRef (ind,j+1),compute_semi_auto_implicits env_ar flags manual c)) - mip.mind_nf_lc) + (ConstructRef (ind,j+1),compute_semi_auto_implicits env_ar sigma flags manual c)) + (Array.map of_constr mip.mind_nf_lc)) in Array.mapi imps_one_inductive mib.mind_packets @@ -453,7 +453,8 @@ let compute_all_mib_implicits flags manual kn = let compute_var_implicits flags manual id = let env = Global.env () in - compute_semi_auto_implicits env flags manual (NamedDecl.get_type (lookup_named id env)) + let sigma = Evd.from_env env in + compute_semi_auto_implicits env sigma flags manual (NamedDecl.get_type (lookup_named id env)) (* Implicits of a global reference. *) @@ -524,7 +525,7 @@ let impls_of_context ctx = | Implicit -> Some (NamedDecl.get_id decl, Manual, (true, true)) | _ -> None in - List.rev_map map (List.filter (fst %> is_local_assum) ctx) + List.rev_map map (List.filter (fst %> NamedDecl.is_local_assum) ctx) let adjust_side_condition p = function | LessArgsThan n -> LessArgsThan (n+p) @@ -649,8 +650,8 @@ type manual_explicitation = Constrexpr.explicitation * (bool * bool * bool) type manual_implicits = manual_explicitation list -let compute_implicits_with_manual env typ enriching l = - let _,autoimpls = compute_auto_implicits env !implicit_args enriching typ in +let compute_implicits_with_manual env sigma typ enriching l = + let _,autoimpls = compute_auto_implicits env sigma !implicit_args enriching typ in set_manual_implicits env !implicit_args enriching autoimpls l let check_inclusion l = @@ -674,9 +675,10 @@ let projection_implicits env p impls = let declare_manual_implicits local ref ?enriching l = let flags = !implicit_args in let env = Global.env () in - let t, _ = Global.type_of_global_in_context (Global.env ()) ref in + let sigma = Evd.from_env env in + let t, _ = Global.type_of_global_in_context env ref in let enriching = Option.default flags.auto enriching in - let isrigid,autoimpls = compute_auto_implicits env flags enriching t in + let isrigid,autoimpls = compute_auto_implicits env sigma flags enriching (of_constr t) in let l' = match l with | [] -> assert false | [l] -> diff --git a/interp/impargs.mli b/interp/impargs.mli index 40fa4cb260..dcfe527b0c 100644 --- a/interp/impargs.mli +++ b/interp/impargs.mli @@ -7,7 +7,7 @@ (************************************************************************) open Names -open Constr +open EConstr open Globnames open Environ @@ -90,10 +90,10 @@ type manual_explicitation = Constrexpr.explicitation * type manual_implicits = manual_explicitation list -val compute_implicits_with_manual : env -> types -> bool -> +val compute_implicits_with_manual : env -> Evd.evar_map -> types -> bool -> manual_implicits -> implicit_status list -val compute_implicits_names : env -> types -> Name.t list +val compute_implicits_names : env -> Evd.evar_map -> types -> Name.t list (** {6 Computation of implicits (done using the global environment). } *) diff --git a/interp/modintern.ml b/interp/modintern.ml index e631b3ea43..128152cc2b 100644 --- a/interp/modintern.ml +++ b/interp/modintern.ml @@ -61,13 +61,16 @@ let transl_with_decl env = function | CWith_Module ((_,fqid),qid) -> WithMod (fqid,lookup_module qid), Univ.ContextSet.empty | CWith_Definition ((_,fqid),c) -> - let c, ectx = interp_constr env (Evd.from_env env) c in + let sigma = Evd.from_env env in + let c, ectx = interp_constr env sigma c in if Flags.is_universe_polymorphism () then let ctx = UState.context ectx in let inst, ctx = Univ.abstract_universes ctx in - let c = Vars.subst_univs_level_constr (Univ.make_instance_subst inst) c in + let c = EConstr.Vars.subst_univs_level_constr (Univ.make_instance_subst inst) c in + let c = EConstr.to_constr sigma c in WithDef (fqid,(c, Some ctx)), Univ.ContextSet.empty else + let c = EConstr.to_constr sigma c in WithDef (fqid,(c, None)), UState.context_set ectx let loc_of_module l = l.CAst.loc diff --git a/interp/notation.ml b/interp/notation.ml index ea7ef21b19..bf39c726a8 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -668,8 +668,8 @@ type scope_class = cl_typ let scope_class_compare : scope_class -> scope_class -> int = cl_typ_ord -let compute_scope_class t = - let (cl,_,_) = find_class_type Evd.empty (EConstr.of_constr t) in +let compute_scope_class sigma t = + let (cl,_,_) = find_class_type sigma t in cl module ScopeClassOrd = @@ -698,22 +698,22 @@ let find_scope_class_opt = function (**********************************************************************) (* Special scopes associated to arguments of a global reference *) -let rec compute_arguments_classes t = - match Constr.kind (EConstr.Unsafe.to_constr (Reductionops.whd_betaiotazeta Evd.empty (EConstr.of_constr t))) with +let rec compute_arguments_classes sigma t = + match EConstr.kind sigma (Reductionops.whd_betaiotazeta sigma t) with | Prod (_,t,u) -> - let cl = try Some (compute_scope_class t) with Not_found -> None in - cl :: compute_arguments_classes u + let cl = try Some (compute_scope_class sigma t) with Not_found -> None in + cl :: compute_arguments_classes sigma u | _ -> [] -let compute_arguments_scope_full t = - let cls = compute_arguments_classes t in +let compute_arguments_scope_full sigma t = + let cls = compute_arguments_classes sigma t in let scs = List.map find_scope_class_opt cls in scs, cls -let compute_arguments_scope t = fst (compute_arguments_scope_full t) +let compute_arguments_scope sigma t = fst (compute_arguments_scope_full sigma t) -let compute_type_scope t = - find_scope_class_opt (try Some (compute_scope_class t) with Not_found -> None) +let compute_type_scope sigma t = + find_scope_class_opt (try Some (compute_scope_class sigma t) with Not_found -> None) let current_type_scope_name () = find_scope_class_opt (Some CL_SORT) @@ -779,20 +779,24 @@ let discharge_arguments_scope (_,(req,r,n,l,_)) = let classify_arguments_scope (req,_,_,_,_ as obj) = if req == ArgsScopeNoDischarge then Dispose else Substitute obj -let rebuild_arguments_scope (req,r,n,l,_) = +let rebuild_arguments_scope sigma (req,r,n,l,_) = match req with | ArgsScopeNoDischarge -> assert false | ArgsScopeAuto -> - let scs,cls = compute_arguments_scope_full (fst(Global.type_of_global_in_context (Global.env ()) r)(*FIXME?*)) in - (req,r,List.length scs,scs,cls) + let env = Global.env () in (*FIXME?*) + let typ = EConstr.of_constr @@ fst (Global.type_of_global_in_context env r) in + let scs,cls = compute_arguments_scope_full sigma typ in + (req,r,List.length scs,scs,cls) | ArgsScopeManual -> - (* Add to the manually given scopes the one found automatically - for the extra parameters of the section. Discard the classes - of the manually given scopes to avoid further re-computations. *) - let l',cls = compute_arguments_scope_full (fst (Global.type_of_global_in_context (Global.env ()) r)) in - let l1 = List.firstn n l' in - let cls1 = List.firstn n cls in - (req,r,0,l1@l,cls1) + (* Add to the manually given scopes the one found automatically + for the extra parameters of the section. Discard the classes + of the manually given scopes to avoid further re-computations. *) + let env = Global.env () in (*FIXME?*) + let typ = EConstr.of_constr @@ fst (Global.type_of_global_in_context env r) in + let l',cls = compute_arguments_scope_full sigma typ in + let l1 = List.firstn n l' in + let cls1 = List.firstn n cls in + (req,r,0,l1@l,cls1) type arguments_scope_obj = arguments_scope_discharge_request * global_reference * @@ -807,7 +811,8 @@ let inArgumentsScope : arguments_scope_obj -> obj = subst_function = subst_arguments_scope; classify_function = classify_arguments_scope; discharge_function = discharge_arguments_scope; - rebuild_function = rebuild_arguments_scope } + (* XXX: Should we pass the sigma here or not, see @herbelin's comment in 6511 *) + rebuild_function = rebuild_arguments_scope Evd.empty } let is_local local ref = local || isVarRef ref && Lib.is_in_section ref @@ -819,7 +824,7 @@ let declare_arguments_scope local r scl = (* We empty the list of argument classes to disable further scope re-computations and keep these manually given scopes. *) declare_arguments_scope_gen req r 0 (scl,[]) - + let find_arguments_scope r = try let (scl,cls,stamp) = Refmap.find r !arguments_scope in @@ -832,12 +837,12 @@ let find_arguments_scope r = scl' with Not_found -> [] -let declare_ref_arguments_scope ref = - let t, _ = Global.type_of_global_in_context (Global.env ()) ref in - let (scs,cls as o) = compute_arguments_scope_full t in +let declare_ref_arguments_scope sigma ref = + let env = Global.env () in (* FIXME? *) + let typ = EConstr.of_constr @@ fst @@ Global.type_of_global_in_context env ref in + let (scs,cls as o) = compute_arguments_scope_full sigma typ in declare_arguments_scope_gen ArgsScopeAuto ref (List.length scs) o - (********************************) (* Encoding notations as string *) diff --git a/interp/notation.mli b/interp/notation.mli index a4c79d6d35..79b56bd410 100644 --- a/interp/notation.mli +++ b/interp/notation.mli @@ -163,10 +163,10 @@ val subst_scope_class : Mod_subst.substitution -> scope_class -> scope_class option val declare_scope_class : scope_name -> scope_class -> unit -val declare_ref_arguments_scope : global_reference -> unit +val declare_ref_arguments_scope : Evd.evar_map -> global_reference -> unit -val compute_arguments_scope : Constr.types -> scope_name option list -val compute_type_scope : Constr.types -> scope_name option +val compute_arguments_scope : Evd.evar_map -> EConstr.types -> scope_name option list +val compute_type_scope : Evd.evar_map -> EConstr.types -> scope_name option (** Get the current scope bound to Sortclass, if it exists *) val current_type_scope_name : unit -> scope_name option diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml index 98e507309f..abca1307f8 100644 --- a/interp/syntax_def.ml +++ b/interp/syntax_def.ml @@ -88,12 +88,11 @@ let pr_compat_warning (kn, def, v) = | [], NRef r -> spc () ++ str "is" ++ spc () ++ pr_global_env Id.Set.empty r | _ -> strbrk " is a compatibility notation" in - let since = strbrk " since Coq > " ++ str (Flags.pr_version v) ++ str "." in - pr_syndef kn ++ pp_def ++ since + pr_syndef kn ++ pp_def let warn_compatibility_notation = CWarnings.(create ~name:"compatibility-notation" - ~category:"deprecated" ~default:Disabled pr_compat_warning) + ~category:"deprecated" ~default:Enabled pr_compat_warning) let verbose_compat kn def = function | Some v when Flags.version_strictly_greater v -> diff --git a/kernel/cbytecodes.ml b/kernel/cbytecodes.ml index 05399cc04c..6ed1ba5391 100644 --- a/kernel/cbytecodes.ml +++ b/kernel/cbytecodes.ml @@ -32,13 +32,12 @@ let cofix_evaluated_tag = 7 let last_variant_tag = 245 type structured_constant = - | Const_sorts of Sorts.t + | Const_sort of Sorts.t | Const_ind of inductive | Const_proj of Constant.t | Const_b0 of tag | Const_bn of tag * structured_constant array | Const_univ_level of Univ.Level.t - | Const_type of Univ.Universe.t type reloc_table = (tag * int) array @@ -46,8 +45,8 @@ type annot_switch = {ci : case_info; rtbl : reloc_table; tailcall : bool; max_stack_size : int} let rec eq_structured_constant c1 c2 = match c1, c2 with -| Const_sorts s1, Const_sorts s2 -> Sorts.equal s1 s2 -| Const_sorts _, _ -> false +| Const_sort s1, Const_sort s2 -> Sorts.equal s1 s2 +| Const_sort _, _ -> false | Const_ind i1, Const_ind i2 -> eq_ind i1 i2 | Const_ind _, _ -> false | Const_proj p1, Const_proj p2 -> Constant.equal p1 p2 @@ -59,13 +58,11 @@ let rec eq_structured_constant c1 c2 = match c1, c2 with | Const_bn _, _ -> false | Const_univ_level l1 , Const_univ_level l2 -> Univ.Level.equal l1 l2 | Const_univ_level _ , _ -> false -| Const_type u1 , Const_type u2 -> Univ.Universe.equal u1 u2 -| Const_type _ , _ -> false let rec hash_structured_constant c = let open Hashset.Combine in match c with - | Const_sorts s -> combinesmall 1 (Sorts.hash s) + | Const_sort s -> combinesmall 1 (Sorts.hash s) | Const_ind i -> combinesmall 2 (ind_hash i) | Const_proj p -> combinesmall 3 (Constant.hash p) | Const_b0 t -> combinesmall 4 (Int.hash t) @@ -74,7 +71,6 @@ let rec hash_structured_constant c = let h = Array.fold_left fold 0 a in combinesmall 5 (combine (Int.hash t) h) | Const_univ_level l -> combinesmall 6 (Univ.Level.hash l) - | Const_type u -> combinesmall 7 (Univ.Universe.hash u) let eq_annot_switch asw1 asw2 = let eq_ci ci1 ci2 = @@ -240,20 +236,19 @@ open Util let pp_sort s = let open Sorts in - match family s with - | InSet -> str "Set" - | InProp -> str "Prop" - | InType -> str "Type" + match s with + | Prop Null -> str "Prop" + | Prop Pos -> str "Set" + | Type u -> str "Type@{" ++ Univ.pr_uni u ++ str "}" let rec pp_struct_const = function - | Const_sorts s -> pp_sort s + | Const_sort s -> pp_sort s | Const_ind (mind, i) -> MutInd.print mind ++ str"#" ++ int i | Const_proj p -> Constant.print p | Const_b0 i -> int i | Const_bn (i,t) -> int i ++ surround (prvect_with_sep pr_comma pp_struct_const t) | Const_univ_level l -> Univ.Level.pr l - | Const_type u -> str "Type@{" ++ Univ.pr_uni u ++ str "}" let pp_lbl lbl = str "L" ++ int lbl diff --git a/kernel/cbytecodes.mli b/kernel/cbytecodes.mli index 47d8d95641..11e07c00e9 100644 --- a/kernel/cbytecodes.mli +++ b/kernel/cbytecodes.mli @@ -26,13 +26,12 @@ val cofix_evaluated_tag : tag val last_variant_tag : tag type structured_constant = - | Const_sorts of Sorts.t + | Const_sort of Sorts.t | Const_ind of inductive | Const_proj of Constant.t | Const_b0 of tag | Const_bn of tag * structured_constant array | Const_univ_level of Univ.Level.t - | Const_type of Univ.Universe.t val pp_struct_const : structured_constant -> Pp.t diff --git a/kernel/cbytegen.ml b/kernel/cbytegen.ml index 3619bb94e7..10f82438cd 100644 --- a/kernel/cbytegen.ml +++ b/kernel/cbytegen.ml @@ -496,23 +496,23 @@ let rec compile_lam env reloc lam sz cont = (Const_ind ind) (Univ.Instance.to_array u) sz cont | Lsort (Sorts.Prop _ as s) -> - compile_structured_constant reloc (Const_sorts s) sz cont + compile_structured_constant reloc (Const_sort s) sz cont | Lsort (Sorts.Type u) -> - (* We separate global and local universes in [u]. The former will be part - of the structured constant, while the later (if any) will be applied as - arguments. *) - let open Univ in begin + (* We separate global and local universes in [u]. The former will be part + of the structured constant, while the later (if any) will be applied as + arguments. *) + let open Univ in begin let u,s = Universe.compact u in (* We assume that [Universe.type0m] is a neutral element for [Universe.sup] *) + let compile_get_univ reloc idx sz cont = + set_max_stack_size sz; + compile_fv_elem reloc (FVuniv_var idx) sz cont + in if List.is_empty s then - compile_structured_constant reloc (Const_sorts (Sorts.Type u)) sz cont + compile_structured_constant reloc (Const_sort (Sorts.Type u)) sz cont else - let compile_get_univ reloc idx sz cont = - set_max_stack_size sz; - compile_fv_elem reloc (FVuniv_var idx) sz cont - in comp_app compile_structured_constant compile_get_univ reloc - (Const_type u) (Array.of_list s) sz cont + (Const_sort (Sorts.Type u)) (Array.of_list s) sz cont end | Llet (id,def,body) -> diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml index 856b0b465c..32d5387b23 100644 --- a/kernel/cemitcodes.ml +++ b/kernel/cemitcodes.ml @@ -350,7 +350,7 @@ type to_patch = emitcodes * patches * fv (* Substitution *) let rec subst_strcst s sc = match sc with - | Const_sorts _ | Const_b0 _ | Const_univ_level _ | Const_type _ -> sc + | Const_sort _ | Const_b0 _ | Const_univ_level _ -> sc | Const_proj p -> Const_proj (subst_constant s p) | Const_bn(tag,args) -> Const_bn(tag,Array.map (subst_strcst s) args) | Const_ind ind -> let kn,i = ind in Const_ind (subst_mind s kn, i) diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml index f1e8d10317..5dca69c165 100644 --- a/kernel/uGraph.ml +++ b/kernel/uGraph.ml @@ -833,7 +833,7 @@ let sort_universes g = (** Subtyping of polymorphic contexts *) let check_subtype univs ctxT ctx = - if AUContext.size ctx == AUContext.size ctx then + if AUContext.size ctxT == AUContext.size ctx then let (inst, cst) = UContext.dest (AUContext.repr ctx) in let cstT = UContext.constraints (AUContext.repr ctxT) in let push accu v = add_universe v false accu in diff --git a/kernel/vconv.ml b/kernel/vconv.ml index 84303fc215..f11803b67c 100644 --- a/kernel/vconv.ml +++ b/kernel/vconv.ml @@ -44,7 +44,6 @@ let rec conv_val env pb k v1 v2 cu = and conv_whd env pb k whd1 whd2 cu = (* Pp.(msg_debug (str "conv_whd(" ++ pr_whd whd1 ++ str ", " ++ pr_whd whd2 ++ str ")")) ; *) match whd1, whd2 with - | Vsort s1, Vsort s2 -> sort_cmp_universes env pb s1 s2 cu | Vuniv_level _ , _ | _ , Vuniv_level _ -> (** Both of these are invalid since universes are handled via @@ -81,7 +80,7 @@ and conv_whd env pb k whd1 whd2 cu = (* on the fly eta expansion *) conv_val env CONV (k+1) (apply_whd k whd1) (apply_whd k whd2) cu - | Vsort _, _ | Vprod _, _ | Vfix _, _ | Vcofix _, _ | Vconstr_const _, _ + | Vprod _, _ | Vfix _, _ | Vcofix _, _ | Vconstr_const _, _ | Vconstr_block _, _ | Vatom_stk _, _ -> raise NotConvertible @@ -119,8 +118,9 @@ and conv_atom env pb k a1 stk1 a2 stk2 cu = if Vmvalues.eq_id_key ik1 ik2 && compare_stack stk1 stk2 then conv_stack env k stk1 stk2 cu else raise NotConvertible - | Atype _ , _ | _, Atype _ -> assert false - | Aind _, _ | Aid _, _ -> raise NotConvertible + | Asort s1, Asort s2 -> + sort_cmp_universes env pb s1 s2 cu + | Asort _ , _ | Aind _, _ | Aid _, _ -> raise NotConvertible and conv_stack env k stk1 stk2 cu = match stk1, stk2 with diff --git a/kernel/vm.ml b/kernel/vm.ml index 0f6e09521c..a1b0c697c7 100644 --- a/kernel/vm.ml +++ b/kernel/vm.ml @@ -166,7 +166,7 @@ let rec apply_stack a stk v = let apply_whd k whd = let v = val_of_rel k in match whd with - | Vsort _ | Vprod _ | Vconstr_const _ | Vconstr_block _ -> assert false + | Vprod _ | Vconstr_const _ | Vconstr_block _ -> assert false | Vfun f -> reduce_fun k f | Vfix(f, None) -> push_ra stop; diff --git a/kernel/vmvalues.ml b/kernel/vmvalues.ml index 039b75e1c5..a286d25514 100644 --- a/kernel/vmvalues.ml +++ b/kernel/vmvalues.ml @@ -134,7 +134,7 @@ let eq_id_key k1 k2 = match k1, k2 with type atom = | Aid of id_key | Aind of inductive - | Atype of Univ.Universe.t + | Asort of Sorts.t (* Zippers *) @@ -149,7 +149,6 @@ type stack = zipper list type to_update = values type whd = - | Vsort of Sorts.t | Vprod of vprod | Vfun of vfun | Vfix of vfix * arguments option @@ -180,7 +179,6 @@ let uni_lvl_val (v : values) : Univ.Level.t = let pr = let open Pp in match whd with - | Vsort _ -> str "Vsort" | Vprod _ -> str "Vprod" | Vfun _ -> str "Vfun" | Vfix _ -> str "Vfix" @@ -202,12 +200,17 @@ let rec whd_accu a stk = match Obj.tag at with | i when Int.equal i type_atom_tag -> begin match stk with + | [] -> Vatom_stk(Obj.magic at, stk) | [Zapp args] -> let args = Array.init (nargs args) (arg args) in - let u = Obj.obj (Obj.field at 0) in - let inst = Instance.of_array (Array.map uni_lvl_val args) in - let u = Univ.subst_instance_universe inst u in - Vsort (Type u) + let s = Obj.obj (Obj.field at 0) in + begin match s with + | Type u -> + let inst = Instance.of_array (Array.map uni_lvl_val args) in + let u = Univ.subst_instance_universe inst u in + Vatom_stk (Asort (Type u), []) + | _ -> assert false + end | _ -> assert false end | i when i <= max_atom_tag -> @@ -256,11 +259,8 @@ let whd_val : values -> whd = else let tag = Obj.tag o in if tag = accu_tag then - ( - if Int.equal (Obj.size o) 1 then Obj.obj o (* sort *) - else - if is_accumulate (fun_code o) then whd_accu o [] - else Vprod(Obj.obj o)) + if is_accumulate (fun_code o) then whd_accu o [] + else Vprod(Obj.obj o) else if tag = Obj.closure_tag || tag = Obj.infix_tag then (match kind_of_closure o with @@ -286,7 +286,7 @@ let obj_of_atom : atom -> Obj.t = (* obj_of_str_const : structured_constant -> Obj.t *) let rec obj_of_str_const str = match str with - | Const_sorts s -> Obj.repr (Vsort s) + | Const_sort s -> obj_of_atom (Asort s) | Const_ind ind -> obj_of_atom (Aind ind) | Const_proj p -> Obj.repr p | Const_b0 tag -> Obj.repr tag @@ -298,7 +298,6 @@ let rec obj_of_str_const str = done; res | Const_univ_level l -> Obj.repr (Vuniv_level l) - | Const_type u -> obj_of_atom (Atype u) let val_of_obj o = ((Obj.obj o) : values) @@ -518,10 +517,9 @@ let rec pr_atom a = | RelKey i -> str "#" ++ int i | _ -> str "...") ++ str ")" | Aind (mi,i) -> str "Aind(" ++ MutInd.print mi ++ str "#" ++ int i ++ str ")" - | Atype _ -> str "Atype(") + | Asort _ -> str "Asort(") and pr_whd w = Pp.(match w with - | Vsort _ -> str "Vsort" | Vprod _ -> str "Vprod" | Vfun _ -> str "Vfun" | Vfix _ -> str "Vfix" diff --git a/kernel/vmvalues.mli b/kernel/vmvalues.mli index 8f39cfae4a..86debd5d57 100644 --- a/kernel/vmvalues.mli +++ b/kernel/vmvalues.mli @@ -65,7 +65,7 @@ val eq_id_key : id_key -> id_key -> bool type atom = | Aid of id_key | Aind of inductive - | Atype of Univ.Universe.t + | Asort of Sorts.t (** Zippers *) @@ -78,7 +78,6 @@ type zipper = type stack = zipper list type whd = - | Vsort of Sorts.t | Vprod of vprod | Vfun of vfun | Vfix of vfix * arguments option diff --git a/lib/flags.ml b/lib/flags.ml index 5da1310206..12ed2a4503 100644 --- a/lib/flags.ml +++ b/lib/flags.ml @@ -67,17 +67,11 @@ let we_are_parsing = ref false (* Current means no particular compatibility consideration. For correct comparisons, this constructor should remain the last one. *) -type compat_version = VOld | V8_5 | V8_6 | V8_7 | Current +type compat_version = V8_6 | V8_7 | Current let compat_version = ref Current let version_compare v1 v2 = match v1, v2 with - | VOld, VOld -> 0 - | VOld, _ -> -1 - | _, VOld -> 1 - | V8_5, V8_5 -> 0 - | V8_5, _ -> -1 - | _, V8_5 -> 1 | V8_6, V8_6 -> 0 | V8_6, _ -> -1 | _, V8_6 -> 1 @@ -90,8 +84,6 @@ let version_strictly_greater v = version_compare !compat_version v > 0 let version_less_or_equal v = not (version_strictly_greater v) let pr_version = function - | VOld -> "old" - | V8_5 -> "8.5" | V8_6 -> "8.6" | V8_7 -> "8.7" | Current -> "current" diff --git a/lib/flags.mli b/lib/flags.mli index bc07dec804..148b2ca5e2 100644 --- a/lib/flags.mli +++ b/lib/flags.mli @@ -43,7 +43,7 @@ val raw_print : bool ref (* Univ print flag, never set anywere. Maybe should belong to Univ? *) val univ_print : bool ref -type compat_version = VOld | V8_5 | V8_6 | V8_7 | Current +type compat_version = V8_6 | V8_7 | Current val compat_version : compat_version ref val version_compare : compat_version -> compat_version -> int val version_strictly_greater : compat_version -> bool diff --git a/parsing/cLexer.ml4 b/parsing/cLexer.ml4 index 52a6fe16c6..d7e3751fd7 100644 --- a/parsing/cLexer.ml4 +++ b/parsing/cLexer.ml4 @@ -384,16 +384,6 @@ let comments = ref [] let current_comment = Buffer.create 8192 let between_commands = ref true -let rec split_comments comacc acc pos = function - [] -> comments := List.rev acc; comacc - | ((b,e),c as com)::coms -> - (* Take all comments that terminates before pos, or begin exactly - at pos (used to print comments attached after an expression) *) - if e<=pos || pos=b then split_comments (c::comacc) acc pos coms - else split_comments comacc (com::acc) pos coms - -let extract_comments pos = split_comments [] [] pos !comments - (* The state of the lexer visible from outside *) type lexer_state = int option * string * bool * ((int * int) * string) list * Loc.source @@ -410,6 +400,8 @@ let release_lexer_state = get_lexer_state let drop_lexer_state () = set_lexer_state (init_lexer_state Loc.ToplevelInput) +let get_comment_state (_,_,_,c,_) = c + let real_push_char c = Buffer.add_char current_comment c (* Add a char if it is between two commands, if it is a newline or diff --git a/parsing/cLexer.mli b/parsing/cLexer.mli index 5f4e10f145..2d35571f11 100644 --- a/parsing/cLexer.mli +++ b/parsing/cLexer.mli @@ -55,7 +55,4 @@ val get_lexer_state : unit -> lexer_state val release_lexer_state : unit -> lexer_state [@@ocaml.deprecated "Use get_lexer_state"] val drop_lexer_state : unit -> unit - -(* Retrieve the comments lexed at a given location of the stream - currently being processeed *) -val extract_comments : int -> string list +val get_comment_state : lexer_state -> ((int * int) * string) list diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4 index 93e534e0bd..4d6741ff5e 100644 --- a/parsing/g_vernac.ml4 +++ b/parsing/g_vernac.ml4 @@ -56,9 +56,7 @@ let parse_compat_version ?(allow_old = true) = let open Flags in function | "8.8" -> Current | "8.7" -> V8_7 | "8.6" -> V8_6 - | "8.5" -> V8_5 - | ("8.4" | "8.3" | "8.2" | "8.1" | "8.0") as s -> - if allow_old then VOld else + | ("8.5" | "8.4" | "8.3" | "8.2" | "8.1" | "8.0") as s -> CErrors.user_err ~hdr:"get_compat_version" Pp.(str "Compatibility with version " ++ str s ++ str " not supported.") | s -> diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml index 7a51908d91..fec26f9415 100644 --- a/parsing/pcoq.ml +++ b/parsing/pcoq.ml @@ -88,7 +88,9 @@ module type S = val entry_create : string -> 'a entry val entry_parse : 'a entry -> coq_parsable -> 'a val entry_print : Format.formatter -> 'a entry -> unit - val with_parsable : coq_parsable -> ('a -> 'b) -> 'a -> 'b + + val comment_state : coq_parsable -> ((int * int) * string) list + val srules' : production_rule list -> symbol val parse_tokens_after_filter : 'a entry -> Tok.t Stream.t -> 'a @@ -105,6 +107,7 @@ end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e = struct string option * Gramext.g_assoc option * production_rule list type extend_statment = Gramext.position option * single_extend_statment list + type coq_parsable = parsable * CLexer.lexer_state ref let parsable ?(file=Loc.ToplevelInput) c = @@ -129,15 +132,8 @@ end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e = struct let loc = match loc' with None -> to_coqloc loc | Some loc -> loc in Loc.raise ~loc e - let with_parsable (p,state) f x = - CLexer.set_lexer_state !state; - try - let a = f x in - state := CLexer.get_lexer_state (); - a - with e -> - CLexer.drop_lexer_state (); - raise e + let comment_state (p,state) = + CLexer.get_comment_state !state let entry_print ft x = Entry.print ft x diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index f36250176a..1b330aa047 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -78,7 +78,9 @@ module type S = val entry_create : string -> 'a entry val entry_parse : 'a entry -> coq_parsable -> 'a val entry_print : Format.formatter -> 'a entry -> unit - val with_parsable : coq_parsable -> ('a -> 'b) -> 'a -> 'b + + (* Get comment parsing information from the Lexer *) + val comment_state : coq_parsable -> ((int * int) * string) list (* Apparently not used *) val srules' : production_rule list -> symbol diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml index 22881c32c7..7159614d94 100644 --- a/plugins/funind/glob_term_to_relation.ml +++ b/plugins/funind/glob_term_to_relation.ml @@ -352,9 +352,9 @@ let raw_push_named (na,raw_value,raw_typ) env = let typ,_ = Pretyping.understand env (Evd.from_env env) ~expected_type:Pretyping.IsType raw_typ in (match raw_value with | None -> - Environ.push_named (NamedDecl.LocalAssum (id,typ)) env + EConstr.push_named (NamedDecl.LocalAssum (id,typ)) env | Some value -> - Environ.push_named (NamedDecl.LocalDef (id, value, typ)) env) + EConstr.push_named (NamedDecl.LocalDef (id, value, typ)) env) let add_pat_variables pat typ env : Environ.env = @@ -519,7 +519,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return = The "value" of this branch is then simply [res] *) let rt_as_constr,ctx = Pretyping.understand env (Evd.from_env env) rt in - let rt_typ = Typing.unsafe_type_of env (Evd.from_env env) (EConstr.of_constr rt_as_constr) in + let rt_typ = Typing.unsafe_type_of env (Evd.from_env env) rt_as_constr in let res_raw_type = Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_env env) rt_typ in let res = fresh_id args_res.to_avoid "_res" in let new_avoid = res::args_res.to_avoid in @@ -631,12 +631,11 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return = let v = match typ with None -> v | Some t -> DAst.make ?loc:rt.loc @@ GCast (v,CastConv t) in let v_res = build_entry_lc env funnames avoid v in let v_as_constr,ctx = Pretyping.understand env (Evd.from_env env) v in - let v_type = Typing.unsafe_type_of env (Evd.from_env env) (EConstr.of_constr v_as_constr) in - let v_type = EConstr.Unsafe.to_constr v_type in + let v_type = Typing.unsafe_type_of env (Evd.from_env env) v_as_constr in let new_env = match n with Anonymous -> env - | Name id -> Environ.push_named (NamedDecl.LocalDef (id,v_as_constr,v_type)) env + | Name id -> EConstr.push_named (NamedDecl.LocalDef (id,v_as_constr,v_type)) env in let b_res = build_entry_lc new_env funnames avoid b in combine_results (combine_letin n) v_res b_res @@ -648,7 +647,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return = build_entry_lc_from_case env funnames make_discr el brl avoid | GIf(b,(na,e_option),lhs,rhs) -> let b_as_constr,ctx = Pretyping.understand env (Evd.from_env env) b in - let b_typ = Typing.unsafe_type_of env (Evd.from_env env) (EConstr.of_constr b_as_constr) in + let b_typ = Typing.unsafe_type_of env (Evd.from_env env) b_as_constr in let (ind,_) = try Inductiveops.find_inductive env (Evd.from_env env) b_typ with Not_found -> @@ -680,7 +679,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return = nal in let b_as_constr,ctx = Pretyping.understand env (Evd.from_env env) b in - let b_typ = Typing.unsafe_type_of env (Evd.from_env env) (EConstr.of_constr b_as_constr) in + let b_typ = Typing.unsafe_type_of env (Evd.from_env env) b_as_constr in let (ind,_) = try Inductiveops.find_inductive env (Evd.from_env env) b_typ with Not_found -> @@ -726,7 +725,7 @@ and build_entry_lc_from_case env funname make_discr let types = List.map (fun (case_arg,_) -> let case_arg_as_constr,ctx = Pretyping.understand env (Evd.from_env env) case_arg in - EConstr.Unsafe.to_constr (Typing.unsafe_type_of env (Evd.from_env env) (EConstr.of_constr case_arg_as_constr)) + EConstr.Unsafe.to_constr (Typing.unsafe_type_of env (Evd.from_env env) case_arg_as_constr) ) el in (****** The next works only if the match is not dependent ****) @@ -948,7 +947,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = mkGApp(mkGVar(mk_rel_id this_relname),List.tl args'@[res_rt]) in let t',ctx = Pretyping.understand env (Evd.from_env env) new_t in - let new_env = Environ.push_rel (LocalAssum (n,t')) env in + let new_env = EConstr.push_rel (LocalAssum (n,t')) env in let new_b,id_to_exclude = rebuild_cons new_env nb_args relname @@ -983,7 +982,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = let subst_b = if is_in_b then b else replace_var_by_term id rt b in - let new_env = Environ.push_rel (LocalAssum (n,t')) env in + let new_env = EConstr.push_rel (LocalAssum (n,t')) env in let new_b,id_to_exclude = rebuild_cons new_env @@ -995,7 +994,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = with Continue -> let jmeq = Globnames.IndRef (fst (EConstr.destInd Evd.empty (jmeq ()))) in let ty',ctx = Pretyping.understand env (Evd.from_env env) ty in - let ind,args' = Inductive.find_inductive env ty' in + let ind,args' = Inductiveops.find_inductive env Evd.(from_env env) ty' in let mib,_ = Global.lookup_inductive (fst ind) in let nparam = mib.Declarations.mind_nparams in let params,arg' = @@ -1017,14 +1016,14 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = observe (str "computing new type for jmeq : " ++ pr_glob_constr_env env eq'); let eq'_as_constr,ctx = Pretyping.understand env (Evd.from_env env) eq' in observe (str " computing new type for jmeq : done") ; + let sigma = Evd.(from_env env) in let new_args = - match Constr.kind eq'_as_constr with + match EConstr.kind sigma eq'_as_constr with | App(_,[|_;_;ty;_|]) -> - let ty = Array.to_list (snd (destApp ty)) in + let ty = Array.to_list (snd (EConstr.destApp sigma ty)) in let ty' = snd (Util.List.chop nparam ty) in List.fold_left2 (fun acc var_as_constr arg -> - let arg = EConstr.of_constr arg in if isRel var_as_constr then let na = RelDecl.get_name (Environ.lookup_rel (destRel var_as_constr) env) in @@ -1065,7 +1064,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = in let new_env = let t',ctx = Pretyping.understand env (Evd.from_env env) eq' in - Environ.push_rel (LocalAssum (n,t')) env + EConstr.push_rel (LocalAssum (n,t')) env in let new_b,id_to_exclude = rebuild_cons @@ -1103,7 +1102,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = with Continue -> observe (str "computing new type for prod : " ++ pr_glob_constr_env env rt); let t',ctx = Pretyping.understand env (Evd.from_env env) t in - let new_env = Environ.push_rel (LocalAssum (n,t')) env in + let new_env = EConstr.push_rel (LocalAssum (n,t')) env in let new_b,id_to_exclude = rebuild_cons new_env nb_args relname @@ -1119,7 +1118,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = | _ -> observe (str "computing new type for prod : " ++ pr_glob_constr_env env rt); let t',ctx = Pretyping.understand env (Evd.from_env env) t in - let new_env = Environ.push_rel (LocalAssum (n,t')) env in + let new_env = EConstr.push_rel (LocalAssum (n,t')) env in let new_b,id_to_exclude = rebuild_cons new_env nb_args relname @@ -1140,7 +1139,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = let t',ctx = Pretyping.understand env (Evd.from_env env) t in match n with | Name id -> - let new_env = Environ.push_rel (LocalAssum (n,t')) env in + let new_env = EConstr.push_rel (LocalAssum (n,t')) env in let new_b,id_to_exclude = rebuild_cons new_env nb_args relname @@ -1163,7 +1162,8 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = let evd = (Evd.from_env env) in let t',ctx = Pretyping.understand env evd t in let evd = Evd.from_ctx ctx in - let type_t' = Typing.unsafe_type_of env evd (EConstr.of_constr t') in + let type_t' = Typing.unsafe_type_of env evd t' in + let t' = EConstr.Unsafe.to_constr t' in let type_t' = EConstr.Unsafe.to_constr type_t' in let new_env = Environ.push_rel (LocalDef (n,t',type_t')) env in let new_b,id_to_exclude = @@ -1189,7 +1189,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt = depth t in let t',ctx = Pretyping.understand env (Evd.from_env env) new_t in - let new_env = Environ.push_rel (LocalAssum (na,t')) env in + let new_env = EConstr.push_rel (LocalAssum (na,t')) env in let new_b,id_to_exclude = rebuild_cons new_env nb_args relname @@ -1369,8 +1369,9 @@ let do_build_inductive *) let rel_arities = Array.mapi rel_arity funsargs in Util.Array.fold_left2 (fun env rel_name rel_ar -> - Environ.push_named (LocalAssum (rel_name, - fst (with_full_print (Constrintern.interp_constr env evd) rel_ar))) env) env relnames rel_arities + let rex = fst (with_full_print (Constrintern.interp_constr env evd) rel_ar) in + let rex = EConstr.Unsafe.to_constr rex in + Environ.push_named (LocalAssum (rel_name,rex)) env) env relnames rel_arities in (* and of the real constructors*) let constr i res = diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml index e19fc9b624..13eda3952a 100644 --- a/plugins/funind/indfun.ml +++ b/plugins/funind/indfun.ml @@ -141,8 +141,7 @@ let rec abstract_glob_constr c = function | Constrexpr.CLocalPattern _::bl -> assert false let interp_casted_constr_with_implicits env sigma impls c = - Constrintern.intern_gen Pretyping.WithoutTypeConstraint env ~impls - c + Constrintern.intern_gen Pretyping.WithoutTypeConstraint env sigma ~impls c (* Construct a fixpoint as a Glob_term @@ -160,9 +159,9 @@ let build_newrecursive let arity,ctx = Constrintern.interp_type env0 sigma arityc in let evd = Evd.from_env env0 in let evd, (_, (_, impls')) = Constrintern.interp_context_evars env evd bl in - let impl = Constrintern.compute_internalization_data env0 Constrintern.Recursive arity impls' in + let impl = Constrintern.compute_internalization_data env0 evd Constrintern.Recursive arity impls' in let open Context.Named.Declaration in - (Environ.push_named (LocalAssum (recname,arity)) env, Id.Map.add recname impl impls)) + (EConstr.push_named (LocalAssum (recname,arity)) env, Id.Map.add recname impl impls)) (env0,Constrintern.empty_internalization_env) lnameargsardef in let recdef = (* Declare local notations *) diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml index 8fe05b4978..e2d7de6d59 100644 --- a/plugins/funind/recdef.ml +++ b/plugins/funind/recdef.ml @@ -210,6 +210,7 @@ let (value_f: Constr.t list -> global_reference -> Constr.t) = DAst.make @@ GVar v_id)]) in let body = fst (understand env (Evd.from_env env) glob_body)(*FIXME*) in + let body = EConstr.Unsafe.to_constr body in it_mkLambda_or_LetIn body context let (declare_f : Id.t -> logical_kind -> Constr.t list -> global_reference -> global_reference) = @@ -1400,7 +1401,7 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp (fun c -> Proofview.V82.of_tactic (Tacticals.New.tclTHENLIST [intros; - Simple.apply (EConstr.of_constr (fst (interp_constr (Global.env()) Evd.empty c))) (*FIXME*); + Simple.apply (fst (interp_constr (Global.env()) Evd.empty c)) (*FIXME*); Tacticals.New.tclCOMPLETE Auto.default_auto ]) ) @@ -1599,7 +1600,9 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num and functional_ref = destConst (constr_of_global functional_ref) and eq_ref = destConst (constr_of_global eq_ref) in generate_induction_principle f_ref tcc_lemma_constr - functional_ref eq_ref rec_arg_num (EConstr.of_constr rec_arg_type) (nb_prod evd (EConstr.of_constr res)) (EConstr.of_constr relation); + functional_ref eq_ref rec_arg_num + (EConstr.of_constr rec_arg_type) + (nb_prod evd (EConstr.of_constr res)) relation; Flags.if_verbose msgnl (h 1 (Ppconstr.pr_id function_name ++ spc () ++ str"is defined" )++ fnl () ++ @@ -1614,7 +1617,7 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num tcc_lemma_constr is_mes functional_ref (EConstr.of_constr rec_arg_type) - (EConstr.of_constr relation) rec_arg_num + relation rec_arg_num term_id using_lemmas (List.length res_vars) diff --git a/plugins/ltac/coretactics.ml4 b/plugins/ltac/coretactics.ml4 index 794a28dd43..ad6c6df5fa 100644 --- a/plugins/ltac/coretactics.ml4 +++ b/plugins/ltac/coretactics.ml4 @@ -239,12 +239,20 @@ END (** Simple induction / destruct *) +let simple_induct h = + Tacticals.New.tclTHEN (Tactics.intros_until h) + (Tacticals.New.onLastHyp Tactics.simplest_elim) + TACTIC EXTEND simple_induction - [ "simple" "induction" quantified_hypothesis(h) ] -> [ Tactics.simple_induct h ] + [ "simple" "induction" quantified_hypothesis(h) ] -> [ simple_induct h ] END +let simple_destruct h = + Tacticals.New.tclTHEN (Tactics.intros_until h) + (Tacticals.New.onLastHyp Tactics.simplest_case) + TACTIC EXTEND simple_destruct - [ "simple" "destruct" quantified_hypothesis(h) ] -> [ Tactics.simple_destruct h ] + [ "simple" "destruct" quantified_hypothesis(h) ] -> [ simple_destruct h ] END (** Double induction *) diff --git a/plugins/ltac/extratactics.ml4 b/plugins/ltac/extratactics.ml4 index 10be8a842d..6c42518b11 100644 --- a/plugins/ltac/extratactics.ml4 +++ b/plugins/ltac/extratactics.ml4 @@ -253,6 +253,7 @@ let add_rewrite_hint ~poly bases ort t lcsr = let sigma = Evd.from_env env in let f ce = let c, ctx = Constrintern.interp_constr env sigma ce in + let c = EConstr.to_constr sigma c in let ctx = let ctx = UState.context_set ctx in if poly then ctx @@ -554,6 +555,7 @@ let add_transitivity_lemma left lem = let env = Global.env () in let sigma = Evd.from_env env in let lem',ctx (*FIXME*) = Constrintern.interp_constr env sigma lem in + let lem' = EConstr.to_constr sigma lem' in add_anonymous_leaf (inTransitivity (left,lem')) (* Vernacular syntax *) @@ -611,8 +613,10 @@ END VERNAC COMMAND EXTEND RetroknowledgeRegister CLASSIFIED AS SIDEFF | [ "Register" constr(c) "as" retroknowledge_field(f) "by" constr(b)] -> - [ let tc,ctx = Constrintern.interp_constr (Global.env ()) Evd.empty c in - let tb,ctx(*FIXME*) = Constrintern.interp_constr (Global.env ()) Evd.empty b in + [ let tc,_ctx = Constrintern.interp_constr (Global.env ()) Evd.empty c in + let tb,_ctx(*FIXME*) = Constrintern.interp_constr (Global.env ()) Evd.empty b in + let tc = EConstr.to_constr Evd.empty tc in + let tb = EConstr.to_constr Evd.empty tb in Global.register f tc tb ] END @@ -705,7 +709,6 @@ let hResolve id c occ t = resolve_hole (subst_hole_with_term loc_begin c_raw t_hole) in let t_constr,ctx = resolve_hole (subst_var_with_hole occ id t_raw) in - let t_constr = EConstr.of_constr t_constr in let sigma = Evd.merge_universe_context sigma ctx in let t_constr_type = Retyping.get_type_of env sigma t_constr in Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) @@ -973,6 +976,7 @@ TACTIC EXTEND unshelve | [ "unshelve" tactic1(t) ] -> [ Proofview.with_shelf (Tacinterp.tactic_of_value ist t) >>= fun (gls, ()) -> + let gls = List.map Proofview.with_empty_state gls in Proofview.Unsafe.tclGETGOALS >>= fun ogls -> Proofview.Unsafe.tclSETGOALS (gls @ ogls) ] diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml index e73a18b79e..1f21890157 100644 --- a/plugins/ltac/rewrite.ml +++ b/plugins/ltac/rewrite.ml @@ -1568,7 +1568,8 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause = let (undef, prf, newt) = res in let fold ev _ accu = if Evd.mem sigma ev then accu else ev :: accu in let gls = List.rev (Evd.fold_undefined fold undef []) in - match clause, prf with + let gls = List.map Proofview.with_empty_state gls in + match clause, prf with | Some id, Some p -> let tac = tclTHENLIST [ Refine.refine ~typecheck:true (fun h -> (h,p)); @@ -1896,7 +1897,6 @@ let declare_projection n instance_id r = let build_morphism_signature env sigma m = let m,ctx = Constrintern.interp_constr env sigma m in - let m = EConstr.of_constr m in let sigma = Evd.from_ctx ctx in let t = Typing.unsafe_type_of env sigma m in let cstrs = diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml index 22ec6c5b1b..9a10fb805a 100644 --- a/plugins/ltac/tacintern.ml +++ b/plugins/ltac/tacintern.ml @@ -199,7 +199,7 @@ let intern_constr_gen pattern_mode isarity {ltacvars=lfun; genv=env; extra} c = ltac_extra = extra; } in let c' = - warn (Constrintern.intern_gen scope ~pattern_mode ~ltacvars env) c + warn (Constrintern.intern_gen scope ~pattern_mode ~ltacvars env Evd.(from_env env)) c in (c',if !strict_check then None else Some c) @@ -316,7 +316,7 @@ let intern_constr_pattern ist ~as_type ~ltacvars pc = ltac_extra = ist.extra; } in let metas,pat = Constrintern.intern_constr_pattern - ist.genv ~as_type ~ltacvars pc + ist.genv Evd.(from_env ist.genv) ~as_type ~ltacvars pc in let (glob,_ as c) = intern_constr_gen true false ist pc in let bound_names = Glob_ops.bound_glob_vars glob in @@ -335,7 +335,7 @@ let intern_typed_pattern ist ~as_type ~ltacvars p = ltac_bound = Id.Set.empty; ltac_extra = ist.extra; } in - Constrintern.intern_constr_pattern ist.genv ~as_type ~ltacvars p + Constrintern.intern_constr_pattern ist.genv Evd.(from_env ist.genv) ~as_type ~ltacvars p else [], dummy_pat in let (glob,_ as c) = intern_constr_gen true false ist p in diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml index 79b5c16227..6a04badf34 100644 --- a/plugins/ltac/tacinterp.ml +++ b/plugins/ltac/tacinterp.ml @@ -584,7 +584,7 @@ let interp_glob_closure ist env sigma ?(kind=WithoutTypeConstraint) ?(pattern_mo ltac_bound = Id.Map.domain ist.lfun; ltac_extra = Genintern.Store.empty; } in - { closure ; term = intern_gen kind ~pattern_mode ~ltacvars env term_expr } + { closure ; term = intern_gen kind ~pattern_mode ~ltacvars env sigma term_expr } let interp_uconstr ist env sigma c = interp_glob_closure ist env sigma c diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml index 125afb1a0e..0f0dbfff30 100644 --- a/plugins/setoid_ring/newring.ml +++ b/plugins/setoid_ring/newring.ml @@ -148,7 +148,7 @@ let ic c = let ic_unsafe c = (*FIXME remove *) let env = Global.env() in let sigma = Evd.from_env env in - EConstr.of_constr (fst (Constrintern.interp_constr env sigma c)) + fst (Constrintern.interp_constr env sigma c) let decl_constant na univs c = let open Constr in diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml index 4ae746288d..1a02fb91c3 100644 --- a/plugins/ssr/ssrcommon.ml +++ b/plugins/ssr/ssrcommon.ml @@ -203,7 +203,7 @@ let glob_constr ist genv = function let vars = Id.Map.fold (fun x _ accu -> Id.Set.add x accu) ist.Tacinterp.lfun Id.Set.empty in let ltacvars = { Constrintern.empty_ltac_sign with Constrintern.ltac_vars = vars } in - Constrintern.intern_gen Pretyping.WithoutTypeConstraint ~ltacvars genv ce + Constrintern.intern_gen Pretyping.WithoutTypeConstraint ~ltacvars genv Evd.(from_env genv) ce | rc, None -> rc let pf_intern_term ist gl (_, c) = glob_constr ist (pf_env gl) c diff --git a/plugins/ssr/ssrfun.v b/plugins/ssr/ssrfun.v index 1f3a9c124d..f77f7c4fa8 100644 --- a/plugins/ssr/ssrfun.v +++ b/plugins/ssr/ssrfun.v @@ -443,14 +443,14 @@ Section Tag. Variables (I : Type) (i : I) (T_ U_ : I -> Type). -Definition tag := projS1. -Definition tagged : forall w, T_(tag w) := @projS2 I [eta T_]. -Definition Tagged x := @existS I [eta T_] i x. +Definition tag := projT1. +Definition tagged : forall w, T_(tag w) := @projT2 I [eta T_]. +Definition Tagged x := @existT I [eta T_] i x. Definition tag2 (w : @sigT2 I T_ U_) := let: existT2 _ _ i _ _ := w in i. Definition tagged2 w : T_(tag2 w) := let: existT2 _ _ _ x _ := w in x. Definition tagged2' w : U_(tag2 w) := let: existT2 _ _ _ _ y := w in y. -Definition Tagged2 x y := @existS2 I [eta T_] [eta U_] i x y. +Definition Tagged2 x y := @existT2 I [eta T_] [eta U_] i x y. End Tag. diff --git a/plugins/ssr/ssrvernac.ml4 b/plugins/ssr/ssrvernac.ml4 index 8e6e0347f0..96ded5abf5 100644 --- a/plugins/ssr/ssrvernac.ml4 +++ b/plugins/ssr/ssrvernac.ml4 @@ -335,7 +335,8 @@ let push_rels_assum l e = push_rels_assum l e let coerce_search_pattern_to_sort hpat = - let env = Global.env () and sigma = Evd.empty in + let env = Global.env () in + let sigma = Evd.(from_env env) in let mkPApp fp n_imps args = let args' = Array.append (Array.make n_imps (Pattern.PMeta None)) args in Pattern.PApp (fp, args') in @@ -393,8 +394,9 @@ let interp_search_arg arg = interp_search_notation ~loc s key | RGlobSearchSubPattern p -> try - let intern = Constrintern.intern_constr_pattern in - Search.GlobSearchSubPattern (snd (intern (Global.env()) p)) + let env = Global.env () in + let _, p = Constrintern.intern_constr_pattern env (Evd.from_env env) p in + Search.GlobSearchSubPattern p with e -> let e = CErrors.push e in iraise (ExplainErr.process_vernac_interp_error e)) arg in let hpat, a1 = match arg with | (_, Search.GlobSearchSubPattern (Pattern.PMeta _)) :: a' -> all_true, a' diff --git a/plugins/ssr/ssrview.ml b/plugins/ssr/ssrview.ml index 61b65e3478..f2990070b4 100644 --- a/plugins/ssr/ssrview.ml +++ b/plugins/ssr/ssrview.ml @@ -55,7 +55,8 @@ let in_viewhint = Libobject.classify_function = classify_viewhint } let glob_view_hints lvh = - List.map (Constrintern.intern_constr (Global.env ())) lvh + let env = Global.env () in + List.map (Constrintern.intern_constr env Evd.(from_env env)) lvh let add_view_hints lvh i = Lib.add_anonymous_leaf (in_viewhint (i, lvh)) diff --git a/plugins/ssrmatching/ssrmatching.ml4 b/plugins/ssrmatching/ssrmatching.ml4 index 73e2123656..d05f50e6d0 100644 --- a/plugins/ssrmatching/ssrmatching.ml4 +++ b/plugins/ssrmatching/ssrmatching.ml4 @@ -73,11 +73,11 @@ let env_size env = List.length (Environ.named_context env) let safeDestApp c = match kind c with App (f, a) -> f, a | _ -> c, [| |] (* Toplevel constr must be globalized twice ! *) -let glob_constr ist genv = function +let glob_constr ist genv sigma = function | _, Some ce -> let vars = Id.Map.fold (fun x _ accu -> Id.Set.add x accu) ist.lfun Id.Set.empty in let ltacvars = { Constrintern.empty_ltac_sign with Constrintern.ltac_vars = vars } in - Constrintern.intern_gen WithoutTypeConstraint ~ltacvars:ltacvars genv ce + Constrintern.intern_gen WithoutTypeConstraint ~ltacvars:ltacvars genv sigma ce | rc, None -> rc (* Term printing utilities functions for deciding bracketing. *) @@ -1009,7 +1009,7 @@ let interp_wit wit ist gl x = sigma, Value.cast (topwit wit) arg let interp_open_constr ist gl gc = interp_wit wit_open_constr ist gl gc -let pf_intern_term ist gl (_, c) = glob_constr ist (pf_env gl) c +let pf_intern_term ist gl (_, c) = glob_constr ist (pf_env gl) gl.sigma c let interp_term ist gl (_, c) = on_snd EConstr.Unsafe.to_constr (interp_open_constr ist gl c) let pr_ssrterm _ _ _ = pr_term let input_ssrtermkind strm = match stream_nth 0 strm with diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml index 275a079d5d..33d674ff5d 100644 --- a/pretyping/inductiveops.ml +++ b/pretyping/inductiveops.ml @@ -643,8 +643,9 @@ let type_of_projection_knowing_arg env sigma p c ty = (* A function which checks that a term well typed verifies both syntactic conditions *) -let control_only_guard env c = - let check_fix_cofix e c = match kind c with +let control_only_guard env sigma c = + let check_fix_cofix e c = + match kind (EConstr.to_constr sigma c) with | CoFix (_,(_,_,_) as cofix) -> Inductive.check_cofix e cofix | Fix (_,(_,_,_) as fix) -> @@ -653,6 +654,6 @@ let control_only_guard env c = in let rec iter env c = check_fix_cofix env c; - iter_constr_with_full_binders push_rel iter env c + iter_constr_with_full_binders sigma EConstr.push_rel iter env c in iter env c diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli index 55149552aa..8efa087a7a 100644 --- a/pretyping/inductiveops.mli +++ b/pretyping/inductiveops.mli @@ -198,4 +198,4 @@ val type_of_inductive_knowing_conclusion : env -> evar_map -> Inductive.mind_specif Univ.puniverses -> EConstr.types -> evar_map * EConstr.types (********************) -val control_only_guard : env -> types -> unit +val control_only_guard : env -> Evd.evar_map -> EConstr.types -> unit diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 6700748ebc..4363fc7cc4 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -923,7 +923,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre | [], [] -> [] | _ -> assert false in aux 1 1 (List.rev nal) cs.cs_args, true in - let fsign = if Flags.version_strictly_greater Flags.V8_6 || Flags.version_less_or_equal Flags.VOld + let fsign = if Flags.version_strictly_greater Flags.V8_6 then Context.Rel.map (whd_betaiota !evdref) fsign else fsign (* beta-iota-normalization regression in 8.5 and 8.6 *) in let obj ind p v f = @@ -1036,7 +1036,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre let pi = beta_applist !evdref (pi, [EConstr.of_constr (build_dependent_constructor cs)]) in let cs_args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cs.cs_args in let cs_args = - if Flags.version_strictly_greater Flags.V8_6 || Flags.version_less_or_equal Flags.VOld + if Flags.version_strictly_greater Flags.V8_6 then Context.Rel.map (whd_betaiota !evdref) cs_args else cs_args (* beta-iota-normalization regression in 8.5 and 8.6 *) in let csgn = @@ -1205,8 +1205,7 @@ let all_no_fail_flags = default_inference_flags false let ise_pretype_gen_ctx flags env sigma lvar kind c = let evd, c, _ = ise_pretype_gen flags env sigma lvar kind c in - let evd, f = Evarutil.nf_evars_and_universes evd in - f (EConstr.Unsafe.to_constr c), Evd.evar_universe_context evd + c, Evd.evar_universe_context evd (** Entry points of the high-level type synthesis algorithm *) diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli index 864768fe56..ee568fbc49 100644 --- a/pretyping/pretyping.mli +++ b/pretyping/pretyping.mli @@ -12,7 +12,6 @@ into elementary ones, insertion of coercions and resolution of implicit arguments. *) -open Constr open Environ open Evd open EConstr @@ -26,7 +25,7 @@ val interp_known_glob_level : ?loc:Loc.t -> Evd.evar_map -> (** An auxiliary function for searching for fixpoint guard indexes *) val search_guard : - ?loc:Loc.t -> env -> int list list -> rec_declaration -> int array + ?loc:Loc.t -> env -> int list list -> Constr.rec_declaration -> int array type typing_constraint = OfType of types | IsType | WithoutTypeConstraint @@ -85,9 +84,8 @@ val understand_ltac : inference_flags -> heuristics (but no external tactic solver hook), as well as to ensure that conversion problems are all solved and that no unresolved evar remains, expanding evars. *) - val understand : ?flags:inference_flags -> ?expected_type:typing_constraint -> - env -> evar_map -> glob_constr -> Constr.constr Evd.in_evar_universe_context + env -> evar_map -> glob_constr -> constr Evd.in_evar_universe_context (** Trying to solve remaining evars and remaining conversion problems possibly using type classes, heuristics, external tactic solver diff --git a/pretyping/unification.ml b/pretyping/unification.ml index e1720ec955..6106b6ef63 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -193,7 +193,7 @@ let pose_all_metas_as_evars env evd t = let ty = EConstr.of_constr ty in let ty = if Evd.Metaset.is_empty mvs then ty else aux ty in let ty = - if Flags.version_strictly_greater Flags.V8_6 || Flags.version_less_or_equal Flags.VOld + if Flags.version_strictly_greater Flags.V8_6 then nf_betaiota env evd ty (* How it was in Coq <= 8.4 (but done in logic.ml at this time) *) else ty (* some beta-iota-normalization "regression" in 8.5 and 8.6 *) in let src = Evd.evar_source_of_meta mv !evdref in @@ -1304,12 +1304,7 @@ let solve_simple_evar_eqn ts env evd ev rhs = match solve_simple_eqn (Evarconv.evar_conv_x ts) env evd (None,ev,rhs) with | UnifFailure (evd,reason) -> error_cannot_unify env evd ~reason (mkEvar ev,rhs); - | Success evd -> - if Flags.version_less_or_equal Flags.V8_5 then - (* We used to force solving unrelated problems at arbitrary times *) - Evarconv.solve_unif_constraints_with_heuristics env evd - else (* solve_simple_eqn calls reconsider_unif_constraints itself *) - evd + | Success evd -> evd (* [w_merge env sigma b metas evars] merges common instances in metas or in evars, possibly generating new unification problems; if [b] diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml index 687fa8f77f..eb174936c4 100644 --- a/pretyping/vnorm.ml +++ b/pretyping/vnorm.ml @@ -141,7 +141,6 @@ and nf_vtype env sigma v = nf_val env sigma v crazy_type and nf_whd env sigma whd typ = match whd with - | Vsort s -> mkSort s | Vprod p -> let dom = nf_vtype env sigma (dom p) in let name = Name (Id.of_string "x") in @@ -182,7 +181,8 @@ and nf_whd env sigma whd typ = let pind = (ind, u) in (mkIndU pind, type_of_ind env pind) in nf_univ_args ~nb_univs mk env sigma stk - | Vatom_stk(Atype u, stk) -> assert false + | Vatom_stk(Asort s, stk) -> + assert (List.is_empty stk); mkSort s | Vuniv_level lvl -> assert false diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml index 3c7095505a..da1fe6d3d2 100644 --- a/printing/ppconstr.ml +++ b/printing/ppconstr.ml @@ -149,7 +149,7 @@ let tag_var = tag Tag.variable str "`" ++ str hd ++ c ++ str tl let pr_com_at n = - if !Flags.beautify && not (Int.equal n 0) then comment (CLexer.extract_comments n) + if !Flags.beautify && not (Int.equal n 0) then comment (Pputils.extract_comments n) else mt() let pr_with_comments ?loc pp = pr_located (fun x -> x) (loc, pp) @@ -701,13 +701,16 @@ let tag_var = tag Tag.variable | { CAst.v = CAppExpl ((None,f,us),[]) } -> str "@" ++ pr_cref f us | c -> pr prec c - let transf env c = + let transf env sigma c = if !Flags.beautify_file then - let r = Constrintern.for_grammar (Constrintern.intern_constr env) c in + let r = Constrintern.for_grammar (Constrintern.intern_constr env sigma) c in Constrextern.extern_glob_constr (Termops.vars_of_env env) r else c - let pr_expr prec c = pr prec (transf (Global.env()) c) + let pr_expr prec c = + let env = Global.env () in + let sigma = Evd.from_env env in + pr prec (transf env sigma c) let pr_simpleconstr = pr_expr lsimpleconstr diff --git a/printing/pputils.ml b/printing/pputils.ml index e779fc5fc0..3d72c8da3f 100644 --- a/printing/pputils.ml +++ b/printing/pputils.ml @@ -13,14 +13,26 @@ open Misctypes open Locus open Genredexpr +let beautify_comments = ref [] + +let rec split_comments comacc acc pos = function + | [] -> beautify_comments := List.rev acc; comacc + | ((b,e),c as com)::coms -> + (* Take all comments that terminates before pos, or begin exactly + at pos (used to print comments attached after an expression) *) + if e<=pos || pos=b then split_comments (c::comacc) acc pos coms + else split_comments comacc (com::acc) pos coms + +let extract_comments pos = split_comments [] [] pos !beautify_comments + let pr_located pr (loc, x) = match loc with | Some loc when !Flags.beautify -> let (b, e) = Loc.unloc loc in (* Side-effect: order matters *) - let before = Pp.comment (CLexer.extract_comments b) in + let before = Pp.comment (extract_comments b) in let x = pr x in - let after = Pp.comment (CLexer.extract_comments e) in + let after = Pp.comment (extract_comments e) in before ++ x ++ after | _ -> pr x diff --git a/printing/pputils.mli b/printing/pputils.mli index ec5c32fc46..483bd0ae38 100644 --- a/printing/pputils.mli +++ b/printing/pputils.mli @@ -37,3 +37,9 @@ val pr_red_expr_env : Environ.env -> Evd.evar_map -> val pr_raw_generic : Environ.env -> rlevel generic_argument -> Pp.t val pr_glb_generic : Environ.env -> glevel generic_argument -> Pp.t + +(* The comments interface is imperative due to the printer not + threading it, this could be solved using a better data + structure. *) +val beautify_comments : ((int * int) * string) list ref +val extract_comments : int -> string list diff --git a/proofs/proof.ml b/proofs/proof.ml index 04e707cd66..f5ff35eeb2 100644 --- a/proofs/proof.ml +++ b/proofs/proof.ml @@ -432,7 +432,7 @@ module V82 = struct CList.nth evl (n-1) in let env = Evd.evar_filtered_env evi in - let rawc = Constrintern.intern_constr env com in + let rawc = Constrintern.intern_constr env sigma com in let ltac_vars = Glob_ops.empty_lvar in let sigma = Evar_refiner.w_refine (evk, evi) (ltac_vars, rawc) sigma in Proofview.Unsafe.tclEVARS sigma diff --git a/proofs/refine.ml b/proofs/refine.ml index 90276951be..73ed70a1a7 100644 --- a/proofs/refine.ml +++ b/proofs/refine.ml @@ -73,6 +73,7 @@ let generic_refine ~typecheck f gl = let sigma = Proofview.Goal.sigma gl in let env = Proofview.Goal.env gl in let concl = Proofview.Goal.concl gl in + let state = Proofview.Goal.state gl in (** Save the [future_goals] state to restore them after the refinement. *) let prev_future_goals = Evd.future_goals sigma in @@ -120,6 +121,7 @@ let generic_refine ~typecheck f gl = (** Select the goals *) let comb = CList.map_filter (Proofview.Unsafe.advance sigma) (CList.rev evs) in let sigma = CList.fold_left Proofview.Unsafe.mark_as_goal sigma comb in + let comb = CList.map (fun x -> Proofview.goal_with_state x state) comb in let trace () = Pp.(hov 2 (str"simple refine"++spc()++ Hook.get pr_constrv env sigma c)) in Proofview.Trace.name_tactic trace (Proofview.tclUNIT v) >>= fun v -> Proofview.Unsafe.tclSETENV (Environ.reset_context env) <*> diff --git a/stm/stm.ml b/stm/stm.ml index e7c3717988..fd22a83886 100644 --- a/stm/stm.ml +++ b/stm/stm.ml @@ -2949,6 +2949,7 @@ let get_ast ~doc id = match VCS.visit id with | { step = `Cmd { cast = { loc; expr } } } | { step = `Fork (({ loc; expr }, _, _, _), _) } + | { step = `Sideff ((ReplayCommand {loc; expr}) , _) } | { step = `Qed ({ qast = { loc; expr } }, _) } -> Some (Loc.tag ?loc expr) | _ -> None diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index a95e6b941e..b8860d3a56 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -581,7 +581,7 @@ let make_resolve_hyp env sigma st flags only_classes pri decl = (fun (path,info,c) -> let info = { info with Vernacexpr.hint_pattern = - Option.map (Constrintern.intern_constr_pattern env) + Option.map (Constrintern.intern_constr_pattern env sigma) info.Vernacexpr.hint_pattern } in make_resolves env sigma ~name:(PathHints path) @@ -1131,6 +1131,7 @@ module Search = struct let rec result (shelf, ()) i k = foundone := true; Proofview.Unsafe.tclGETGOALS >>= fun gls -> + let gls = CList.map Proofview.drop_state gls in let j = List.length gls in (if !typeclasses_debug > 0 then Feedback.msg_debug @@ -1179,7 +1180,7 @@ module Search = struct (if List.is_empty goals then tclUNIT () else let sigma' = mark_unresolvables sigma goals in - with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS goals) >>= + with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS (CList.map Proofview.with_empty_state goals)) >>= fun s -> result s i (Some (Option.default 0 k + j))) end in with_shelf res >>= fun (sh, ()) -> @@ -1272,6 +1273,7 @@ module Search = struct search_tac_gl ~st only_classes dep hints depth (succ i) sigma gls gl end in Proofview.Unsafe.tclGETGOALS >>= fun gls -> + let gls = CList.map Proofview.drop_state gls in Proofview.tclEVARMAP >>= fun sigma -> let j = List.length gls in (tclDISPATCH (List.init j (fun i -> tac sigma gls i))) diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml index 467754a848..3386f972e7 100644 --- a/tactics/contradiction.ml +++ b/tactics/contradiction.ml @@ -44,8 +44,6 @@ let absurd c = absurd c (* Contradiction *) -let use_negated_unit_or_eq_type () = Flags.version_strictly_greater Flags.V8_5 - (** [f] does not assume its argument to be [nf_evar]-ed. *) let filter_hyp f tac = let rec seek = function @@ -71,9 +69,7 @@ let contradiction_context = simplest_elim (mkVar id) else match EConstr.kind sigma typ with | Prod (na,t,u) when is_empty_type sigma u -> - let is_unit_or_eq = - if use_negated_unit_or_eq_type () then match_with_unit_or_eq_type sigma t - else None in + let is_unit_or_eq = match_with_unit_or_eq_type sigma t in Tacticals.New.tclORELSE (match is_unit_or_eq with | Some _ -> diff --git a/tactics/equality.ml b/tactics/equality.ml index 9a1ac768c7..96a53a8b1e 100644 --- a/tactics/equality.ml +++ b/tactics/equality.ml @@ -84,7 +84,7 @@ let _ = let injection_in_context = ref false let use_injection_in_context = function - | None -> !injection_in_context && Flags.version_strictly_greater Flags.V8_5 + | None -> !injection_in_context | Some flags -> flags.injection_in_context let _ = @@ -533,7 +533,7 @@ let general_rewrite_clause l2r with_evars ?tac c cl = let rec do_hyps_atleastonce = function | [] -> tclZEROMSG (Pp.str"Nothing to rewrite.") | id :: l -> - tclIFTHENTRYELSEMUST + tclIFTHENFIRSTTRYELSEMUST (general_rewrite_ebindings_in l2r AllOccurrences false true ?tac id c with_evars) (do_hyps_atleastonce l) in @@ -549,7 +549,7 @@ let general_rewrite_clause l2r with_evars ?tac c cl = end in if cl.concl_occs == NoOccurrences then do_hyps else - tclIFTHENTRYELSEMUST + tclIFTHENFIRSTTRYELSEMUST (general_rewrite_ebindings l2r (occs_of cl.concl_occs) false true ?tac c with_evars) do_hyps diff --git a/tactics/hints.ml b/tactics/hints.ml index 7f9b5ef34e..10cd7e1f64 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -1270,7 +1270,7 @@ let prepare_hint check (poly,local) env init (sigma,c) = let interp_hints poly = fun h -> - let env = (Global.env()) in + let env = Global.env () in let sigma = Evd.from_env env in let f poly c = let evd,c = Constrintern.interp_open_constr env sigma c in @@ -1279,9 +1279,7 @@ let interp_hints poly = let gr = global_with_alias r in Dumpglob.add_glob ?loc:(loc_of_reference r) gr; gr in - let fr r = - evaluable_of_global_reference (Global.env()) (fref r) - in + let fr r = evaluable_of_global_reference env (fref r) in let fi c = match c with | HintsReference c -> @@ -1289,7 +1287,7 @@ let interp_hints poly = (PathHints [gr], poly, IsGlobRef gr) | HintsConstr c -> (PathAny, poly, f poly c) in - let fp = Constrintern.intern_constr_pattern (Global.env()) in + let fp = Constrintern.intern_constr_pattern env sigma in let fres (info, b, r) = let path, poly, gr = fi r in let info = { info with hint_pattern = Option.map fp info.hint_pattern } in diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml index e7da17cff1..0cc0001c1c 100644 --- a/tactics/tacticals.ml +++ b/tactics/tacticals.ml @@ -408,8 +408,14 @@ module New = struct Proofview.tclIFCATCH t1 (fun () -> tclDISPATCH (Array.to_list a)) (fun _ -> t3) + let tclIFTHENFIRSTELSE t1 t2 t3 = + Proofview.tclIFCATCH t1 + (fun () -> tclEXTEND [t2] (tclUNIT ()) []) + (fun _ -> t3) let tclIFTHENTRYELSEMUST t1 t2 = tclIFTHENELSE t1 (tclTRY t2) t2 + let tclIFTHENFIRSTTRYELSEMUST t1 t2 = + tclIFTHENFIRSTELSE t1 (tclTRY t2) t2 (* Try the first tactic that does not fail in a list of tactics *) let rec tclFIRST = function diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli index c5d5c8c123..a3bc4707ea 100644 --- a/tactics/tacticals.mli +++ b/tactics/tacticals.mli @@ -210,6 +210,7 @@ module New : sig val tclIFTHENELSE : unit tactic -> unit tactic -> unit tactic -> unit tactic val tclIFTHENSVELSE : unit tactic -> unit tactic array -> unit tactic -> unit tactic val tclIFTHENTRYELSEMUST : unit tactic -> unit tactic -> unit tactic + val tclIFTHENFIRSTTRYELSEMUST : unit tactic -> unit tactic -> unit tactic val tclDO : int -> unit tactic -> unit tactic val tclREPEAT : unit tactic -> unit tactic diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 7e281e2fe0..61ca3e319c 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -1991,7 +1991,6 @@ let exact_proof c = Proofview.Goal.enter begin fun gl -> Refine.refine ~typecheck:false begin fun sigma -> let (c, ctx) = Constrintern.interp_casted_constr (pf_env gl) sigma c (pf_concl gl) in - let c = EConstr.of_constr c in let sigma = Evd.merge_universe_context sigma ctx in (sigma, c) end @@ -4662,30 +4661,6 @@ let destruct ev clr c l e = induction_gen clr false ev e ((Evd.empty,(c,NoBindings)),(None,l)) None -(* The registered tactic, which calls the default elimination - * if no elimination constant is provided. *) - -(* Induction tactics *) - -(* This was Induction before 6.3 (induction only in quantified premisses) *) -let simple_induct_id s = Tacticals.New.tclTHEN (intros_until_id s) (Tacticals.New.onLastHyp simplest_elim) -let simple_induct_nodep n = Tacticals.New.tclTHEN (intros_until_n n) (Tacticals.New.onLastHyp simplest_elim) - -let simple_induct = function - | NamedHyp id -> simple_induct_id id - | AnonHyp n -> simple_induct_nodep n - -(* Destruction tactics *) - -let simple_destruct_id s = - (Tacticals.New.tclTHEN (intros_until_id s) (Tacticals.New.onLastHyp simplest_case)) -let simple_destruct_nodep n = - (Tacticals.New.tclTHEN (intros_until_n n) (Tacticals.New.onLastHyp simplest_case)) - -let simple_destruct = function - | NamedHyp id -> simple_destruct_id id - | AnonHyp n -> simple_destruct_nodep n - (* * Eliminations giving the type instead of the proof. * These tactics use the default elimination constant and @@ -5146,16 +5121,10 @@ module New = struct open Locus let reduce_after_refine = - let onhyps = - (** We reduced everywhere in the hyps before 8.6 *) - if Flags.version_compare !Flags.compat_version Flags.V8_5 == 0 - then None - else Some [] - in reduce (Lazy {rBeta=true;rMatch=true;rFix=true;rCofix=true; rZeta=false;rDelta=false;rConst=[]}) - {onhyps; concl_occs=AllOccurrences } + {onhyps = Some []; concl_occs = AllOccurrences } let refine ~typecheck c = Refine.refine ~typecheck c <*> diff --git a/tactics/tactics.mli b/tactics/tactics.mli index 74415f8d03..100ddf17f2 100644 --- a/tactics/tactics.mli +++ b/tactics/tactics.mli @@ -280,8 +280,6 @@ val simplest_elim : constr -> unit Proofview.tactic val elim : evars_flag -> clear_flag -> constr with_bindings -> constr with_bindings option -> unit Proofview.tactic -val simple_induct : quantified_hypothesis -> unit Proofview.tactic - val induction : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option -> constr with_bindings option -> unit Proofview.tactic @@ -290,7 +288,6 @@ val induction : evars_flag -> clear_flag -> constr -> or_and_intro_pattern optio val general_case_analysis : evars_flag -> clear_flag -> constr with_bindings -> unit Proofview.tactic val simplest_case : constr -> unit Proofview.tactic -val simple_destruct : quantified_hypothesis -> unit Proofview.tactic val destruct : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option -> constr with_bindings option -> unit Proofview.tactic diff --git a/test-suite/bugs/closed/4785.v b/test-suite/bugs/closed/4785.v index c3c97d3f59..0d347b262d 100644 --- a/test-suite/bugs/closed/4785.v +++ b/test-suite/bugs/closed/4785.v @@ -1,5 +1,4 @@ Require Coq.Lists.List Coq.Vectors.Vector. -Require Coq.Compat.Coq85. Module A. Import Coq.Lists.List Coq.Vectors.Vector. @@ -21,12 +20,10 @@ Delimit Scope mylist_scope with mylist. Bind Scope mylist_scope with mylist. Arguments mynil {_}, _. Arguments mycons {_} _ _. -Notation " [] " := mynil (compat "8.5") : mylist_scope. Notation " [ ] " := mynil (format "[ ]") : mylist_scope. Notation " [ x ] " := (mycons x nil) : mylist_scope. Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z nil) ..)) : mylist_scope. -Import Coq.Compat.Coq85. Locate Module VectorNotations. Import VectorDef.VectorNotations. @@ -35,11 +32,3 @@ Check []%mylist : mylist _. Check [ ]%mylist : mylist _. Check [ ]%list : list _. End A. - -Module B. -Import Coq.Compat.Coq85. - -Goal True. - idtac; []. (* Check that importing the compat file doesn't break the [ | .. | ] syntax of Ltac *) -Abort. -End B. diff --git a/test-suite/bugs/closed/4785_compat_85.v b/test-suite/bugs/closed/4785_compat_85.v deleted file mode 100644 index bbb34f465c..0000000000 --- a/test-suite/bugs/closed/4785_compat_85.v +++ /dev/null @@ -1,46 +0,0 @@ -(* -*- coq-prog-args: ("-compat" "8.5") -*- *) -Require Coq.Lists.List Coq.Vectors.Vector. -Require Coq.Compat.Coq85. - -Module A. -Import Coq.Lists.List Coq.Vectors.Vector. -Import ListNotations. -Check [ ]%list : list _. -Import VectorNotations ListNotations. -Delimit Scope vector_scope with vector. -Check [ ]%vector : Vector.t _ _. -Check []%vector : Vector.t _ _. -Check [ ]%list : list _. -Fail Check []%list : list _. - -Goal True. - idtac; [ ]. (* Note that vector notations break the [ | .. | ] syntax of Ltac *) -Abort. - -Inductive mylist A := mynil | mycons (x : A) (xs : mylist A). -Delimit Scope mylist_scope with mylist. -Bind Scope mylist_scope with mylist. -Arguments mynil {_}, _. -Arguments mycons {_} _ _. -Notation " [] " := mynil (compat "8.5") : mylist_scope. -Notation " [ ] " := mynil (format "[ ]") : mylist_scope. -Notation " [ x ] " := (mycons x nil) : mylist_scope. -Notation " [ x ; y ; .. ; z ] " := (mycons x (mycons y .. (mycons z nil) ..)) : mylist_scope. - -Import Coq.Compat.Coq85. -Locate Module VectorNotations. -Import VectorDef.VectorNotations. - -Check []%vector : Vector.t _ _. -Check []%mylist : mylist _. -Check [ ]%mylist : mylist _. -Check [ ]%list : list _. -End A. - -Module B. -Import Coq.Compat.Coq85. - -Goal True. - idtac; []. (* Check that importing the compat file doesn't break the [ | .. | ] syntax of Ltac *) -Abort. -End B. diff --git a/test-suite/bugs/closed/4798.v b/test-suite/bugs/closed/4798.v index dbc3d46fce..6f2bcb9685 100644 --- a/test-suite/bugs/closed/4798.v +++ b/test-suite/bugs/closed/4798.v @@ -1,3 +1,3 @@ Check match 2 with 0 => 0 | S n => n end. -Notation "|" := 1 (compat "8.4"). +Notation "|" := 1 (compat "8.6"). Check match 2 with 0 => 0 | S n => n end. (* fails *) diff --git a/test-suite/bugs/closed/4873.v b/test-suite/bugs/closed/4873.v index 3be36d8475..39299883ad 100644 --- a/test-suite/bugs/closed/4873.v +++ b/test-suite/bugs/closed/4873.v @@ -1,6 +1,5 @@ Require Import Coq.Classes.Morphisms. Require Import Relation_Definitions. -Require Import Coq.Compat.Coq85. Fixpoint tuple' T n : Type := match n with diff --git a/test-suite/bugs/closed/6878.v b/test-suite/bugs/closed/6878.v new file mode 100644 index 0000000000..70f1b3127a --- /dev/null +++ b/test-suite/bugs/closed/6878.v @@ -0,0 +1,8 @@ + +Set Universe Polymorphism. +Module Type T. + Axiom foo : Prop. +End T. + +(** Used to anomaly *) +Fail Module M : T with Definition foo := Type. diff --git a/test-suite/output/Load.out b/test-suite/output/Load.out new file mode 100644 index 0000000000..0904d5540b --- /dev/null +++ b/test-suite/output/Load.out @@ -0,0 +1,6 @@ +f = 2 + : nat +u = I + : True +The command has indeed failed with message: +Files processed by Load cannot leave open proofs. diff --git a/test-suite/output/Load.v b/test-suite/output/Load.v new file mode 100644 index 0000000000..967507415a --- /dev/null +++ b/test-suite/output/Load.v @@ -0,0 +1,7 @@ +Load "output/load/Load_noproof.v". +Print f. + +Load "output/load/Load_proof.v". +Print u. + +Fail Load "output/load/Load_openproof.v". diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v index 08918981a4..a498db3e89 100644 --- a/test-suite/output/PrintInfos.v +++ b/test-suite/output/PrintInfos.v @@ -26,6 +26,7 @@ About bar. Print bar. About Peano. (* Module *) +Set Warnings "-deprecated". About existS2. (* Notation *) Arguments eq_refl {A} {x}, {A} x. diff --git a/test-suite/output/load/Load_noproof.v b/test-suite/output/load/Load_noproof.v new file mode 100644 index 0000000000..aaf1ffe26d --- /dev/null +++ b/test-suite/output/load/Load_noproof.v @@ -0,0 +1 @@ +Definition f := 2. diff --git a/test-suite/output/load/Load_openproof.v b/test-suite/output/load/Load_openproof.v new file mode 100644 index 0000000000..204d4ecbfe --- /dev/null +++ b/test-suite/output/load/Load_openproof.v @@ -0,0 +1 @@ +Lemma k : True. diff --git a/test-suite/output/load/Load_proof.v b/test-suite/output/load/Load_proof.v new file mode 100644 index 0000000000..e47f66a193 --- /dev/null +++ b/test-suite/output/load/Load_proof.v @@ -0,0 +1,2 @@ +Lemma u : True. +Proof. exact I. Qed. diff --git a/test-suite/success/rewrite.v b/test-suite/success/rewrite.v index 62249666b3..448d0082db 100644 --- a/test-suite/success/rewrite.v +++ b/test-suite/success/rewrite.v @@ -151,10 +151,25 @@ Abort. (* Check that rewriting within evars still work (was broken in 8.5beta1) *) - Goal forall (a: unit) (H: a = tt), exists x y:nat, x = y. intros; eexists; eexists. rewrite H. Undo. subst. Abort. + +(* Check that iterated rewriting does not rewrite in the side conditions *) +(* Example from Sigurd Schneider, extracted from contrib containers *) + +Lemma EQ + : forall (e e' : nat), True -> e = e'. +Admitted. + +Lemma test (v1 v2 v3: nat) (v' : v1 = v2) : v2 = v1. +Proof. + rewrite <- (EQ v1 v2) in *. + exact v'. + (* There should be only two side conditions *) + exact I. + exact I. +Qed. diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v index 1e3237d105..b7235b669f 100644 --- a/theories/Arith/Compare_dec.v +++ b/theories/Arith/Compare_dec.v @@ -133,11 +133,11 @@ Qed. See now [Nat.compare] and its properties. In scope [nat_scope], the notation for [Nat.compare] is "?=" *) -Notation nat_compare := Nat.compare (compat "8.4"). +Notation nat_compare := Nat.compare (compat "8.6"). -Notation nat_compare_spec := Nat.compare_spec (compat "8.4"). -Notation nat_compare_eq_iff := Nat.compare_eq_iff (compat "8.4"). -Notation nat_compare_S := Nat.compare_succ (compat "8.4"). +Notation nat_compare_spec := Nat.compare_spec (compat "8.6"). +Notation nat_compare_eq_iff := Nat.compare_eq_iff (compat "8.6"). +Notation nat_compare_S := Nat.compare_succ (only parsing). Lemma nat_compare_lt n m : n<m <-> (n ?= m) = Lt. Proof. @@ -198,9 +198,9 @@ Qed. See now [Nat.leb] and its properties. In scope [nat_scope], the notation for [Nat.leb] is "<=?" *) -Notation leb := Nat.leb (compat "8.4"). +Notation leb := Nat.leb (only parsing). -Notation leb_iff := Nat.leb_le (compat "8.4"). +Notation leb_iff := Nat.leb_le (only parsing). Lemma leb_iff_conv m n : (n <=? m) = false <-> m < n. Proof. diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v index ecb9a5706c..725d65d82a 100644 --- a/theories/Arith/Div2.v +++ b/theories/Arith/Div2.v @@ -18,7 +18,7 @@ Implicit Type n : nat. (** Here we define [n/2] and prove some of its properties *) -Notation div2 := Nat.div2 (compat "8.4"). +Notation div2 := Nat.div2 (only parsing). (** Since [div2] is recursively defined on [0], [1] and [(S (S n))], it is useful to prove the corresponding induction principle *) @@ -84,7 +84,7 @@ Qed. (** Properties related to the double ([2n]) *) -Notation double := Nat.double (compat "8.4"). +Notation double := Nat.double (only parsing). Hint Unfold double Nat.double: arith. diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v index 722615428b..a4f2d30bdd 100644 --- a/theories/Arith/EqNat.v +++ b/theories/Arith/EqNat.v @@ -69,10 +69,10 @@ Defined. We reuse the one already defined in module [Nat]. In scope [nat_scope], the notation "=?" can be used. *) -Notation beq_nat := Nat.eqb (compat "8.4"). +Notation beq_nat := Nat.eqb (only parsing). -Notation beq_nat_true_iff := Nat.eqb_eq (compat "8.4"). -Notation beq_nat_false_iff := Nat.eqb_neq (compat "8.4"). +Notation beq_nat_true_iff := Nat.eqb_eq (only parsing). +Notation beq_nat_false_iff := Nat.eqb_neq (only parsing). Lemma beq_nat_refl n : true = (n =? n). Proof. diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v index d95b057702..9fcce45200 100644 --- a/theories/Arith/Le.v +++ b/theories/Arith/Le.v @@ -26,17 +26,17 @@ Local Open Scope nat_scope. (** * [le] is an order on [nat] *) -Notation le_refl := Nat.le_refl (compat "8.4"). -Notation le_trans := Nat.le_trans (compat "8.4"). -Notation le_antisym := Nat.le_antisymm (compat "8.4"). +Notation le_refl := Nat.le_refl (only parsing). +Notation le_trans := Nat.le_trans (only parsing). +Notation le_antisym := Nat.le_antisymm (only parsing). Hint Resolve le_trans: arith. Hint Immediate le_antisym: arith. (** * Properties of [le] w.r.t 0 *) -Notation le_0_n := Nat.le_0_l (compat "8.4"). (* 0 <= n *) -Notation le_Sn_0 := Nat.nle_succ_0 (compat "8.4"). (* ~ S n <= 0 *) +Notation le_0_n := Nat.le_0_l (only parsing). (* 0 <= n *) +Notation le_Sn_0 := Nat.nle_succ_0 (only parsing). (* ~ S n <= 0 *) Lemma le_n_0_eq n : n <= 0 -> 0 = n. Proof. @@ -53,8 +53,8 @@ Proof Peano.le_n_S. Theorem le_S_n : forall n m, S n <= S m -> n <= m. Proof Peano.le_S_n. -Notation le_n_Sn := Nat.le_succ_diag_r (compat "8.4"). (* n <= S n *) -Notation le_Sn_n := Nat.nle_succ_diag_l (compat "8.4"). (* ~ S n <= n *) +Notation le_n_Sn := Nat.le_succ_diag_r (only parsing). (* n <= S n *) +Notation le_Sn_n := Nat.nle_succ_diag_l (only parsing). (* ~ S n <= n *) Theorem le_Sn_le : forall n m, S n <= m -> n <= m. Proof Nat.lt_le_incl. @@ -65,8 +65,8 @@ Hint Immediate le_n_0_eq le_Sn_le le_S_n : arith. (** * Properties of [le] w.r.t predecessor *) -Notation le_pred_n := Nat.le_pred_l (compat "8.4"). (* pred n <= n *) -Notation le_pred := Nat.pred_le_mono (compat "8.4"). (* n<=m -> pred n <= pred m *) +Notation le_pred_n := Nat.le_pred_l (only parsing). (* pred n <= n *) +Notation le_pred := Nat.pred_le_mono (only parsing). (* n<=m -> pred n <= pred m *) Hint Resolve le_pred_n: arith. diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v index 2c2bea4a65..7c3badce13 100644 --- a/theories/Arith/Lt.v +++ b/theories/Arith/Lt.v @@ -23,7 +23,7 @@ Local Open Scope nat_scope. (** * Irreflexivity *) -Notation lt_irrefl := Nat.lt_irrefl (compat "8.4"). (* ~ x < x *) +Notation lt_irrefl := Nat.lt_irrefl (only parsing). (* ~ x < x *) Hint Resolve lt_irrefl: arith. @@ -62,12 +62,12 @@ Hint Immediate le_not_lt lt_not_le: arith. (** * Asymmetry *) -Notation lt_asym := Nat.lt_asymm (compat "8.4"). (* n<m -> ~m<n *) +Notation lt_asym := Nat.lt_asymm (only parsing). (* n<m -> ~m<n *) (** * Order and 0 *) -Notation lt_0_Sn := Nat.lt_0_succ (compat "8.4"). (* 0 < S n *) -Notation lt_n_0 := Nat.nlt_0_r (compat "8.4"). (* ~ n < 0 *) +Notation lt_0_Sn := Nat.lt_0_succ (only parsing). (* 0 < S n *) +Notation lt_n_0 := Nat.nlt_0_r (only parsing). (* ~ n < 0 *) Theorem neq_0_lt n : 0 <> n -> 0 < n. Proof. @@ -84,8 +84,8 @@ Hint Immediate neq_0_lt lt_0_neq: arith. (** * Order and successor *) -Notation lt_n_Sn := Nat.lt_succ_diag_r (compat "8.4"). (* n < S n *) -Notation lt_S := Nat.lt_lt_succ_r (compat "8.4"). (* n < m -> n < S m *) +Notation lt_n_Sn := Nat.lt_succ_diag_r (only parsing). (* n < S n *) +Notation lt_S := Nat.lt_lt_succ_r (only parsing). (* n < m -> n < S m *) Theorem lt_n_S n m : n < m -> S n < S m. Proof. @@ -127,28 +127,28 @@ Hint Resolve lt_pred_n_n: arith. (** * Transitivity properties *) -Notation lt_trans := Nat.lt_trans (compat "8.4"). -Notation lt_le_trans := Nat.lt_le_trans (compat "8.4"). -Notation le_lt_trans := Nat.le_lt_trans (compat "8.4"). +Notation lt_trans := Nat.lt_trans (only parsing). +Notation lt_le_trans := Nat.lt_le_trans (only parsing). +Notation le_lt_trans := Nat.le_lt_trans (only parsing). Hint Resolve lt_trans lt_le_trans le_lt_trans: arith. (** * Large = strict or equal *) -Notation le_lt_or_eq_iff := Nat.lt_eq_cases (compat "8.4"). +Notation le_lt_or_eq_iff := Nat.lt_eq_cases (only parsing). Theorem le_lt_or_eq n m : n <= m -> n < m \/ n = m. Proof. apply Nat.lt_eq_cases. Qed. -Notation lt_le_weak := Nat.lt_le_incl (compat "8.4"). +Notation lt_le_weak := Nat.lt_le_incl (only parsing). Hint Immediate lt_le_weak: arith. (** * Dichotomy *) -Notation le_or_lt := Nat.le_gt_cases (compat "8.4"). (* n <= m \/ m < n *) +Notation le_or_lt := Nat.le_gt_cases (only parsing). (* n <= m \/ m < n *) Theorem nat_total_order n m : n <> m -> n < m \/ m < n. Proof. diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v index 950f985d4a..ffa1e048c6 100644 --- a/theories/Arith/Minus.v +++ b/theories/Arith/Minus.v @@ -46,7 +46,7 @@ Qed. (** * Diagonal *) -Notation minus_diag := Nat.sub_diag (compat "8.4"). (* n - n = 0 *) +Notation minus_diag := Nat.sub_diag (only parsing). (* n - n = 0 *) Lemma minus_diag_reverse n : 0 = n - n. Proof. @@ -87,13 +87,13 @@ Qed. (** * Relation with order *) Notation minus_le_compat_r := - Nat.sub_le_mono_r (compat "8.4"). (* n <= m -> n - p <= m - p. *) + Nat.sub_le_mono_r (only parsing). (* n <= m -> n - p <= m - p. *) Notation minus_le_compat_l := - Nat.sub_le_mono_l (compat "8.4"). (* n <= m -> p - m <= p - n. *) + Nat.sub_le_mono_l (only parsing). (* n <= m -> p - m <= p - n. *) -Notation le_minus := Nat.le_sub_l (compat "8.4"). (* n - m <= n *) -Notation lt_minus := Nat.sub_lt (compat "8.4"). (* m <= n -> 0 < m -> n-m < n *) +Notation le_minus := Nat.le_sub_l (only parsing). (* n - m <= n *) +Notation lt_minus := Nat.sub_lt (only parsing). (* m <= n -> 0 < m -> n-m < n *) Lemma lt_O_minus_lt n m : 0 < n - m -> m < n. Proof. diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v index e4084ba471..4b13e145a1 100644 --- a/theories/Arith/Mult.v +++ b/theories/Arith/Mult.v @@ -23,35 +23,35 @@ Local Open Scope nat_scope. (** ** Zero property *) -Notation mult_0_l := Nat.mul_0_l (compat "8.4"). (* 0 * n = 0 *) -Notation mult_0_r := Nat.mul_0_r (compat "8.4"). (* n * 0 = 0 *) +Notation mult_0_l := Nat.mul_0_l (only parsing). (* 0 * n = 0 *) +Notation mult_0_r := Nat.mul_0_r (only parsing). (* n * 0 = 0 *) (** ** 1 is neutral *) -Notation mult_1_l := Nat.mul_1_l (compat "8.4"). (* 1 * n = n *) -Notation mult_1_r := Nat.mul_1_r (compat "8.4"). (* n * 1 = n *) +Notation mult_1_l := Nat.mul_1_l (only parsing). (* 1 * n = n *) +Notation mult_1_r := Nat.mul_1_r (only parsing). (* n * 1 = n *) Hint Resolve mult_1_l mult_1_r: arith. (** ** Commutativity *) -Notation mult_comm := Nat.mul_comm (compat "8.4"). (* n * m = m * n *) +Notation mult_comm := Nat.mul_comm (only parsing). (* n * m = m * n *) Hint Resolve mult_comm: arith. (** ** Distributivity *) Notation mult_plus_distr_r := - Nat.mul_add_distr_r (compat "8.4"). (* (n+m)*p = n*p + m*p *) + Nat.mul_add_distr_r (only parsing). (* (n+m)*p = n*p + m*p *) Notation mult_plus_distr_l := - Nat.mul_add_distr_l (compat "8.4"). (* n*(m+p) = n*m + n*p *) + Nat.mul_add_distr_l (only parsing). (* n*(m+p) = n*m + n*p *) Notation mult_minus_distr_r := - Nat.mul_sub_distr_r (compat "8.4"). (* (n-m)*p = n*p - m*p *) + Nat.mul_sub_distr_r (only parsing). (* (n-m)*p = n*p - m*p *) Notation mult_minus_distr_l := - Nat.mul_sub_distr_l (compat "8.4"). (* n*(m-p) = n*m - n*p *) + Nat.mul_sub_distr_l (only parsing). (* n*(m-p) = n*m - n*p *) Hint Resolve mult_plus_distr_r: arith. Hint Resolve mult_minus_distr_r: arith. @@ -59,7 +59,7 @@ Hint Resolve mult_minus_distr_l: arith. (** ** Associativity *) -Notation mult_assoc := Nat.mul_assoc (compat "8.4"). (* n*(m*p)=n*m*p *) +Notation mult_assoc := Nat.mul_assoc (only parsing). (* n*(m*p)=n*m*p *) Lemma mult_assoc_reverse n m p : n * m * p = n * (m * p). Proof. @@ -83,8 +83,8 @@ Qed. (** ** Multiplication and successor *) -Notation mult_succ_l := Nat.mul_succ_l (compat "8.4"). (* S n * m = n * m + m *) -Notation mult_succ_r := Nat.mul_succ_r (compat "8.4"). (* n * S m = n * m + n *) +Notation mult_succ_l := Nat.mul_succ_l (only parsing). (* S n * m = n * m + m *) +Notation mult_succ_r := Nat.mul_succ_r (only parsing). (* n * S m = n * m + n *) (** * Compatibility with orders *) diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v index 247ea20a88..9ed08f1b19 100644 --- a/theories/Arith/Peano_dec.v +++ b/theories/Arith/Peano_dec.v @@ -19,7 +19,7 @@ Proof. - left; exists n; auto. Defined. -Notation eq_nat_dec := Nat.eq_dec (compat "8.4"). +Notation eq_nat_dec := Nat.eq_dec (only parsing). Hint Resolve O_or_S eq_nat_dec: arith. diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v index 600e5e518d..3e44bbfe59 100644 --- a/theories/Arith/Plus.v +++ b/theories/Arith/Plus.v @@ -27,12 +27,12 @@ Local Open Scope nat_scope. (** * Neutrality of 0, commutativity, associativity *) -Notation plus_0_l := Nat.add_0_l (compat "8.4"). -Notation plus_0_r := Nat.add_0_r (compat "8.4"). -Notation plus_comm := Nat.add_comm (compat "8.4"). -Notation plus_assoc := Nat.add_assoc (compat "8.4"). +Notation plus_0_l := Nat.add_0_l (only parsing). +Notation plus_0_r := Nat.add_0_r (only parsing). +Notation plus_comm := Nat.add_comm (only parsing). +Notation plus_assoc := Nat.add_assoc (only parsing). -Notation plus_permute := Nat.add_shuffle3 (compat "8.4"). +Notation plus_permute := Nat.add_shuffle3 (only parsing). Definition plus_Snm_nSm : forall n m, S n + m = n + S m := Peano.plus_n_Sm. @@ -138,7 +138,7 @@ Defined. (** * Derived properties *) -Notation plus_permute_2_in_4 := Nat.add_shuffle1 (compat "8.4"). +Notation plus_permute_2_in_4 := Nat.add_shuffle1 (only parsing). (** * Tail-recursive plus *) diff --git a/theories/Compat/Coq85.v b/theories/Compat/Coq85.v deleted file mode 100644 index 56a9130d1a..0000000000 --- a/theories/Compat/Coq85.v +++ /dev/null @@ -1,36 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -(** Compatibility file for making Coq act similar to Coq v8.5 *) - -(** Any compatibility changes to make future versions of Coq behave like Coq 8.6 - are likely needed to make them behave like Coq 8.5. *) -Require Export Coq.Compat.Coq86. - -(** We use some deprecated options in this file, so we disable the - corresponding warning, to silence the build of this file. *) -Local Set Warnings "-deprecated-option". - -(* In 8.5, "intros [|]", taken e.g. on a goal "A\/B->C", does not - behave as "intros [H|H]" but leave instead hypotheses quantified in - the goal, here producing subgoals A->C and B->C. *) - -Global Unset Bracketing Last Introduction Pattern. -Global Unset Regular Subst Tactic. -Global Unset Structural Injection. -Global Unset Shrink Abstract. -Global Unset Shrink Obligations. -Global Set Refolding Reduction. - -(** The resolution algorithm for type classes has changed. *) -Global Set Typeclasses Legacy Resolution. -Global Set Typeclasses Limit Intros. -Global Unset Typeclasses Filtered Unification. - -(** Allow silently letting unification constraints float after a "." *) -Global Unset Solve Unification Constraints. diff --git a/theories/FSets/FMapFacts.v b/theories/FSets/FMapFacts.v index 3c5690a724..5ae22c497b 100644 --- a/theories/FSets/FMapFacts.v +++ b/theories/FSets/FMapFacts.v @@ -24,7 +24,7 @@ Hint Extern 1 (Equivalence _) => constructor; congruence. Module WFacts_fun (E:DecidableType)(Import M:WSfun E). -Notation option_map := option_map (compat "8.4"). +Notation option_map := option_map (compat "8.6"). Notation eq_dec := E.eq_dec. Definition eqb x y := if eq_dec x y then true else false. @@ -440,7 +440,7 @@ destruct (eq_dec x y); auto. Qed. Lemma map_o : forall m x (f:elt->elt'), - find x (map f m) = option_map f (find x m). + find x (map f m) = Datatypes.option_map f (find x m). Proof. intros. generalize (find_mapsto_iff (map f m) x) (find_mapsto_iff m x) @@ -473,7 +473,7 @@ Qed. Lemma mapi_o : forall m x (f:key->elt->elt'), (forall x y e, E.eq x y -> f x e = f y e) -> - find x (mapi f m) = option_map (f x) (find x m). + find x (mapi f m) = Datatypes.option_map (f x) (find x m). Proof. intros. generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x) diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index 22e10e2e43..84ec907858 100644 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -359,14 +359,14 @@ Definition idProp : IDProp := fun A x => x. (* Compatibility *) -Notation prodT := prod (compat "8.2"). -Notation pairT := pair (compat "8.2"). -Notation prodT_rect := prod_rect (compat "8.2"). -Notation prodT_rec := prod_rec (compat "8.2"). -Notation prodT_ind := prod_ind (compat "8.2"). -Notation fstT := fst (compat "8.2"). -Notation sndT := snd (compat "8.2"). -Notation prodT_uncurry := prod_uncurry (compat "8.2"). -Notation prodT_curry := prod_curry (compat "8.2"). +Notation prodT := prod (only parsing). +Notation pairT := pair (only parsing). +Notation prodT_rect := prod_rect (only parsing). +Notation prodT_rec := prod_rec (only parsing). +Notation prodT_ind := prod_ind (only parsing). +Notation fstT := fst (only parsing). +Notation sndT := snd (only parsing). +Notation prodT_uncurry := prod_uncurry (only parsing). +Notation prodT_curry := prod_curry (only parsing). (* end hide *) diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v index 053ed601f0..2209d13ff0 100644 --- a/theories/Init/Logic.v +++ b/theories/Init/Logic.v @@ -549,14 +549,14 @@ Qed. (* Aliases *) -Notation sym_eq := eq_sym (compat "8.3"). -Notation trans_eq := eq_trans (compat "8.3"). -Notation sym_not_eq := not_eq_sym (compat "8.3"). - -Notation refl_equal := eq_refl (compat "8.3"). -Notation sym_equal := eq_sym (compat "8.3"). -Notation trans_equal := eq_trans (compat "8.3"). -Notation sym_not_equal := not_eq_sym (compat "8.3"). +Notation sym_eq := eq_sym (only parsing). +Notation trans_eq := eq_trans (only parsing). +Notation sym_not_eq := not_eq_sym (only parsing). + +Notation refl_equal := eq_refl (only parsing). +Notation sym_equal := eq_sym (only parsing). +Notation trans_equal := eq_trans (only parsing). +Notation sym_not_equal := not_eq_sym (only parsing). Hint Immediate eq_sym not_eq_sym: core. diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v index 567d2c15c5..3244fa14c3 100644 --- a/theories/Init/Logic_Type.v +++ b/theories/Init/Logic_Type.v @@ -66,7 +66,7 @@ Defined. Hint Immediate identity_sym not_identity_sym: core. -Notation refl_id := identity_refl (compat "8.3"). -Notation sym_id := identity_sym (compat "8.3"). -Notation trans_id := identity_trans (compat "8.3"). -Notation sym_not_id := not_identity_sym (compat "8.3"). +Notation refl_id := identity_refl (only parsing). +Notation sym_id := identity_sym (only parsing). +Notation trans_id := identity_trans (only parsing). +Notation sym_not_id := not_identity_sym (only parsing). diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v index 571d2f2dd2..857913c3e4 100644 --- a/theories/Init/Peano.v +++ b/theories/Init/Peano.v @@ -37,7 +37,7 @@ Hint Resolve f_equal_nat: core. (** The predecessor function *) -Notation pred := Nat.pred (compat "8.4"). +Notation pred := Nat.pred (only parsing). Definition f_equal_pred := f_equal pred. @@ -79,7 +79,7 @@ Hint Resolve n_Sn: core. (** Addition *) -Notation plus := Nat.add (compat "8.4"). +Notation plus := Nat.add (only parsing). Infix "+" := Nat.add : nat_scope. Definition f_equal2_plus := f_equal2 plus. @@ -110,12 +110,12 @@ Qed. (** Standard associated names *) -Notation plus_0_r_reverse := plus_n_O (compat "8.2"). -Notation plus_succ_r_reverse := plus_n_Sm (compat "8.2"). +Notation plus_0_r_reverse := plus_n_O (only parsing). +Notation plus_succ_r_reverse := plus_n_Sm (only parsing). (** Multiplication *) -Notation mult := Nat.mul (compat "8.4"). +Notation mult := Nat.mul (only parsing). Infix "*" := Nat.mul : nat_scope. Definition f_equal2_mult := f_equal2 mult. @@ -137,12 +137,12 @@ Hint Resolve mult_n_Sm: core. (** Standard associated names *) -Notation mult_0_r_reverse := mult_n_O (compat "8.2"). -Notation mult_succ_r_reverse := mult_n_Sm (compat "8.2"). +Notation mult_0_r_reverse := mult_n_O (only parsing). +Notation mult_succ_r_reverse := mult_n_Sm (only parsing). (** Truncated subtraction: [m-n] is [0] if [n>=m] *) -Notation minus := Nat.sub (compat "8.4"). +Notation minus := Nat.sub (only parsing). Infix "-" := Nat.sub : nat_scope. (** Definition of the usual orders, the basic properties of [le] and [lt] @@ -219,8 +219,8 @@ Qed. (** Maximum and minimum : definitions and specifications *) -Notation max := Nat.max (compat "8.4"). -Notation min := Nat.min (compat "8.4"). +Notation max := Nat.max (only parsing). +Notation min := Nat.min (only parsing). Lemma max_l n m : m <= n -> Nat.max n m = n. Proof. diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v index 47e8a7558e..e9d6a15973 100644 --- a/theories/Init/Specif.v +++ b/theories/Init/Specif.v @@ -742,16 +742,16 @@ Hint Resolve exist exist2 existT existT2: core. (* Compatibility *) -Notation sigS := sigT (compat "8.2"). -Notation existS := existT (compat "8.2"). -Notation sigS_rect := sigT_rect (compat "8.2"). -Notation sigS_rec := sigT_rec (compat "8.2"). -Notation sigS_ind := sigT_ind (compat "8.2"). -Notation projS1 := projT1 (compat "8.2"). -Notation projS2 := projT2 (compat "8.2"). - -Notation sigS2 := sigT2 (compat "8.2"). -Notation existS2 := existT2 (compat "8.2"). -Notation sigS2_rect := sigT2_rect (compat "8.2"). -Notation sigS2_rec := sigT2_rec (compat "8.2"). -Notation sigS2_ind := sigT2_ind (compat "8.2"). +Notation sigS := sigT (compat "8.6"). +Notation existS := existT (compat "8.6"). +Notation sigS_rect := sigT_rect (compat "8.6"). +Notation sigS_rec := sigT_rec (compat "8.6"). +Notation sigS_ind := sigT_ind (compat "8.6"). +Notation projS1 := projT1 (compat "8.6"). +Notation projS2 := projT2 (compat "8.6"). + +Notation sigS2 := sigT2 (compat "8.6"). +Notation existS2 := existT2 (compat "8.6"). +Notation sigS2_rect := sigT2_rect (compat "8.6"). +Notation sigS2_rec := sigT2_rec (compat "8.6"). +Notation sigS2_ind := sigT2_ind (compat "8.6"). diff --git a/theories/Lists/List.v b/theories/Lists/List.v index eae2c52de3..301528598e 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -27,7 +27,6 @@ Module ListNotations. Notation "[ ]" := nil (format "[ ]") : list_scope. Notation "[ x ]" := (cons x nil) : list_scope. Notation "[ x ; y ; .. ; z ]" := (cons x (cons y .. (cons z nil) ..)) : list_scope. -Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..) (compat "8.4") : list_scope. End ListNotations. Import ListNotations. diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v index 78ec8ff247..e9b90b52c1 100644 --- a/theories/Logic/ChoiceFacts.v +++ b/theories/Logic/ChoiceFacts.v @@ -1308,11 +1308,11 @@ Qed. (**********************************************************************) (** * Compatibility notations *) Notation description_rel_choice_imp_funct_choice := - functional_rel_reification_and_rel_choice_imp_fun_choice (compat "8.6"). + functional_rel_reification_and_rel_choice_imp_fun_choice (only parsing). -Notation funct_choice_imp_rel_choice := fun_choice_imp_rel_choice (compat "8.6"). +Notation funct_choice_imp_rel_choice := fun_choice_imp_rel_choice (only parsing). Notation FunChoice_Equiv_RelChoice_and_ParamDefinDescr := - fun_choice_iff_rel_choice_and_functional_rel_reification (compat "8.6"). + fun_choice_iff_rel_choice_and_functional_rel_reification (only parsing). -Notation funct_choice_imp_description := fun_choice_imp_functional_rel_reification (compat "8.6"). +Notation funct_choice_imp_description := fun_choice_imp_functional_rel_reification (only parsing). diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v index c9dca432a5..af7fcb3fe2 100644 --- a/theories/Logic/EqdepFacts.v +++ b/theories/Logic/EqdepFacts.v @@ -123,7 +123,7 @@ Proof. apply eq_dep_intro. Qed. -Notation eq_sigS_eq_dep := eq_sigT_eq_dep (compat "8.2"). (* Compatibility *) +Notation eq_sigS_eq_dep := eq_sigT_eq_dep (compat "8.6"). (* Compatibility *) Lemma eq_dep_eq_sigT : forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v index 75a8bfdb39..fcee77b827 100644 --- a/theories/NArith/BinNat.v +++ b/theories/NArith/BinNat.v @@ -956,95 +956,94 @@ Notation "( p | q )" := (N.divide p q) (at level 0) : N_scope. (** Compatibility notations *) -(*Notation N := N (compat "8.3").*) (*hidden by module N above *) Notation N_rect := N_rect (only parsing). Notation N_rec := N_rec (only parsing). Notation N_ind := N_ind (only parsing). Notation N0 := N0 (only parsing). Notation Npos := N.pos (only parsing). -Notation Ndiscr := N.discr (compat "8.3"). -Notation Ndouble_plus_one := N.succ_double (compat "8.3"). -Notation Ndouble := N.double (compat "8.3"). -Notation Nsucc := N.succ (compat "8.3"). -Notation Npred := N.pred (compat "8.3"). -Notation Nsucc_pos := N.succ_pos (compat "8.3"). -Notation Ppred_N := Pos.pred_N (compat "8.3"). -Notation Nplus := N.add (compat "8.3"). -Notation Nminus := N.sub (compat "8.3"). -Notation Nmult := N.mul (compat "8.3"). -Notation Neqb := N.eqb (compat "8.3"). -Notation Ncompare := N.compare (compat "8.3"). -Notation Nlt := N.lt (compat "8.3"). -Notation Ngt := N.gt (compat "8.3"). -Notation Nle := N.le (compat "8.3"). -Notation Nge := N.ge (compat "8.3"). -Notation Nmin := N.min (compat "8.3"). -Notation Nmax := N.max (compat "8.3"). -Notation Ndiv2 := N.div2 (compat "8.3"). -Notation Neven := N.even (compat "8.3"). -Notation Nodd := N.odd (compat "8.3"). -Notation Npow := N.pow (compat "8.3"). -Notation Nlog2 := N.log2 (compat "8.3"). - -Notation nat_of_N := N.to_nat (compat "8.3"). -Notation N_of_nat := N.of_nat (compat "8.3"). -Notation N_eq_dec := N.eq_dec (compat "8.3"). -Notation Nrect := N.peano_rect (compat "8.3"). -Notation Nrect_base := N.peano_rect_base (compat "8.3"). -Notation Nrect_step := N.peano_rect_succ (compat "8.3"). -Notation Nind := N.peano_ind (compat "8.3"). -Notation Nrec := N.peano_rec (compat "8.3"). -Notation Nrec_base := N.peano_rec_base (compat "8.3"). -Notation Nrec_succ := N.peano_rec_succ (compat "8.3"). - -Notation Npred_succ := N.pred_succ (compat "8.3"). -Notation Npred_minus := N.pred_sub (compat "8.3"). -Notation Nsucc_pred := N.succ_pred (compat "8.3"). -Notation Ppred_N_spec := N.pos_pred_spec (compat "8.3"). -Notation Nsucc_pos_spec := N.succ_pos_spec (compat "8.3"). -Notation Ppred_Nsucc := N.pos_pred_succ (compat "8.3"). -Notation Nplus_0_l := N.add_0_l (compat "8.3"). -Notation Nplus_0_r := N.add_0_r (compat "8.3"). -Notation Nplus_comm := N.add_comm (compat "8.3"). -Notation Nplus_assoc := N.add_assoc (compat "8.3"). -Notation Nplus_succ := N.add_succ_l (compat "8.3"). -Notation Nsucc_0 := N.succ_0_discr (compat "8.3"). -Notation Nsucc_inj := N.succ_inj (compat "8.3"). -Notation Nminus_N0_Nle := N.sub_0_le (compat "8.3"). -Notation Nminus_0_r := N.sub_0_r (compat "8.3"). -Notation Nminus_succ_r:= N.sub_succ_r (compat "8.3"). -Notation Nmult_0_l := N.mul_0_l (compat "8.3"). -Notation Nmult_1_l := N.mul_1_l (compat "8.3"). -Notation Nmult_1_r := N.mul_1_r (compat "8.3"). -Notation Nmult_comm := N.mul_comm (compat "8.3"). -Notation Nmult_assoc := N.mul_assoc (compat "8.3"). -Notation Nmult_plus_distr_r := N.mul_add_distr_r (compat "8.3"). -Notation Neqb_eq := N.eqb_eq (compat "8.3"). -Notation Nle_0 := N.le_0_l (compat "8.3"). -Notation Ncompare_refl := N.compare_refl (compat "8.3"). -Notation Ncompare_Eq_eq := N.compare_eq (compat "8.3"). -Notation Ncompare_eq_correct := N.compare_eq_iff (compat "8.3"). -Notation Nlt_irrefl := N.lt_irrefl (compat "8.3"). -Notation Nlt_trans := N.lt_trans (compat "8.3"). -Notation Nle_lteq := N.lt_eq_cases (compat "8.3"). -Notation Nlt_succ_r := N.lt_succ_r (compat "8.3"). -Notation Nle_trans := N.le_trans (compat "8.3"). -Notation Nle_succ_l := N.le_succ_l (compat "8.3"). -Notation Ncompare_spec := N.compare_spec (compat "8.3"). -Notation Ncompare_0 := N.compare_0_r (compat "8.3"). -Notation Ndouble_div2 := N.div2_double (compat "8.3"). -Notation Ndouble_plus_one_div2 := N.div2_succ_double (compat "8.3"). -Notation Ndouble_inj := N.double_inj (compat "8.3"). -Notation Ndouble_plus_one_inj := N.succ_double_inj (compat "8.3"). -Notation Npow_0_r := N.pow_0_r (compat "8.3"). -Notation Npow_succ_r := N.pow_succ_r (compat "8.3"). -Notation Nlog2_spec := N.log2_spec (compat "8.3"). -Notation Nlog2_nonpos := N.log2_nonpos (compat "8.3"). -Notation Neven_spec := N.even_spec (compat "8.3"). -Notation Nodd_spec := N.odd_spec (compat "8.3"). -Notation Nlt_not_eq := N.lt_neq (compat "8.3"). -Notation Ngt_Nlt := N.gt_lt (compat "8.3"). +Notation Ndiscr := N.discr (compat "8.6"). +Notation Ndouble_plus_one := N.succ_double (only parsing). +Notation Ndouble := N.double (compat "8.6"). +Notation Nsucc := N.succ (compat "8.6"). +Notation Npred := N.pred (compat "8.6"). +Notation Nsucc_pos := N.succ_pos (compat "8.6"). +Notation Ppred_N := Pos.pred_N (compat "8.6"). +Notation Nplus := N.add (only parsing). +Notation Nminus := N.sub (only parsing). +Notation Nmult := N.mul (only parsing). +Notation Neqb := N.eqb (compat "8.6"). +Notation Ncompare := N.compare (compat "8.6"). +Notation Nlt := N.lt (compat "8.6"). +Notation Ngt := N.gt (compat "8.6"). +Notation Nle := N.le (compat "8.6"). +Notation Nge := N.ge (compat "8.6"). +Notation Nmin := N.min (compat "8.6"). +Notation Nmax := N.max (compat "8.6"). +Notation Ndiv2 := N.div2 (compat "8.6"). +Notation Neven := N.even (compat "8.6"). +Notation Nodd := N.odd (compat "8.6"). +Notation Npow := N.pow (compat "8.6"). +Notation Nlog2 := N.log2 (compat "8.6"). + +Notation nat_of_N := N.to_nat (only parsing). +Notation N_of_nat := N.of_nat (only parsing). +Notation N_eq_dec := N.eq_dec (compat "8.6"). +Notation Nrect := N.peano_rect (only parsing). +Notation Nrect_base := N.peano_rect_base (only parsing). +Notation Nrect_step := N.peano_rect_succ (only parsing). +Notation Nind := N.peano_ind (only parsing). +Notation Nrec := N.peano_rec (only parsing). +Notation Nrec_base := N.peano_rec_base (only parsing). +Notation Nrec_succ := N.peano_rec_succ (only parsing). + +Notation Npred_succ := N.pred_succ (compat "8.6"). +Notation Npred_minus := N.pred_sub (only parsing). +Notation Nsucc_pred := N.succ_pred (compat "8.6"). +Notation Ppred_N_spec := N.pos_pred_spec (only parsing). +Notation Nsucc_pos_spec := N.succ_pos_spec (compat "8.6"). +Notation Ppred_Nsucc := N.pos_pred_succ (only parsing). +Notation Nplus_0_l := N.add_0_l (only parsing). +Notation Nplus_0_r := N.add_0_r (only parsing). +Notation Nplus_comm := N.add_comm (only parsing). +Notation Nplus_assoc := N.add_assoc (only parsing). +Notation Nplus_succ := N.add_succ_l (only parsing). +Notation Nsucc_0 := N.succ_0_discr (only parsing). +Notation Nsucc_inj := N.succ_inj (compat "8.6"). +Notation Nminus_N0_Nle := N.sub_0_le (only parsing). +Notation Nminus_0_r := N.sub_0_r (only parsing). +Notation Nminus_succ_r:= N.sub_succ_r (only parsing). +Notation Nmult_0_l := N.mul_0_l (only parsing). +Notation Nmult_1_l := N.mul_1_l (only parsing). +Notation Nmult_1_r := N.mul_1_r (only parsing). +Notation Nmult_comm := N.mul_comm (only parsing). +Notation Nmult_assoc := N.mul_assoc (only parsing). +Notation Nmult_plus_distr_r := N.mul_add_distr_r (only parsing). +Notation Neqb_eq := N.eqb_eq (compat "8.6"). +Notation Nle_0 := N.le_0_l (only parsing). +Notation Ncompare_refl := N.compare_refl (compat "8.6"). +Notation Ncompare_Eq_eq := N.compare_eq (only parsing). +Notation Ncompare_eq_correct := N.compare_eq_iff (only parsing). +Notation Nlt_irrefl := N.lt_irrefl (compat "8.6"). +Notation Nlt_trans := N.lt_trans (compat "8.6"). +Notation Nle_lteq := N.lt_eq_cases (only parsing). +Notation Nlt_succ_r := N.lt_succ_r (compat "8.6"). +Notation Nle_trans := N.le_trans (compat "8.6"). +Notation Nle_succ_l := N.le_succ_l (compat "8.6"). +Notation Ncompare_spec := N.compare_spec (compat "8.6"). +Notation Ncompare_0 := N.compare_0_r (only parsing). +Notation Ndouble_div2 := N.div2_double (only parsing). +Notation Ndouble_plus_one_div2 := N.div2_succ_double (only parsing). +Notation Ndouble_inj := N.double_inj (compat "8.6"). +Notation Ndouble_plus_one_inj := N.succ_double_inj (only parsing). +Notation Npow_0_r := N.pow_0_r (compat "8.6"). +Notation Npow_succ_r := N.pow_succ_r (compat "8.6"). +Notation Nlog2_spec := N.log2_spec (compat "8.6"). +Notation Nlog2_nonpos := N.log2_nonpos (compat "8.6"). +Notation Neven_spec := N.even_spec (compat "8.6"). +Notation Nodd_spec := N.odd_spec (compat "8.6"). +Notation Nlt_not_eq := N.lt_neq (only parsing). +Notation Ngt_Nlt := N.gt_lt (only parsing). (** More complex compatibility facts, expressed as lemmas (to preserve scopes for instance) *) diff --git a/theories/NArith/Ndec.v b/theories/NArith/Ndec.v index 892bbe7cdc..494a80f4a2 100644 --- a/theories/NArith/Ndec.v +++ b/theories/NArith/Ndec.v @@ -20,11 +20,11 @@ Local Open Scope N_scope. (** Obsolete results about boolean comparisons over [N], kept for compatibility with IntMap and SMC. *) -Notation Peqb := Pos.eqb (compat "8.3"). -Notation Neqb := N.eqb (compat "8.3"). -Notation Peqb_correct := Pos.eqb_refl (compat "8.3"). -Notation Neqb_correct := N.eqb_refl (compat "8.3"). -Notation Neqb_comm := N.eqb_sym (compat "8.3"). +Notation Peqb := Pos.eqb (compat "8.6"). +Notation Neqb := N.eqb (compat "8.6"). +Notation Peqb_correct := Pos.eqb_refl (only parsing). +Notation Neqb_correct := N.eqb_refl (only parsing). +Notation Neqb_comm := N.eqb_sym (only parsing). Lemma Peqb_complete p p' : Pos.eqb p p' = true -> p = p'. Proof. now apply Pos.eqb_eq. Qed. @@ -274,7 +274,7 @@ Qed. (* Old results about [N.min] *) -Notation Nmin_choice := N.min_dec (compat "8.3"). +Notation Nmin_choice := N.min_dec (only parsing). Lemma Nmin_le_1 a b : Nleb (N.min a b) a = true. Proof. rewrite Nleb_Nle. apply N.le_min_l. Qed. diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v index 9aadf985de..835f500a76 100644 --- a/theories/NArith/Ndigits.v +++ b/theories/NArith/Ndigits.v @@ -14,17 +14,17 @@ Local Open Scope N_scope. (** Compatibility names for some bitwise operations *) -Notation Pxor := Pos.lxor (compat "8.3"). -Notation Nxor := N.lxor (compat "8.3"). -Notation Pbit := Pos.testbit_nat (compat "8.3"). -Notation Nbit := N.testbit_nat (compat "8.3"). - -Notation Nxor_eq := N.lxor_eq (compat "8.3"). -Notation Nxor_comm := N.lxor_comm (compat "8.3"). -Notation Nxor_assoc := N.lxor_assoc (compat "8.3"). -Notation Nxor_neutral_left := N.lxor_0_l (compat "8.3"). -Notation Nxor_neutral_right := N.lxor_0_r (compat "8.3"). -Notation Nxor_nilpotent := N.lxor_nilpotent (compat "8.3"). +Notation Pxor := Pos.lxor (only parsing). +Notation Nxor := N.lxor (only parsing). +Notation Pbit := Pos.testbit_nat (only parsing). +Notation Nbit := N.testbit_nat (only parsing). + +Notation Nxor_eq := N.lxor_eq (only parsing). +Notation Nxor_comm := N.lxor_comm (only parsing). +Notation Nxor_assoc := N.lxor_assoc (only parsing). +Notation Nxor_neutral_left := N.lxor_0_l (only parsing). +Notation Nxor_neutral_right := N.lxor_0_r (only parsing). +Notation Nxor_nilpotent := N.lxor_nilpotent (only parsing). (** Equivalence of bit-testing functions, either with index in [N] or in [nat]. *) @@ -249,7 +249,7 @@ Local Close Scope N_scope. (** Checking whether a number is odd, i.e. if its lower bit is set. *) -Notation Nbit0 := N.odd (compat "8.3"). +Notation Nbit0 := N.odd (only parsing). Definition Nodd (n:N) := N.odd n = true. Definition Neven (n:N) := N.odd n = false. @@ -498,7 +498,7 @@ Qed. (** Number of digits in a number *) -Notation Nsize := N.size_nat (compat "8.3"). +Notation Nsize := N.size_nat (only parsing). (** conversions between N and bit vectors. *) diff --git a/theories/NArith/Ndiv_def.v b/theories/NArith/Ndiv_def.v index 974e93994c..6e2893a9bc 100644 --- a/theories/NArith/Ndiv_def.v +++ b/theories/NArith/Ndiv_def.v @@ -22,10 +22,10 @@ Lemma Pdiv_eucl_remainder a b : snd (Pdiv_eucl a b) < Npos b. Proof. now apply (N.pos_div_eucl_remainder a (Npos b)). Qed. -Notation Ndiv_eucl := N.div_eucl (compat "8.3"). -Notation Ndiv := N.div (compat "8.3"). -Notation Nmod := N.modulo (compat "8.3"). +Notation Ndiv_eucl := N.div_eucl (compat "8.6"). +Notation Ndiv := N.div (compat "8.6"). +Notation Nmod := N.modulo (only parsing). -Notation Ndiv_eucl_correct := N.div_eucl_spec (compat "8.3"). -Notation Ndiv_mod_eq := N.div_mod' (compat "8.3"). -Notation Nmod_lt := N.mod_lt (compat "8.3"). +Notation Ndiv_eucl_correct := N.div_eucl_spec (only parsing). +Notation Ndiv_mod_eq := N.div_mod' (only parsing). +Notation Nmod_lt := N.mod_lt (compat "8.6"). diff --git a/theories/NArith/Nnat.v b/theories/NArith/Nnat.v index 798ab28289..da66a16d61 100644 --- a/theories/NArith/Nnat.v +++ b/theories/NArith/Nnat.v @@ -208,30 +208,30 @@ Hint Rewrite Nat2N.id : Nnat. (** Compatibility notations *) -Notation nat_of_N_inj := N2Nat.inj (compat "8.3"). -Notation N_of_nat_of_N := N2Nat.id (compat "8.3"). -Notation nat_of_Ndouble := N2Nat.inj_double (compat "8.3"). -Notation nat_of_Ndouble_plus_one := N2Nat.inj_succ_double (compat "8.3"). -Notation nat_of_Nsucc := N2Nat.inj_succ (compat "8.3"). -Notation nat_of_Nplus := N2Nat.inj_add (compat "8.3"). -Notation nat_of_Nmult := N2Nat.inj_mul (compat "8.3"). -Notation nat_of_Nminus := N2Nat.inj_sub (compat "8.3"). -Notation nat_of_Npred := N2Nat.inj_pred (compat "8.3"). -Notation nat_of_Ndiv2 := N2Nat.inj_div2 (compat "8.3"). -Notation nat_of_Ncompare := N2Nat.inj_compare (compat "8.3"). -Notation nat_of_Nmax := N2Nat.inj_max (compat "8.3"). -Notation nat_of_Nmin := N2Nat.inj_min (compat "8.3"). - -Notation nat_of_N_of_nat := Nat2N.id (compat "8.3"). -Notation N_of_nat_inj := Nat2N.inj (compat "8.3"). -Notation N_of_double := Nat2N.inj_double (compat "8.3"). -Notation N_of_double_plus_one := Nat2N.inj_succ_double (compat "8.3"). -Notation N_of_S := Nat2N.inj_succ (compat "8.3"). -Notation N_of_pred := Nat2N.inj_pred (compat "8.3"). -Notation N_of_plus := Nat2N.inj_add (compat "8.3"). -Notation N_of_minus := Nat2N.inj_sub (compat "8.3"). -Notation N_of_mult := Nat2N.inj_mul (compat "8.3"). -Notation N_of_div2 := Nat2N.inj_div2 (compat "8.3"). -Notation N_of_nat_compare := Nat2N.inj_compare (compat "8.3"). -Notation N_of_min := Nat2N.inj_min (compat "8.3"). -Notation N_of_max := Nat2N.inj_max (compat "8.3"). +Notation nat_of_N_inj := N2Nat.inj (only parsing). +Notation N_of_nat_of_N := N2Nat.id (only parsing). +Notation nat_of_Ndouble := N2Nat.inj_double (only parsing). +Notation nat_of_Ndouble_plus_one := N2Nat.inj_succ_double (only parsing). +Notation nat_of_Nsucc := N2Nat.inj_succ (only parsing). +Notation nat_of_Nplus := N2Nat.inj_add (only parsing). +Notation nat_of_Nmult := N2Nat.inj_mul (only parsing). +Notation nat_of_Nminus := N2Nat.inj_sub (only parsing). +Notation nat_of_Npred := N2Nat.inj_pred (only parsing). +Notation nat_of_Ndiv2 := N2Nat.inj_div2 (only parsing). +Notation nat_of_Ncompare := N2Nat.inj_compare (only parsing). +Notation nat_of_Nmax := N2Nat.inj_max (only parsing). +Notation nat_of_Nmin := N2Nat.inj_min (only parsing). + +Notation nat_of_N_of_nat := Nat2N.id (only parsing). +Notation N_of_nat_inj := Nat2N.inj (only parsing). +Notation N_of_double := Nat2N.inj_double (only parsing). +Notation N_of_double_plus_one := Nat2N.inj_succ_double (only parsing). +Notation N_of_S := Nat2N.inj_succ (only parsing). +Notation N_of_pred := Nat2N.inj_pred (only parsing). +Notation N_of_plus := Nat2N.inj_add (only parsing). +Notation N_of_minus := Nat2N.inj_sub (only parsing). +Notation N_of_mult := Nat2N.inj_mul (only parsing). +Notation N_of_div2 := Nat2N.inj_div2 (only parsing). +Notation N_of_nat_compare := Nat2N.inj_compare (only parsing). +Notation N_of_min := Nat2N.inj_min (only parsing). +Notation N_of_max := Nat2N.inj_max (only parsing). diff --git a/theories/NArith/Nsqrt_def.v b/theories/NArith/Nsqrt_def.v index 97de41c20a..61e86eab79 100644 --- a/theories/NArith/Nsqrt_def.v +++ b/theories/NArith/Nsqrt_def.v @@ -11,8 +11,8 @@ Require Import BinNat. (** Obsolete file, see [BinNat] now, only compatibility notations remain here. *) -Notation Nsqrtrem := N.sqrtrem (compat "8.3"). -Notation Nsqrt := N.sqrt (compat "8.3"). -Notation Nsqrtrem_spec := N.sqrtrem_spec (compat "8.3"). -Notation Nsqrt_spec := (fun n => N.sqrt_spec n (N.le_0_l n)) (compat "8.3"). -Notation Nsqrtrem_sqrt := N.sqrtrem_sqrt (compat "8.3"). +Notation Nsqrtrem := N.sqrtrem (compat "8.6"). +Notation Nsqrt := N.sqrt (compat "8.6"). +Notation Nsqrtrem_spec := N.sqrtrem_spec (compat "8.6"). +Notation Nsqrt_spec := (fun n => N.sqrt_spec n (N.le_0_l n)) (only parsing). +Notation Nsqrtrem_sqrt := N.sqrtrem_sqrt (compat "8.6"). diff --git a/theories/Numbers/Natural/Peano/NPeano.v b/theories/Numbers/Natural/Peano/NPeano.v index 787ef81dc9..c75138fbd0 100644 --- a/theories/Numbers/Natural/Peano/NPeano.v +++ b/theories/Numbers/Natural/Peano/NPeano.v @@ -18,74 +18,74 @@ Module Nat <: NAxiomsSig := Nat. (** Compat notations for stuff that used to be at the beginning of NPeano. *) -Notation leb := Nat.leb (compat "8.4"). -Notation ltb := Nat.ltb (compat "8.4"). -Notation leb_le := Nat.leb_le (compat "8.4"). -Notation ltb_lt := Nat.ltb_lt (compat "8.4"). -Notation pow := Nat.pow (compat "8.4"). -Notation pow_0_r := Nat.pow_0_r (compat "8.4"). -Notation pow_succ_r := Nat.pow_succ_r (compat "8.4"). -Notation square := Nat.square (compat "8.4"). -Notation square_spec := Nat.square_spec (compat "8.4"). -Notation Even := Nat.Even (compat "8.4"). -Notation Odd := Nat.Odd (compat "8.4"). -Notation even := Nat.even (compat "8.4"). -Notation odd := Nat.odd (compat "8.4"). -Notation even_spec := Nat.even_spec (compat "8.4"). -Notation odd_spec := Nat.odd_spec (compat "8.4"). +Notation leb := Nat.leb (only parsing). +Notation ltb := Nat.ltb (only parsing). +Notation leb_le := Nat.leb_le (only parsing). +Notation ltb_lt := Nat.ltb_lt (only parsing). +Notation pow := Nat.pow (only parsing). +Notation pow_0_r := Nat.pow_0_r (only parsing). +Notation pow_succ_r := Nat.pow_succ_r (only parsing). +Notation square := Nat.square (only parsing). +Notation square_spec := Nat.square_spec (only parsing). +Notation Even := Nat.Even (only parsing). +Notation Odd := Nat.Odd (only parsing). +Notation even := Nat.even (only parsing). +Notation odd := Nat.odd (only parsing). +Notation even_spec := Nat.even_spec (only parsing). +Notation odd_spec := Nat.odd_spec (only parsing). Lemma Even_equiv n : Even n <-> Even.even n. Proof. symmetry. apply Even.even_equiv. Qed. Lemma Odd_equiv n : Odd n <-> Even.odd n. Proof. symmetry. apply Even.odd_equiv. Qed. -Notation divmod := Nat.divmod (compat "8.4"). -Notation div := Nat.div (compat "8.4"). -Notation modulo := Nat.modulo (compat "8.4"). -Notation divmod_spec := Nat.divmod_spec (compat "8.4"). -Notation div_mod := Nat.div_mod (compat "8.4"). -Notation mod_bound_pos := Nat.mod_bound_pos (compat "8.4"). -Notation sqrt_iter := Nat.sqrt_iter (compat "8.4"). -Notation sqrt := Nat.sqrt (compat "8.4"). -Notation sqrt_iter_spec := Nat.sqrt_iter_spec (compat "8.4"). -Notation sqrt_spec := Nat.sqrt_spec (compat "8.4"). -Notation log2_iter := Nat.log2_iter (compat "8.4"). -Notation log2 := Nat.log2 (compat "8.4"). -Notation log2_iter_spec := Nat.log2_iter_spec (compat "8.4"). -Notation log2_spec := Nat.log2_spec (compat "8.4"). -Notation log2_nonpos := Nat.log2_nonpos (compat "8.4"). -Notation gcd := Nat.gcd (compat "8.4"). -Notation divide := Nat.divide (compat "8.4"). -Notation gcd_divide := Nat.gcd_divide (compat "8.4"). -Notation gcd_divide_l := Nat.gcd_divide_l (compat "8.4"). -Notation gcd_divide_r := Nat.gcd_divide_r (compat "8.4"). -Notation gcd_greatest := Nat.gcd_greatest (compat "8.4"). -Notation testbit := Nat.testbit (compat "8.4"). -Notation shiftl := Nat.shiftl (compat "8.4"). -Notation shiftr := Nat.shiftr (compat "8.4"). -Notation bitwise := Nat.bitwise (compat "8.4"). -Notation land := Nat.land (compat "8.4"). -Notation lor := Nat.lor (compat "8.4"). -Notation ldiff := Nat.ldiff (compat "8.4"). -Notation lxor := Nat.lxor (compat "8.4"). -Notation double_twice := Nat.double_twice (compat "8.4"). -Notation testbit_0_l := Nat.testbit_0_l (compat "8.4"). -Notation testbit_odd_0 := Nat.testbit_odd_0 (compat "8.4"). -Notation testbit_even_0 := Nat.testbit_even_0 (compat "8.4"). -Notation testbit_odd_succ := Nat.testbit_odd_succ (compat "8.4"). -Notation testbit_even_succ := Nat.testbit_even_succ (compat "8.4"). -Notation shiftr_spec := Nat.shiftr_spec (compat "8.4"). -Notation shiftl_spec_high := Nat.shiftl_spec_high (compat "8.4"). -Notation shiftl_spec_low := Nat.shiftl_spec_low (compat "8.4"). -Notation div2_bitwise := Nat.div2_bitwise (compat "8.4"). -Notation odd_bitwise := Nat.odd_bitwise (compat "8.4"). -Notation div2_decr := Nat.div2_decr (compat "8.4"). -Notation testbit_bitwise_1 := Nat.testbit_bitwise_1 (compat "8.4"). -Notation testbit_bitwise_2 := Nat.testbit_bitwise_2 (compat "8.4"). -Notation land_spec := Nat.land_spec (compat "8.4"). -Notation ldiff_spec := Nat.ldiff_spec (compat "8.4"). -Notation lor_spec := Nat.lor_spec (compat "8.4"). -Notation lxor_spec := Nat.lxor_spec (compat "8.4"). +Notation divmod := Nat.divmod (only parsing). +Notation div := Nat.div (only parsing). +Notation modulo := Nat.modulo (only parsing). +Notation divmod_spec := Nat.divmod_spec (only parsing). +Notation div_mod := Nat.div_mod (only parsing). +Notation mod_bound_pos := Nat.mod_bound_pos (only parsing). +Notation sqrt_iter := Nat.sqrt_iter (only parsing). +Notation sqrt := Nat.sqrt (only parsing). +Notation sqrt_iter_spec := Nat.sqrt_iter_spec (only parsing). +Notation sqrt_spec := Nat.sqrt_spec (only parsing). +Notation log2_iter := Nat.log2_iter (only parsing). +Notation log2 := Nat.log2 (only parsing). +Notation log2_iter_spec := Nat.log2_iter_spec (only parsing). +Notation log2_spec := Nat.log2_spec (only parsing). +Notation log2_nonpos := Nat.log2_nonpos (only parsing). +Notation gcd := Nat.gcd (only parsing). +Notation divide := Nat.divide (only parsing). +Notation gcd_divide := Nat.gcd_divide (only parsing). +Notation gcd_divide_l := Nat.gcd_divide_l (only parsing). +Notation gcd_divide_r := Nat.gcd_divide_r (only parsing). +Notation gcd_greatest := Nat.gcd_greatest (only parsing). +Notation testbit := Nat.testbit (only parsing). +Notation shiftl := Nat.shiftl (only parsing). +Notation shiftr := Nat.shiftr (only parsing). +Notation bitwise := Nat.bitwise (only parsing). +Notation land := Nat.land (only parsing). +Notation lor := Nat.lor (only parsing). +Notation ldiff := Nat.ldiff (only parsing). +Notation lxor := Nat.lxor (only parsing). +Notation double_twice := Nat.double_twice (only parsing). +Notation testbit_0_l := Nat.testbit_0_l (only parsing). +Notation testbit_odd_0 := Nat.testbit_odd_0 (only parsing). +Notation testbit_even_0 := Nat.testbit_even_0 (only parsing). +Notation testbit_odd_succ := Nat.testbit_odd_succ (only parsing). +Notation testbit_even_succ := Nat.testbit_even_succ (only parsing). +Notation shiftr_spec := Nat.shiftr_spec (only parsing). +Notation shiftl_spec_high := Nat.shiftl_spec_high (only parsing). +Notation shiftl_spec_low := Nat.shiftl_spec_low (only parsing). +Notation div2_bitwise := Nat.div2_bitwise (only parsing). +Notation odd_bitwise := Nat.odd_bitwise (only parsing). +Notation div2_decr := Nat.div2_decr (only parsing). +Notation testbit_bitwise_1 := Nat.testbit_bitwise_1 (only parsing). +Notation testbit_bitwise_2 := Nat.testbit_bitwise_2 (only parsing). +Notation land_spec := Nat.land_spec (only parsing). +Notation ldiff_spec := Nat.ldiff_spec (only parsing). +Notation lor_spec := Nat.lor_spec (only parsing). +Notation lxor_spec := Nat.lxor_spec (only parsing). Infix "<=?" := Nat.leb (at level 70) : nat_scope. Infix "<?" := Nat.ltb (at level 70) : nat_scope. diff --git a/theories/PArith/BinPos.v b/theories/PArith/BinPos.v index ff880eefa4..3adc72e147 100644 --- a/theories/PArith/BinPos.v +++ b/theories/PArith/BinPos.v @@ -1903,180 +1903,180 @@ Notation IsNul := Pos.IsNul (only parsing). Notation IsPos := Pos.IsPos (only parsing). Notation IsNeg := Pos.IsNeg (only parsing). -Notation Psucc := Pos.succ (compat "8.3"). -Notation Pplus := Pos.add (compat "8.3"). -Notation Pplus_carry := Pos.add_carry (compat "8.3"). -Notation Ppred := Pos.pred (compat "8.3"). -Notation Piter_op := Pos.iter_op (compat "8.3"). -Notation Piter_op_succ := Pos.iter_op_succ (compat "8.3"). -Notation Pmult_nat := (Pos.iter_op plus) (compat "8.3"). -Notation nat_of_P := Pos.to_nat (compat "8.3"). -Notation P_of_succ_nat := Pos.of_succ_nat (compat "8.3"). -Notation Pdouble_minus_one := Pos.pred_double (compat "8.3"). -Notation positive_mask := Pos.mask (compat "8.3"). -Notation positive_mask_rect := Pos.mask_rect (compat "8.3"). -Notation positive_mask_ind := Pos.mask_ind (compat "8.3"). -Notation positive_mask_rec := Pos.mask_rec (compat "8.3"). -Notation Pdouble_plus_one_mask := Pos.succ_double_mask (compat "8.3"). -Notation Pdouble_mask := Pos.double_mask (compat "8.3"). -Notation Pdouble_minus_two := Pos.double_pred_mask (compat "8.3"). -Notation Pminus_mask := Pos.sub_mask (compat "8.3"). -Notation Pminus_mask_carry := Pos.sub_mask_carry (compat "8.3"). -Notation Pminus := Pos.sub (compat "8.3"). -Notation Pmult := Pos.mul (compat "8.3"). -Notation iter_pos := @Pos.iter (compat "8.3"). -Notation Ppow := Pos.pow (compat "8.3"). -Notation Pdiv2 := Pos.div2 (compat "8.3"). -Notation Pdiv2_up := Pos.div2_up (compat "8.3"). -Notation Psize := Pos.size_nat (compat "8.3"). -Notation Psize_pos := Pos.size (compat "8.3"). -Notation Pcompare x y m := (Pos.compare_cont m x y) (compat "8.3"). -Notation Plt := Pos.lt (compat "8.3"). -Notation Pgt := Pos.gt (compat "8.3"). -Notation Ple := Pos.le (compat "8.3"). -Notation Pge := Pos.ge (compat "8.3"). -Notation Pmin := Pos.min (compat "8.3"). -Notation Pmax := Pos.max (compat "8.3"). -Notation Peqb := Pos.eqb (compat "8.3"). -Notation positive_eq_dec := Pos.eq_dec (compat "8.3"). -Notation xI_succ_xO := Pos.xI_succ_xO (compat "8.3"). -Notation Psucc_discr := Pos.succ_discr (compat "8.3"). +Notation Psucc := Pos.succ (compat "8.6"). +Notation Pplus := Pos.add (only parsing). +Notation Pplus_carry := Pos.add_carry (only parsing). +Notation Ppred := Pos.pred (compat "8.6"). +Notation Piter_op := Pos.iter_op (compat "8.6"). +Notation Piter_op_succ := Pos.iter_op_succ (compat "8.6"). +Notation Pmult_nat := (Pos.iter_op plus) (only parsing). +Notation nat_of_P := Pos.to_nat (only parsing). +Notation P_of_succ_nat := Pos.of_succ_nat (only parsing). +Notation Pdouble_minus_one := Pos.pred_double (only parsing). +Notation positive_mask := Pos.mask (only parsing). +Notation positive_mask_rect := Pos.mask_rect (only parsing). +Notation positive_mask_ind := Pos.mask_ind (only parsing). +Notation positive_mask_rec := Pos.mask_rec (only parsing). +Notation Pdouble_plus_one_mask := Pos.succ_double_mask (only parsing). +Notation Pdouble_mask := Pos.double_mask (compat "8.6"). +Notation Pdouble_minus_two := Pos.double_pred_mask (only parsing). +Notation Pminus_mask := Pos.sub_mask (only parsing). +Notation Pminus_mask_carry := Pos.sub_mask_carry (only parsing). +Notation Pminus := Pos.sub (only parsing). +Notation Pmult := Pos.mul (only parsing). +Notation iter_pos := @Pos.iter (only parsing). +Notation Ppow := Pos.pow (compat "8.6"). +Notation Pdiv2 := Pos.div2 (compat "8.6"). +Notation Pdiv2_up := Pos.div2_up (compat "8.6"). +Notation Psize := Pos.size_nat (only parsing). +Notation Psize_pos := Pos.size (only parsing). +Notation Pcompare x y m := (Pos.compare_cont m x y) (only parsing). +Notation Plt := Pos.lt (compat "8.6"). +Notation Pgt := Pos.gt (compat "8.6"). +Notation Ple := Pos.le (compat "8.6"). +Notation Pge := Pos.ge (compat "8.6"). +Notation Pmin := Pos.min (compat "8.6"). +Notation Pmax := Pos.max (compat "8.6"). +Notation Peqb := Pos.eqb (compat "8.6"). +Notation positive_eq_dec := Pos.eq_dec (only parsing). +Notation xI_succ_xO := Pos.xI_succ_xO (only parsing). +Notation Psucc_discr := Pos.succ_discr (compat "8.6"). Notation Psucc_o_double_minus_one_eq_xO := - Pos.succ_pred_double (compat "8.3"). + Pos.succ_pred_double (only parsing). Notation Pdouble_minus_one_o_succ_eq_xI := - Pos.pred_double_succ (compat "8.3"). -Notation xO_succ_permute := Pos.double_succ (compat "8.3"). + Pos.pred_double_succ (only parsing). +Notation xO_succ_permute := Pos.double_succ (only parsing). Notation double_moins_un_xO_discr := - Pos.pred_double_xO_discr (compat "8.3"). -Notation Psucc_not_one := Pos.succ_not_1 (compat "8.3"). -Notation Ppred_succ := Pos.pred_succ (compat "8.3"). -Notation Psucc_pred := Pos.succ_pred_or (compat "8.3"). -Notation Psucc_inj := Pos.succ_inj (compat "8.3"). -Notation Pplus_carry_spec := Pos.add_carry_spec (compat "8.3"). -Notation Pplus_comm := Pos.add_comm (compat "8.3"). -Notation Pplus_succ_permute_r := Pos.add_succ_r (compat "8.3"). -Notation Pplus_succ_permute_l := Pos.add_succ_l (compat "8.3"). -Notation Pplus_no_neutral := Pos.add_no_neutral (compat "8.3"). -Notation Pplus_carry_plus := Pos.add_carry_add (compat "8.3"). -Notation Pplus_reg_r := Pos.add_reg_r (compat "8.3"). -Notation Pplus_reg_l := Pos.add_reg_l (compat "8.3"). -Notation Pplus_carry_reg_r := Pos.add_carry_reg_r (compat "8.3"). -Notation Pplus_carry_reg_l := Pos.add_carry_reg_l (compat "8.3"). -Notation Pplus_assoc := Pos.add_assoc (compat "8.3"). -Notation Pplus_xO := Pos.add_xO (compat "8.3"). -Notation Pplus_xI_double_minus_one := Pos.add_xI_pred_double (compat "8.3"). -Notation Pplus_xO_double_minus_one := Pos.add_xO_pred_double (compat "8.3"). -Notation Pplus_diag := Pos.add_diag (compat "8.3"). -Notation PeanoView := Pos.PeanoView (compat "8.3"). -Notation PeanoOne := Pos.PeanoOne (compat "8.3"). -Notation PeanoSucc := Pos.PeanoSucc (compat "8.3"). -Notation PeanoView_rect := Pos.PeanoView_rect (compat "8.3"). -Notation PeanoView_ind := Pos.PeanoView_ind (compat "8.3"). -Notation PeanoView_rec := Pos.PeanoView_rec (compat "8.3"). -Notation peanoView_xO := Pos.peanoView_xO (compat "8.3"). -Notation peanoView_xI := Pos.peanoView_xI (compat "8.3"). -Notation peanoView := Pos.peanoView (compat "8.3"). -Notation PeanoView_iter := Pos.PeanoView_iter (compat "8.3"). -Notation eq_dep_eq_positive := Pos.eq_dep_eq_positive (compat "8.3"). -Notation PeanoViewUnique := Pos.PeanoViewUnique (compat "8.3"). -Notation Prect := Pos.peano_rect (compat "8.3"). -Notation Prect_succ := Pos.peano_rect_succ (compat "8.3"). -Notation Prect_base := Pos.peano_rect_base (compat "8.3"). -Notation Prec := Pos.peano_rec (compat "8.3"). -Notation Pind := Pos.peano_ind (compat "8.3"). -Notation Pcase := Pos.peano_case (compat "8.3"). -Notation Pmult_1_r := Pos.mul_1_r (compat "8.3"). -Notation Pmult_Sn_m := Pos.mul_succ_l (compat "8.3"). -Notation Pmult_xO_permute_r := Pos.mul_xO_r (compat "8.3"). -Notation Pmult_xI_permute_r := Pos.mul_xI_r (compat "8.3"). -Notation Pmult_comm := Pos.mul_comm (compat "8.3"). -Notation Pmult_plus_distr_l := Pos.mul_add_distr_l (compat "8.3"). -Notation Pmult_plus_distr_r := Pos.mul_add_distr_r (compat "8.3"). -Notation Pmult_assoc := Pos.mul_assoc (compat "8.3"). -Notation Pmult_xI_mult_xO_discr := Pos.mul_xI_mul_xO_discr (compat "8.3"). -Notation Pmult_xO_discr := Pos.mul_xO_discr (compat "8.3"). -Notation Pmult_reg_r := Pos.mul_reg_r (compat "8.3"). -Notation Pmult_reg_l := Pos.mul_reg_l (compat "8.3"). -Notation Pmult_1_inversion_l := Pos.mul_eq_1_l (compat "8.3"). -Notation Psquare_xO := Pos.square_xO (compat "8.3"). -Notation Psquare_xI := Pos.square_xI (compat "8.3"). -Notation iter_pos_swap_gen := Pos.iter_swap_gen (compat "8.3"). -Notation iter_pos_swap := Pos.iter_swap (compat "8.3"). -Notation iter_pos_succ := Pos.iter_succ (compat "8.3"). -Notation iter_pos_plus := Pos.iter_add (compat "8.3"). -Notation iter_pos_invariant := Pos.iter_invariant (compat "8.3"). -Notation Ppow_1_r := Pos.pow_1_r (compat "8.3"). -Notation Ppow_succ_r := Pos.pow_succ_r (compat "8.3"). -Notation Peqb_refl := Pos.eqb_refl (compat "8.3"). -Notation Peqb_eq := Pos.eqb_eq (compat "8.3"). -Notation Pcompare_refl_id := Pos.compare_cont_refl (compat "8.3"). -Notation Pcompare_eq_iff := Pos.compare_eq_iff (compat "8.3"). -Notation Pcompare_Gt_Lt := Pos.compare_cont_Gt_Lt (compat "8.3"). -Notation Pcompare_eq_Lt := Pos.compare_lt_iff (compat "8.3"). -Notation Pcompare_Lt_Gt := Pos.compare_cont_Lt_Gt (compat "8.3"). - -Notation Pcompare_antisym := Pos.compare_cont_antisym (compat "8.3"). -Notation ZC1 := Pos.gt_lt (compat "8.3"). -Notation ZC2 := Pos.lt_gt (compat "8.3"). -Notation Pcompare_spec := Pos.compare_spec (compat "8.3"). -Notation Pcompare_p_Sp := Pos.lt_succ_diag_r (compat "8.3"). -Notation Pcompare_succ_succ := Pos.compare_succ_succ (compat "8.3"). -Notation Pcompare_1 := Pos.nlt_1_r (compat "8.3"). -Notation Plt_1 := Pos.nlt_1_r (compat "8.3"). -Notation Plt_1_succ := Pos.lt_1_succ (compat "8.3"). -Notation Plt_lt_succ := Pos.lt_lt_succ (compat "8.3"). -Notation Plt_irrefl := Pos.lt_irrefl (compat "8.3"). -Notation Plt_trans := Pos.lt_trans (compat "8.3"). -Notation Plt_ind := Pos.lt_ind (compat "8.3"). -Notation Ple_lteq := Pos.le_lteq (compat "8.3"). -Notation Ple_refl := Pos.le_refl (compat "8.3"). -Notation Ple_lt_trans := Pos.le_lt_trans (compat "8.3"). -Notation Plt_le_trans := Pos.lt_le_trans (compat "8.3"). -Notation Ple_trans := Pos.le_trans (compat "8.3"). -Notation Plt_succ_r := Pos.lt_succ_r (compat "8.3"). -Notation Ple_succ_l := Pos.le_succ_l (compat "8.3"). -Notation Pplus_compare_mono_l := Pos.add_compare_mono_l (compat "8.3"). -Notation Pplus_compare_mono_r := Pos.add_compare_mono_r (compat "8.3"). -Notation Pplus_lt_mono_l := Pos.add_lt_mono_l (compat "8.3"). -Notation Pplus_lt_mono_r := Pos.add_lt_mono_r (compat "8.3"). -Notation Pplus_lt_mono := Pos.add_lt_mono (compat "8.3"). -Notation Pplus_le_mono_l := Pos.add_le_mono_l (compat "8.3"). -Notation Pplus_le_mono_r := Pos.add_le_mono_r (compat "8.3"). -Notation Pplus_le_mono := Pos.add_le_mono (compat "8.3"). -Notation Pmult_compare_mono_l := Pos.mul_compare_mono_l (compat "8.3"). -Notation Pmult_compare_mono_r := Pos.mul_compare_mono_r (compat "8.3"). -Notation Pmult_lt_mono_l := Pos.mul_lt_mono_l (compat "8.3"). -Notation Pmult_lt_mono_r := Pos.mul_lt_mono_r (compat "8.3"). -Notation Pmult_lt_mono := Pos.mul_lt_mono (compat "8.3"). -Notation Pmult_le_mono_l := Pos.mul_le_mono_l (compat "8.3"). -Notation Pmult_le_mono_r := Pos.mul_le_mono_r (compat "8.3"). -Notation Pmult_le_mono := Pos.mul_le_mono (compat "8.3"). -Notation Plt_plus_r := Pos.lt_add_r (compat "8.3"). -Notation Plt_not_plus_l := Pos.lt_not_add_l (compat "8.3"). -Notation Ppow_gt_1 := Pos.pow_gt_1 (compat "8.3"). -Notation Ppred_mask := Pos.pred_mask (compat "8.3"). -Notation Pminus_mask_succ_r := Pos.sub_mask_succ_r (compat "8.3"). -Notation Pminus_mask_carry_spec := Pos.sub_mask_carry_spec (compat "8.3"). -Notation Pminus_succ_r := Pos.sub_succ_r (compat "8.3"). -Notation Pminus_mask_diag := Pos.sub_mask_diag (compat "8.3"). - -Notation Pplus_minus_eq := Pos.add_sub (compat "8.3"). -Notation Pmult_minus_distr_l := Pos.mul_sub_distr_l (compat "8.3"). -Notation Pminus_lt_mono_l := Pos.sub_lt_mono_l (compat "8.3"). -Notation Pminus_compare_mono_l := Pos.sub_compare_mono_l (compat "8.3"). -Notation Pminus_compare_mono_r := Pos.sub_compare_mono_r (compat "8.3"). -Notation Pminus_lt_mono_r := Pos.sub_lt_mono_r (compat "8.3"). -Notation Pminus_decr := Pos.sub_decr (compat "8.3"). -Notation Pminus_xI_xI := Pos.sub_xI_xI (compat "8.3"). -Notation Pplus_minus_assoc := Pos.add_sub_assoc (compat "8.3"). -Notation Pminus_plus_distr := Pos.sub_add_distr (compat "8.3"). -Notation Pminus_minus_distr := Pos.sub_sub_distr (compat "8.3"). -Notation Pminus_mask_Lt := Pos.sub_mask_neg (compat "8.3"). -Notation Pminus_Lt := Pos.sub_lt (compat "8.3"). -Notation Pminus_Eq := Pos.sub_diag (compat "8.3"). -Notation Psize_monotone := Pos.size_nat_monotone (compat "8.3"). -Notation Psize_pos_gt := Pos.size_gt (compat "8.3"). -Notation Psize_pos_le := Pos.size_le (compat "8.3"). + Pos.pred_double_xO_discr (only parsing). +Notation Psucc_not_one := Pos.succ_not_1 (only parsing). +Notation Ppred_succ := Pos.pred_succ (compat "8.6"). +Notation Psucc_pred := Pos.succ_pred_or (only parsing). +Notation Psucc_inj := Pos.succ_inj (compat "8.6"). +Notation Pplus_carry_spec := Pos.add_carry_spec (only parsing). +Notation Pplus_comm := Pos.add_comm (only parsing). +Notation Pplus_succ_permute_r := Pos.add_succ_r (only parsing). +Notation Pplus_succ_permute_l := Pos.add_succ_l (only parsing). +Notation Pplus_no_neutral := Pos.add_no_neutral (only parsing). +Notation Pplus_carry_plus := Pos.add_carry_add (only parsing). +Notation Pplus_reg_r := Pos.add_reg_r (only parsing). +Notation Pplus_reg_l := Pos.add_reg_l (only parsing). +Notation Pplus_carry_reg_r := Pos.add_carry_reg_r (only parsing). +Notation Pplus_carry_reg_l := Pos.add_carry_reg_l (only parsing). +Notation Pplus_assoc := Pos.add_assoc (only parsing). +Notation Pplus_xO := Pos.add_xO (only parsing). +Notation Pplus_xI_double_minus_one := Pos.add_xI_pred_double (only parsing). +Notation Pplus_xO_double_minus_one := Pos.add_xO_pred_double (only parsing). +Notation Pplus_diag := Pos.add_diag (only parsing). +Notation PeanoView := Pos.PeanoView (only parsing). +Notation PeanoOne := Pos.PeanoOne (only parsing). +Notation PeanoSucc := Pos.PeanoSucc (only parsing). +Notation PeanoView_rect := Pos.PeanoView_rect (only parsing). +Notation PeanoView_ind := Pos.PeanoView_ind (only parsing). +Notation PeanoView_rec := Pos.PeanoView_rec (only parsing). +Notation peanoView_xO := Pos.peanoView_xO (only parsing). +Notation peanoView_xI := Pos.peanoView_xI (only parsing). +Notation peanoView := Pos.peanoView (only parsing). +Notation PeanoView_iter := Pos.PeanoView_iter (only parsing). +Notation eq_dep_eq_positive := Pos.eq_dep_eq_positive (only parsing). +Notation PeanoViewUnique := Pos.PeanoViewUnique (only parsing). +Notation Prect := Pos.peano_rect (only parsing). +Notation Prect_succ := Pos.peano_rect_succ (only parsing). +Notation Prect_base := Pos.peano_rect_base (only parsing). +Notation Prec := Pos.peano_rec (only parsing). +Notation Pind := Pos.peano_ind (only parsing). +Notation Pcase := Pos.peano_case (only parsing). +Notation Pmult_1_r := Pos.mul_1_r (only parsing). +Notation Pmult_Sn_m := Pos.mul_succ_l (only parsing). +Notation Pmult_xO_permute_r := Pos.mul_xO_r (only parsing). +Notation Pmult_xI_permute_r := Pos.mul_xI_r (only parsing). +Notation Pmult_comm := Pos.mul_comm (only parsing). +Notation Pmult_plus_distr_l := Pos.mul_add_distr_l (only parsing). +Notation Pmult_plus_distr_r := Pos.mul_add_distr_r (only parsing). +Notation Pmult_assoc := Pos.mul_assoc (only parsing). +Notation Pmult_xI_mult_xO_discr := Pos.mul_xI_mul_xO_discr (only parsing). +Notation Pmult_xO_discr := Pos.mul_xO_discr (only parsing). +Notation Pmult_reg_r := Pos.mul_reg_r (only parsing). +Notation Pmult_reg_l := Pos.mul_reg_l (only parsing). +Notation Pmult_1_inversion_l := Pos.mul_eq_1_l (only parsing). +Notation Psquare_xO := Pos.square_xO (compat "8.6"). +Notation Psquare_xI := Pos.square_xI (compat "8.6"). +Notation iter_pos_swap_gen := Pos.iter_swap_gen (only parsing). +Notation iter_pos_swap := Pos.iter_swap (only parsing). +Notation iter_pos_succ := Pos.iter_succ (only parsing). +Notation iter_pos_plus := Pos.iter_add (only parsing). +Notation iter_pos_invariant := Pos.iter_invariant (only parsing). +Notation Ppow_1_r := Pos.pow_1_r (compat "8.6"). +Notation Ppow_succ_r := Pos.pow_succ_r (compat "8.6"). +Notation Peqb_refl := Pos.eqb_refl (compat "8.6"). +Notation Peqb_eq := Pos.eqb_eq (compat "8.6"). +Notation Pcompare_refl_id := Pos.compare_cont_refl (only parsing). +Notation Pcompare_eq_iff := Pos.compare_eq_iff (only parsing). +Notation Pcompare_Gt_Lt := Pos.compare_cont_Gt_Lt (only parsing). +Notation Pcompare_eq_Lt := Pos.compare_lt_iff (only parsing). +Notation Pcompare_Lt_Gt := Pos.compare_cont_Lt_Gt (only parsing). + +Notation Pcompare_antisym := Pos.compare_cont_antisym (only parsing). +Notation ZC1 := Pos.gt_lt (only parsing). +Notation ZC2 := Pos.lt_gt (only parsing). +Notation Pcompare_spec := Pos.compare_spec (compat "8.6"). +Notation Pcompare_p_Sp := Pos.lt_succ_diag_r (only parsing). +Notation Pcompare_succ_succ := Pos.compare_succ_succ (compat "8.6"). +Notation Pcompare_1 := Pos.nlt_1_r (only parsing). +Notation Plt_1 := Pos.nlt_1_r (only parsing). +Notation Plt_1_succ := Pos.lt_1_succ (compat "8.6"). +Notation Plt_lt_succ := Pos.lt_lt_succ (compat "8.6"). +Notation Plt_irrefl := Pos.lt_irrefl (compat "8.6"). +Notation Plt_trans := Pos.lt_trans (compat "8.6"). +Notation Plt_ind := Pos.lt_ind (compat "8.6"). +Notation Ple_lteq := Pos.le_lteq (compat "8.6"). +Notation Ple_refl := Pos.le_refl (compat "8.6"). +Notation Ple_lt_trans := Pos.le_lt_trans (compat "8.6"). +Notation Plt_le_trans := Pos.lt_le_trans (compat "8.6"). +Notation Ple_trans := Pos.le_trans (compat "8.6"). +Notation Plt_succ_r := Pos.lt_succ_r (compat "8.6"). +Notation Ple_succ_l := Pos.le_succ_l (compat "8.6"). +Notation Pplus_compare_mono_l := Pos.add_compare_mono_l (only parsing). +Notation Pplus_compare_mono_r := Pos.add_compare_mono_r (only parsing). +Notation Pplus_lt_mono_l := Pos.add_lt_mono_l (only parsing). +Notation Pplus_lt_mono_r := Pos.add_lt_mono_r (only parsing). +Notation Pplus_lt_mono := Pos.add_lt_mono (only parsing). +Notation Pplus_le_mono_l := Pos.add_le_mono_l (only parsing). +Notation Pplus_le_mono_r := Pos.add_le_mono_r (only parsing). +Notation Pplus_le_mono := Pos.add_le_mono (only parsing). +Notation Pmult_compare_mono_l := Pos.mul_compare_mono_l (only parsing). +Notation Pmult_compare_mono_r := Pos.mul_compare_mono_r (only parsing). +Notation Pmult_lt_mono_l := Pos.mul_lt_mono_l (only parsing). +Notation Pmult_lt_mono_r := Pos.mul_lt_mono_r (only parsing). +Notation Pmult_lt_mono := Pos.mul_lt_mono (only parsing). +Notation Pmult_le_mono_l := Pos.mul_le_mono_l (only parsing). +Notation Pmult_le_mono_r := Pos.mul_le_mono_r (only parsing). +Notation Pmult_le_mono := Pos.mul_le_mono (only parsing). +Notation Plt_plus_r := Pos.lt_add_r (only parsing). +Notation Plt_not_plus_l := Pos.lt_not_add_l (only parsing). +Notation Ppow_gt_1 := Pos.pow_gt_1 (compat "8.6"). +Notation Ppred_mask := Pos.pred_mask (compat "8.6"). +Notation Pminus_mask_succ_r := Pos.sub_mask_succ_r (only parsing). +Notation Pminus_mask_carry_spec := Pos.sub_mask_carry_spec (only parsing). +Notation Pminus_succ_r := Pos.sub_succ_r (only parsing). +Notation Pminus_mask_diag := Pos.sub_mask_diag (only parsing). + +Notation Pplus_minus_eq := Pos.add_sub (only parsing). +Notation Pmult_minus_distr_l := Pos.mul_sub_distr_l (only parsing). +Notation Pminus_lt_mono_l := Pos.sub_lt_mono_l (only parsing). +Notation Pminus_compare_mono_l := Pos.sub_compare_mono_l (only parsing). +Notation Pminus_compare_mono_r := Pos.sub_compare_mono_r (only parsing). +Notation Pminus_lt_mono_r := Pos.sub_lt_mono_r (only parsing). +Notation Pminus_decr := Pos.sub_decr (only parsing). +Notation Pminus_xI_xI := Pos.sub_xI_xI (only parsing). +Notation Pplus_minus_assoc := Pos.add_sub_assoc (only parsing). +Notation Pminus_plus_distr := Pos.sub_add_distr (only parsing). +Notation Pminus_minus_distr := Pos.sub_sub_distr (only parsing). +Notation Pminus_mask_Lt := Pos.sub_mask_neg (only parsing). +Notation Pminus_Lt := Pos.sub_lt (only parsing). +Notation Pminus_Eq := Pos.sub_diag (only parsing). +Notation Psize_monotone := Pos.size_nat_monotone (only parsing). +Notation Psize_pos_gt := Pos.size_gt (only parsing). +Notation Psize_pos_le := Pos.size_le (only parsing). (** More complex compatibility facts, expressed as lemmas (to preserve scopes for instance) *) diff --git a/theories/PArith/Pnat.v b/theories/PArith/Pnat.v index 461967de85..6cbea8a3df 100644 --- a/theories/PArith/Pnat.v +++ b/theories/PArith/Pnat.v @@ -382,36 +382,36 @@ End SuccNat2Pos. (** For compatibility, old names and old-style lemmas *) -Notation Psucc_S := Pos2Nat.inj_succ (compat "8.3"). -Notation Pplus_plus := Pos2Nat.inj_add (compat "8.3"). -Notation Pmult_mult := Pos2Nat.inj_mul (compat "8.3"). -Notation Pcompare_nat_compare := Pos2Nat.inj_compare (compat "8.3"). -Notation nat_of_P_xH := Pos2Nat.inj_1 (compat "8.3"). -Notation nat_of_P_xO := Pos2Nat.inj_xO (compat "8.3"). -Notation nat_of_P_xI := Pos2Nat.inj_xI (compat "8.3"). -Notation nat_of_P_is_S := Pos2Nat.is_succ (compat "8.3"). -Notation nat_of_P_pos := Pos2Nat.is_pos (compat "8.3"). -Notation nat_of_P_inj_iff := Pos2Nat.inj_iff (compat "8.3"). -Notation nat_of_P_inj := Pos2Nat.inj (compat "8.3"). -Notation Plt_lt := Pos2Nat.inj_lt (compat "8.3"). -Notation Pgt_gt := Pos2Nat.inj_gt (compat "8.3"). -Notation Ple_le := Pos2Nat.inj_le (compat "8.3"). -Notation Pge_ge := Pos2Nat.inj_ge (compat "8.3"). -Notation Pminus_minus := Pos2Nat.inj_sub (compat "8.3"). -Notation iter_nat_of_P := @Pos2Nat.inj_iter (compat "8.3"). - -Notation nat_of_P_of_succ_nat := SuccNat2Pos.id_succ (compat "8.3"). -Notation P_of_succ_nat_of_P := Pos2SuccNat.id_succ (compat "8.3"). - -Notation nat_of_P_succ_morphism := Pos2Nat.inj_succ (compat "8.3"). -Notation nat_of_P_plus_morphism := Pos2Nat.inj_add (compat "8.3"). -Notation nat_of_P_mult_morphism := Pos2Nat.inj_mul (compat "8.3"). -Notation nat_of_P_compare_morphism := Pos2Nat.inj_compare (compat "8.3"). -Notation lt_O_nat_of_P := Pos2Nat.is_pos (compat "8.3"). -Notation ZL4 := Pos2Nat.is_succ (compat "8.3"). -Notation nat_of_P_o_P_of_succ_nat_eq_succ := SuccNat2Pos.id_succ (compat "8.3"). -Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (compat "8.3"). -Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (compat "8.3"). +Notation Psucc_S := Pos2Nat.inj_succ (only parsing). +Notation Pplus_plus := Pos2Nat.inj_add (only parsing). +Notation Pmult_mult := Pos2Nat.inj_mul (only parsing). +Notation Pcompare_nat_compare := Pos2Nat.inj_compare (only parsing). +Notation nat_of_P_xH := Pos2Nat.inj_1 (only parsing). +Notation nat_of_P_xO := Pos2Nat.inj_xO (only parsing). +Notation nat_of_P_xI := Pos2Nat.inj_xI (only parsing). +Notation nat_of_P_is_S := Pos2Nat.is_succ (only parsing). +Notation nat_of_P_pos := Pos2Nat.is_pos (only parsing). +Notation nat_of_P_inj_iff := Pos2Nat.inj_iff (only parsing). +Notation nat_of_P_inj := Pos2Nat.inj (only parsing). +Notation Plt_lt := Pos2Nat.inj_lt (only parsing). +Notation Pgt_gt := Pos2Nat.inj_gt (only parsing). +Notation Ple_le := Pos2Nat.inj_le (only parsing). +Notation Pge_ge := Pos2Nat.inj_ge (only parsing). +Notation Pminus_minus := Pos2Nat.inj_sub (only parsing). +Notation iter_nat_of_P := @Pos2Nat.inj_iter (only parsing). + +Notation nat_of_P_of_succ_nat := SuccNat2Pos.id_succ (only parsing). +Notation P_of_succ_nat_of_P := Pos2SuccNat.id_succ (only parsing). + +Notation nat_of_P_succ_morphism := Pos2Nat.inj_succ (only parsing). +Notation nat_of_P_plus_morphism := Pos2Nat.inj_add (only parsing). +Notation nat_of_P_mult_morphism := Pos2Nat.inj_mul (only parsing). +Notation nat_of_P_compare_morphism := Pos2Nat.inj_compare (only parsing). +Notation lt_O_nat_of_P := Pos2Nat.is_pos (only parsing). +Notation ZL4 := Pos2Nat.is_succ (only parsing). +Notation nat_of_P_o_P_of_succ_nat_eq_succ := SuccNat2Pos.id_succ (only parsing). +Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (only parsing). +Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (only parsing). Lemma nat_of_P_minus_morphism p q : Pos.compare_cont Eq p q = Gt -> diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v index 5d055b5474..959a7e5bdf 100644 --- a/theories/QArith/Qreduction.v +++ b/theories/QArith/Qreduction.v @@ -11,8 +11,8 @@ Require Export QArith_base. Require Import Znumtheory. -Notation Z2P := Z.to_pos (compat "8.3"). -Notation Z2P_correct := Z2Pos.id (compat "8.3"). +Notation Z2P := Z.to_pos (only parsing). +Notation Z2P_correct := Z2Pos.id (only parsing). (** Simplification of fractions using [Z.gcd]. This version can compute within Coq. *) diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index bc82c37124..ab7fa15d2f 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -2027,7 +2027,7 @@ Qed. Lemma R_rm : ring_morph 0%R 1%R Rplus Rmult Rminus Ropp eq - 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool IZR. + 0%Z 1%Z Zplus Zmult Zminus Z.opp Zeq_bool IZR. Proof. constructor ; try easy. exact plus_IZR. diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v index 17b3c5099a..a50c7f9523 100644 --- a/theories/Reals/Rbasic_fun.v +++ b/theories/Reals/Rbasic_fun.v @@ -609,7 +609,7 @@ Qed. Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Z.abs z). Proof. - intros z; case z; unfold Zabs. + intros z; case z; unfold Z.abs. apply Rabs_R0. now intros p0; apply Rabs_pos_eq, (IZR_le 0). unfold IZR at 1. diff --git a/theories/Reals/Rlogic.v b/theories/Reals/Rlogic.v index 4ad3339ec9..c1b479b61a 100644 --- a/theories/Reals/Rlogic.v +++ b/theories/Reals/Rlogic.v @@ -63,7 +63,7 @@ destruct (Rle_lt_dec l 0) as [Hl|Hl]. now apply Rinv_0_lt_compat. now apply Hnp. left. -set (N := Zabs_nat (up (/l) - 2)). +set (N := Z.abs_nat (up (/l) - 2)). assert (H1l: (1 <= /l)%R). rewrite <- Rinv_1. apply Rinv_le_contravar with (1 := Hl). @@ -75,7 +75,7 @@ assert (HN: (INR N + 1 = IZR (up (/ l)) - 1)%R). rewrite inj_Zabs_nat. replace (IZR (up (/ l)) - 1)%R with (IZR (up (/ l) - 2) + 1)%R. apply (f_equal (fun v => IZR v + 1)%R). - apply Zabs_eq. + apply Z.abs_eq. apply Zle_minus_le_0. apply (Zlt_le_succ 1). apply lt_IZR. diff --git a/theories/Structures/OrderedTypeEx.v b/theories/Structures/OrderedTypeEx.v index 3c6afc7b25..9b004a6da0 100644 --- a/theories/Structures/OrderedTypeEx.v +++ b/theories/Structures/OrderedTypeEx.v @@ -55,7 +55,7 @@ Module Nat_as_OT <: UsualOrderedType. Definition compare x y : Compare lt eq x y. Proof. - case_eq (nat_compare x y); intro. + case_eq (Nat.compare x y); intro. - apply EQ. now apply nat_compare_eq. - apply LT. now apply nat_compare_Lt_lt. - apply GT. now apply nat_compare_Gt_gt. diff --git a/theories/Vectors/VectorDef.v b/theories/Vectors/VectorDef.v index c494517766..a21b9ca988 100644 --- a/theories/Vectors/VectorDef.v +++ b/theories/Vectors/VectorDef.v @@ -305,12 +305,10 @@ End VECTORLIST. Module VectorNotations. Delimit Scope vector_scope with vector. Notation "[ ]" := [] (format "[ ]") : vector_scope. -Notation "[]" := [] (compat "8.5") : vector_scope. Notation "h :: t" := (h :: t) (at level 60, right associativity) : vector_scope. Notation "[ x ]" := (x :: []) : vector_scope. Notation "[ x ; y ; .. ; z ]" := (cons _ x _ (cons _ y _ .. (cons _ z _ (nil _)) ..)) : vector_scope. -Notation "[ x ; .. ; y ]" := (cons _ x _ .. (cons _ y _ (nil _)) ..) (compat "8.4") : vector_scope. Notation "v [@ p ]" := (nth v p) (at level 1, format "v [@ p ]") : vector_scope. Open Scope vector_scope. End VectorNotations. diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index e6fd0f22eb..e7dd8aebbc 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -1565,94 +1565,94 @@ End Z2Pos. (** Compatibility Notations *) -Notation Zdouble_plus_one := Z.succ_double (compat "8.3"). -Notation Zdouble_minus_one := Z.pred_double (compat "8.3"). -Notation Zdouble := Z.double (compat "8.3"). -Notation ZPminus := Z.pos_sub (compat "8.3"). -Notation Zsucc' := Z.succ (compat "8.3"). -Notation Zpred' := Z.pred (compat "8.3"). -Notation Zplus' := Z.add (compat "8.3"). -Notation Zplus := Z.add (compat "8.3"). (* Slightly incompatible *) -Notation Zopp := Z.opp (compat "8.3"). -Notation Zsucc := Z.succ (compat "8.3"). -Notation Zpred := Z.pred (compat "8.3"). -Notation Zminus := Z.sub (compat "8.3"). -Notation Zmult := Z.mul (compat "8.3"). -Notation Zcompare := Z.compare (compat "8.3"). -Notation Zsgn := Z.sgn (compat "8.3"). -Notation Zle := Z.le (compat "8.3"). -Notation Zge := Z.ge (compat "8.3"). -Notation Zlt := Z.lt (compat "8.3"). -Notation Zgt := Z.gt (compat "8.3"). -Notation Zmax := Z.max (compat "8.3"). -Notation Zmin := Z.min (compat "8.3"). -Notation Zabs := Z.abs (compat "8.3"). -Notation Zabs_nat := Z.abs_nat (compat "8.3"). -Notation Zabs_N := Z.abs_N (compat "8.3"). -Notation Z_of_nat := Z.of_nat (compat "8.3"). -Notation Z_of_N := Z.of_N (compat "8.3"). - -Notation Zind := Z.peano_ind (compat "8.3"). -Notation Zopp_0 := Z.opp_0 (compat "8.3"). -Notation Zopp_involutive := Z.opp_involutive (compat "8.3"). -Notation Zopp_inj := Z.opp_inj (compat "8.3"). -Notation Zplus_0_l := Z.add_0_l (compat "8.3"). -Notation Zplus_0_r := Z.add_0_r (compat "8.3"). -Notation Zplus_comm := Z.add_comm (compat "8.3"). -Notation Zopp_plus_distr := Z.opp_add_distr (compat "8.3"). -Notation Zopp_succ := Z.opp_succ (compat "8.3"). -Notation Zplus_opp_r := Z.add_opp_diag_r (compat "8.3"). -Notation Zplus_opp_l := Z.add_opp_diag_l (compat "8.3"). -Notation Zplus_assoc := Z.add_assoc (compat "8.3"). -Notation Zplus_permute := Z.add_shuffle3 (compat "8.3"). -Notation Zplus_reg_l := Z.add_reg_l (compat "8.3"). -Notation Zplus_succ_l := Z.add_succ_l (compat "8.3"). -Notation Zplus_succ_comm := Z.add_succ_comm (compat "8.3"). -Notation Zsucc_discr := Z.neq_succ_diag_r (compat "8.3"). -Notation Zsucc_inj := Z.succ_inj (compat "8.3"). -Notation Zsucc'_inj := Z.succ_inj (compat "8.3"). -Notation Zsucc'_pred' := Z.succ_pred (compat "8.3"). -Notation Zpred'_succ' := Z.pred_succ (compat "8.3"). -Notation Zpred'_inj := Z.pred_inj (compat "8.3"). -Notation Zsucc'_discr := Z.neq_succ_diag_r (compat "8.3"). -Notation Zminus_0_r := Z.sub_0_r (compat "8.3"). -Notation Zminus_diag := Z.sub_diag (compat "8.3"). -Notation Zminus_plus_distr := Z.sub_add_distr (compat "8.3"). -Notation Zminus_succ_r := Z.sub_succ_r (compat "8.3"). -Notation Zminus_plus := Z.add_simpl_l (compat "8.3"). -Notation Zmult_0_l := Z.mul_0_l (compat "8.3"). -Notation Zmult_0_r := Z.mul_0_r (compat "8.3"). -Notation Zmult_1_l := Z.mul_1_l (compat "8.3"). -Notation Zmult_1_r := Z.mul_1_r (compat "8.3"). -Notation Zmult_comm := Z.mul_comm (compat "8.3"). -Notation Zmult_assoc := Z.mul_assoc (compat "8.3"). -Notation Zmult_permute := Z.mul_shuffle3 (compat "8.3"). -Notation Zmult_1_inversion_l := Z.mul_eq_1 (compat "8.3"). -Notation Zdouble_mult := Z.double_spec (compat "8.3"). -Notation Zdouble_plus_one_mult := Z.succ_double_spec (compat "8.3"). -Notation Zopp_mult_distr_l_reverse := Z.mul_opp_l (compat "8.3"). -Notation Zmult_opp_opp := Z.mul_opp_opp (compat "8.3"). -Notation Zmult_opp_comm := Z.mul_opp_comm (compat "8.3"). -Notation Zopp_eq_mult_neg_1 := Z.opp_eq_mul_m1 (compat "8.3"). -Notation Zmult_plus_distr_r := Z.mul_add_distr_l (compat "8.3"). -Notation Zmult_plus_distr_l := Z.mul_add_distr_r (compat "8.3"). -Notation Zmult_minus_distr_r := Z.mul_sub_distr_r (compat "8.3"). -Notation Zmult_reg_l := Z.mul_reg_l (compat "8.3"). -Notation Zmult_reg_r := Z.mul_reg_r (compat "8.3"). -Notation Zmult_succ_l := Z.mul_succ_l (compat "8.3"). -Notation Zmult_succ_r := Z.mul_succ_r (compat "8.3"). - -Notation Zpos_xI := Pos2Z.inj_xI (compat "8.3"). -Notation Zpos_xO := Pos2Z.inj_xO (compat "8.3"). -Notation Zneg_xI := Pos2Z.neg_xI (compat "8.3"). -Notation Zneg_xO := Pos2Z.neg_xO (compat "8.3"). -Notation Zopp_neg := Pos2Z.opp_neg (compat "8.3"). -Notation Zpos_succ_morphism := Pos2Z.inj_succ (compat "8.3"). -Notation Zpos_mult_morphism := Pos2Z.inj_mul (compat "8.3"). -Notation Zpos_minus_morphism := Pos2Z.inj_sub (compat "8.3"). -Notation Zpos_eq_rev := Pos2Z.inj (compat "8.3"). -Notation Zpos_plus_distr := Pos2Z.inj_add (compat "8.3"). -Notation Zneg_plus_distr := Pos2Z.add_neg_neg (compat "8.3"). +Notation Zdouble_plus_one := Z.succ_double (only parsing). +Notation Zdouble_minus_one := Z.pred_double (only parsing). +Notation Zdouble := Z.double (compat "8.6"). +Notation ZPminus := Z.pos_sub (only parsing). +Notation Zsucc' := Z.succ (compat "8.6"). +Notation Zpred' := Z.pred (compat "8.6"). +Notation Zplus' := Z.add (compat "8.6"). +Notation Zplus := Z.add (only parsing). (* Slightly incompatible *) +Notation Zopp := Z.opp (compat "8.6"). +Notation Zsucc := Z.succ (compat "8.6"). +Notation Zpred := Z.pred (compat "8.6"). +Notation Zminus := Z.sub (only parsing). +Notation Zmult := Z.mul (only parsing). +Notation Zcompare := Z.compare (compat "8.6"). +Notation Zsgn := Z.sgn (compat "8.6"). +Notation Zle := Z.le (compat "8.6"). +Notation Zge := Z.ge (compat "8.6"). +Notation Zlt := Z.lt (compat "8.6"). +Notation Zgt := Z.gt (compat "8.6"). +Notation Zmax := Z.max (compat "8.6"). +Notation Zmin := Z.min (compat "8.6"). +Notation Zabs := Z.abs (compat "8.6"). +Notation Zabs_nat := Z.abs_nat (compat "8.6"). +Notation Zabs_N := Z.abs_N (compat "8.6"). +Notation Z_of_nat := Z.of_nat (only parsing). +Notation Z_of_N := Z.of_N (only parsing). + +Notation Zind := Z.peano_ind (only parsing). +Notation Zopp_0 := Z.opp_0 (compat "8.6"). +Notation Zopp_involutive := Z.opp_involutive (compat "8.6"). +Notation Zopp_inj := Z.opp_inj (compat "8.6"). +Notation Zplus_0_l := Z.add_0_l (only parsing). +Notation Zplus_0_r := Z.add_0_r (only parsing). +Notation Zplus_comm := Z.add_comm (only parsing). +Notation Zopp_plus_distr := Z.opp_add_distr (only parsing). +Notation Zopp_succ := Z.opp_succ (compat "8.6"). +Notation Zplus_opp_r := Z.add_opp_diag_r (only parsing). +Notation Zplus_opp_l := Z.add_opp_diag_l (only parsing). +Notation Zplus_assoc := Z.add_assoc (only parsing). +Notation Zplus_permute := Z.add_shuffle3 (only parsing). +Notation Zplus_reg_l := Z.add_reg_l (only parsing). +Notation Zplus_succ_l := Z.add_succ_l (only parsing). +Notation Zplus_succ_comm := Z.add_succ_comm (only parsing). +Notation Zsucc_discr := Z.neq_succ_diag_r (only parsing). +Notation Zsucc_inj := Z.succ_inj (compat "8.6"). +Notation Zsucc'_inj := Z.succ_inj (compat "8.6"). +Notation Zsucc'_pred' := Z.succ_pred (compat "8.6"). +Notation Zpred'_succ' := Z.pred_succ (compat "8.6"). +Notation Zpred'_inj := Z.pred_inj (compat "8.6"). +Notation Zsucc'_discr := Z.neq_succ_diag_r (only parsing). +Notation Zminus_0_r := Z.sub_0_r (only parsing). +Notation Zminus_diag := Z.sub_diag (only parsing). +Notation Zminus_plus_distr := Z.sub_add_distr (only parsing). +Notation Zminus_succ_r := Z.sub_succ_r (only parsing). +Notation Zminus_plus := Z.add_simpl_l (only parsing). +Notation Zmult_0_l := Z.mul_0_l (only parsing). +Notation Zmult_0_r := Z.mul_0_r (only parsing). +Notation Zmult_1_l := Z.mul_1_l (only parsing). +Notation Zmult_1_r := Z.mul_1_r (only parsing). +Notation Zmult_comm := Z.mul_comm (only parsing). +Notation Zmult_assoc := Z.mul_assoc (only parsing). +Notation Zmult_permute := Z.mul_shuffle3 (only parsing). +Notation Zmult_1_inversion_l := Z.mul_eq_1 (only parsing). +Notation Zdouble_mult := Z.double_spec (only parsing). +Notation Zdouble_plus_one_mult := Z.succ_double_spec (only parsing). +Notation Zopp_mult_distr_l_reverse := Z.mul_opp_l (only parsing). +Notation Zmult_opp_opp := Z.mul_opp_opp (only parsing). +Notation Zmult_opp_comm := Z.mul_opp_comm (only parsing). +Notation Zopp_eq_mult_neg_1 := Z.opp_eq_mul_m1 (only parsing). +Notation Zmult_plus_distr_r := Z.mul_add_distr_l (only parsing). +Notation Zmult_plus_distr_l := Z.mul_add_distr_r (only parsing). +Notation Zmult_minus_distr_r := Z.mul_sub_distr_r (only parsing). +Notation Zmult_reg_l := Z.mul_reg_l (only parsing). +Notation Zmult_reg_r := Z.mul_reg_r (only parsing). +Notation Zmult_succ_l := Z.mul_succ_l (only parsing). +Notation Zmult_succ_r := Z.mul_succ_r (only parsing). + +Notation Zpos_xI := Pos2Z.inj_xI (only parsing). +Notation Zpos_xO := Pos2Z.inj_xO (only parsing). +Notation Zneg_xI := Pos2Z.neg_xI (only parsing). +Notation Zneg_xO := Pos2Z.neg_xO (only parsing). +Notation Zopp_neg := Pos2Z.opp_neg (only parsing). +Notation Zpos_succ_morphism := Pos2Z.inj_succ (only parsing). +Notation Zpos_mult_morphism := Pos2Z.inj_mul (only parsing). +Notation Zpos_minus_morphism := Pos2Z.inj_sub (only parsing). +Notation Zpos_eq_rev := Pos2Z.inj (only parsing). +Notation Zpos_plus_distr := Pos2Z.inj_add (only parsing). +Notation Zneg_plus_distr := Pos2Z.add_neg_neg (only parsing). Notation Z := Z (only parsing). Notation Z_rect := Z_rect (only parsing). diff --git a/theories/ZArith/Int.v b/theories/ZArith/Int.v index 72021f2e45..696016e5b5 100644 --- a/theories/ZArith/Int.v +++ b/theories/ZArith/Int.v @@ -452,7 +452,7 @@ Module Z_as_Int <: Int. Proof. reflexivity. Qed. (** Compatibility notations for Coq v8.4 *) - Notation plus := add (compat "8.4"). - Notation minus := sub (compat "8.4"). - Notation mult := mul (compat "8.4"). + Notation plus := add (only parsing). + Notation minus := sub (only parsing). + Notation mult := mul (only parsing). End Z_as_Int. diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v index 0ee233a35b..e1a943e562 100644 --- a/theories/ZArith/ZArith_dec.v +++ b/theories/ZArith/ZArith_dec.v @@ -32,7 +32,7 @@ Lemma Zcompare_rec (P:Set) (n m:Z) : ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P. Proof. apply Zcompare_rect. Defined. -Notation Z_eq_dec := Z.eq_dec (compat "8.3"). +Notation Z_eq_dec := Z.eq_dec (compat "8.6"). Section decidability. diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v index d4a46930a6..440a558233 100644 --- a/theories/ZArith/Zabs.v +++ b/theories/ZArith/Zabs.v @@ -27,17 +27,17 @@ Local Open Scope Z_scope. (**********************************************************************) (** * Properties of absolute value *) -Notation Zabs_eq := Z.abs_eq (compat "8.3"). -Notation Zabs_non_eq := Z.abs_neq (compat "8.3"). -Notation Zabs_Zopp := Z.abs_opp (compat "8.3"). -Notation Zabs_pos := Z.abs_nonneg (compat "8.3"). -Notation Zabs_involutive := Z.abs_involutive (compat "8.3"). -Notation Zabs_eq_case := Z.abs_eq_cases (compat "8.3"). -Notation Zabs_triangle := Z.abs_triangle (compat "8.3"). -Notation Zsgn_Zabs := Z.sgn_abs (compat "8.3"). -Notation Zabs_Zsgn := Z.abs_sgn (compat "8.3"). -Notation Zabs_Zmult := Z.abs_mul (compat "8.3"). -Notation Zabs_square := Z.abs_square (compat "8.3"). +Notation Zabs_eq := Z.abs_eq (compat "8.6"). +Notation Zabs_non_eq := Z.abs_neq (only parsing). +Notation Zabs_Zopp := Z.abs_opp (only parsing). +Notation Zabs_pos := Z.abs_nonneg (only parsing). +Notation Zabs_involutive := Z.abs_involutive (compat "8.6"). +Notation Zabs_eq_case := Z.abs_eq_cases (only parsing). +Notation Zabs_triangle := Z.abs_triangle (compat "8.6"). +Notation Zsgn_Zabs := Z.sgn_abs (only parsing). +Notation Zabs_Zsgn := Z.abs_sgn (only parsing). +Notation Zabs_Zmult := Z.abs_mul (only parsing). +Notation Zabs_square := Z.abs_square (compat "8.6"). (** * Proving a property of the absolute value by cases *) @@ -68,11 +68,11 @@ Qed. (** * Some results about the sign function. *) -Notation Zsgn_Zmult := Z.sgn_mul (compat "8.3"). -Notation Zsgn_Zopp := Z.sgn_opp (compat "8.3"). -Notation Zsgn_pos := Z.sgn_pos_iff (compat "8.3"). -Notation Zsgn_neg := Z.sgn_neg_iff (compat "8.3"). -Notation Zsgn_null := Z.sgn_null_iff (compat "8.3"). +Notation Zsgn_Zmult := Z.sgn_mul (only parsing). +Notation Zsgn_Zopp := Z.sgn_opp (only parsing). +Notation Zsgn_pos := Z.sgn_pos_iff (only parsing). +Notation Zsgn_neg := Z.sgn_neg_iff (only parsing). +Notation Zsgn_null := Z.sgn_null_iff (only parsing). (** A characterization of the sign function: *) @@ -86,13 +86,13 @@ Qed. (** Compatibility *) -Notation inj_Zabs_nat := Zabs2Nat.id_abs (compat "8.3"). -Notation Zabs_nat_Z_of_nat := Zabs2Nat.id (compat "8.3"). -Notation Zabs_nat_mult := Zabs2Nat.inj_mul (compat "8.3"). -Notation Zabs_nat_Zsucc := Zabs2Nat.inj_succ (compat "8.3"). -Notation Zabs_nat_Zplus := Zabs2Nat.inj_add (compat "8.3"). -Notation Zabs_nat_Zminus := (fun n m => Zabs2Nat.inj_sub m n) (compat "8.3"). -Notation Zabs_nat_compare := Zabs2Nat.inj_compare (compat "8.3"). +Notation inj_Zabs_nat := Zabs2Nat.id_abs (only parsing). +Notation Zabs_nat_Z_of_nat := Zabs2Nat.id (only parsing). +Notation Zabs_nat_mult := Zabs2Nat.inj_mul (only parsing). +Notation Zabs_nat_Zsucc := Zabs2Nat.inj_succ (only parsing). +Notation Zabs_nat_Zplus := Zabs2Nat.inj_add (only parsing). +Notation Zabs_nat_Zminus := (fun n m => Zabs2Nat.inj_sub m n) (only parsing). +Notation Zabs_nat_compare := Zabs2Nat.inj_compare (only parsing). Lemma Zabs_nat_le n m : 0 <= n <= m -> (Z.abs_nat n <= Z.abs_nat m)%nat. Proof. diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v index 407aef3b6d..eeb6c18a7b 100644 --- a/theories/ZArith/Zbool.v +++ b/theories/ZArith/Zbool.v @@ -33,10 +33,10 @@ Definition Zeven_odd_bool (x:Z) := bool_of_sumbool (Zeven_odd_dec x). (**********************************************************************) (** * Boolean comparisons of binary integers *) -Notation Zle_bool := Z.leb (compat "8.3"). -Notation Zge_bool := Z.geb (compat "8.3"). -Notation Zlt_bool := Z.ltb (compat "8.3"). -Notation Zgt_bool := Z.gtb (compat "8.3"). +Notation Zle_bool := Z.leb (only parsing). +Notation Zge_bool := Z.geb (only parsing). +Notation Zlt_bool := Z.ltb (only parsing). +Notation Zgt_bool := Z.gtb (only parsing). (** We now provide a direct [Z.eqb] that doesn't refer to [Z.compare]. The old [Zeq_bool] is kept for compatibility. *) @@ -87,7 +87,7 @@ Proof. apply Z.leb_le. Qed. -Notation Zle_bool_refl := Z.leb_refl (compat "8.3"). +Notation Zle_bool_refl := Z.leb_refl (only parsing). Lemma Zle_bool_antisym n m : (n <=? m) = true -> (m <=? n) = true -> n = m. diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v index f823c41a2c..69e3e9a6ae 100644 --- a/theories/ZArith/Zcompare.v +++ b/theories/ZArith/Zcompare.v @@ -181,18 +181,18 @@ Qed. (** Compatibility notations *) -Notation Zcompare_refl := Z.compare_refl (compat "8.3"). -Notation Zcompare_Eq_eq := Z.compare_eq (compat "8.3"). -Notation Zcompare_Eq_iff_eq := Z.compare_eq_iff (compat "8.3"). -Notation Zcompare_spec := Z.compare_spec (compat "8.3"). -Notation Zmin_l := Z.min_l (compat "8.3"). -Notation Zmin_r := Z.min_r (compat "8.3"). -Notation Zmax_l := Z.max_l (compat "8.3"). -Notation Zmax_r := Z.max_r (compat "8.3"). -Notation Zabs_eq := Z.abs_eq (compat "8.3"). -Notation Zabs_non_eq := Z.abs_neq (compat "8.3"). -Notation Zsgn_0 := Z.sgn_null (compat "8.3"). -Notation Zsgn_1 := Z.sgn_pos (compat "8.3"). -Notation Zsgn_m1 := Z.sgn_neg (compat "8.3"). +Notation Zcompare_refl := Z.compare_refl (compat "8.6"). +Notation Zcompare_Eq_eq := Z.compare_eq (only parsing). +Notation Zcompare_Eq_iff_eq := Z.compare_eq_iff (only parsing). +Notation Zcompare_spec := Z.compare_spec (compat "8.6"). +Notation Zmin_l := Z.min_l (compat "8.6"). +Notation Zmin_r := Z.min_r (compat "8.6"). +Notation Zmax_l := Z.max_l (compat "8.6"). +Notation Zmax_r := Z.max_r (compat "8.6"). +Notation Zabs_eq := Z.abs_eq (compat "8.6"). +Notation Zabs_non_eq := Z.abs_neq (only parsing). +Notation Zsgn_0 := Z.sgn_null (only parsing). +Notation Zsgn_1 := Z.sgn_pos (only parsing). +Notation Zsgn_m1 := Z.sgn_neg (only parsing). (** Not kept: Zcompare_egal_dec *) diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v index fa1ddf56f2..8c4c9d3015 100644 --- a/theories/ZArith/Zdiv.v +++ b/theories/ZArith/Zdiv.v @@ -18,16 +18,16 @@ Local Open Scope Z_scope. (** The definition of the division is now in [BinIntDef], the initial specifications and properties are in [BinInt]. *) -Notation Zdiv_eucl_POS := Z.pos_div_eucl (compat "8.3"). -Notation Zdiv_eucl := Z.div_eucl (compat "8.3"). -Notation Zdiv := Z.div (compat "8.3"). -Notation Zmod := Z.modulo (compat "8.3"). - -Notation Zdiv_eucl_eq := Z.div_eucl_eq (compat "8.3"). -Notation Z_div_mod_eq_full := Z.div_mod (compat "8.3"). -Notation Zmod_POS_bound := Z.pos_div_eucl_bound (compat "8.3"). -Notation Zmod_pos_bound := Z.mod_pos_bound (compat "8.3"). -Notation Zmod_neg_bound := Z.mod_neg_bound (compat "8.3"). +Notation Zdiv_eucl_POS := Z.pos_div_eucl (only parsing). +Notation Zdiv_eucl := Z.div_eucl (compat "8.6"). +Notation Zdiv := Z.div (compat "8.6"). +Notation Zmod := Z.modulo (only parsing). + +Notation Zdiv_eucl_eq := Z.div_eucl_eq (compat "8.6"). +Notation Z_div_mod_eq_full := Z.div_mod (only parsing). +Notation Zmod_POS_bound := Z.pos_div_eucl_bound (only parsing). +Notation Zmod_pos_bound := Z.mod_pos_bound (only parsing). +Notation Zmod_neg_bound := Z.mod_neg_bound (only parsing). (** * Main division theorems *) diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v index 42a6a8ee37..44b4a0083b 100644 --- a/theories/ZArith/Zeven.v +++ b/theories/ZArith/Zeven.v @@ -58,8 +58,8 @@ Proof (Zodd_equiv n). (** Boolean tests of parity (now in BinInt.Z) *) -Notation Zeven_bool := Z.even (compat "8.3"). -Notation Zodd_bool := Z.odd (compat "8.3"). +Notation Zeven_bool := Z.even (only parsing). +Notation Zodd_bool := Z.odd (only parsing). Lemma Zeven_bool_iff n : Z.even n = true <-> Zeven n. Proof. @@ -130,17 +130,17 @@ Qed. Hint Unfold Zeven Zodd: zarith. -Notation Zeven_bool_succ := Z.even_succ (compat "8.3"). -Notation Zeven_bool_pred := Z.even_pred (compat "8.3"). -Notation Zodd_bool_succ := Z.odd_succ (compat "8.3"). -Notation Zodd_bool_pred := Z.odd_pred (compat "8.3"). +Notation Zeven_bool_succ := Z.even_succ (only parsing). +Notation Zeven_bool_pred := Z.even_pred (only parsing). +Notation Zodd_bool_succ := Z.odd_succ (only parsing). +Notation Zodd_bool_pred := Z.odd_pred (only parsing). (******************************************************************) (** * Definition of [Z.quot2], [Z.div2] and properties wrt [Zeven] and [Zodd] *) -Notation Zdiv2 := Z.div2 (compat "8.3"). -Notation Zquot2 := Z.quot2 (compat "8.3"). +Notation Zdiv2 := Z.div2 (compat "8.6"). +Notation Zquot2 := Z.quot2 (compat "8.6"). (** Properties of [Z.div2] *) diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v index b52da85638..36d8451f87 100644 --- a/theories/ZArith/Zmax.v +++ b/theories/ZArith/Zmax.v @@ -16,32 +16,32 @@ Local Open Scope Z_scope. (** Exact compatibility *) -Notation Zmax_case := Z.max_case (compat "8.3"). -Notation Zmax_case_strong := Z.max_case_strong (compat "8.3"). -Notation Zmax_right := Z.max_r (compat "8.3"). -Notation Zle_max_l := Z.le_max_l (compat "8.3"). -Notation Zle_max_r := Z.le_max_r (compat "8.3"). -Notation Zmax_lub := Z.max_lub (compat "8.3"). -Notation Zmax_lub_lt := Z.max_lub_lt (compat "8.3"). -Notation Zle_max_compat_r := Z.max_le_compat_r (compat "8.3"). -Notation Zle_max_compat_l := Z.max_le_compat_l (compat "8.3"). -Notation Zmax_idempotent := Z.max_id (compat "8.3"). -Notation Zmax_n_n := Z.max_id (compat "8.3"). -Notation Zmax_comm := Z.max_comm (compat "8.3"). -Notation Zmax_assoc := Z.max_assoc (compat "8.3"). -Notation Zmax_irreducible_dec := Z.max_dec (compat "8.3"). -Notation Zmax_le_prime := Z.max_le (compat "8.3"). -Notation Zsucc_max_distr := Z.succ_max_distr (compat "8.3"). -Notation Zmax_SS := Z.succ_max_distr (compat "8.3"). -Notation Zplus_max_distr_l := Z.add_max_distr_l (compat "8.3"). -Notation Zplus_max_distr_r := Z.add_max_distr_r (compat "8.3"). -Notation Zmax_plus := Z.add_max_distr_r (compat "8.3"). -Notation Zmax1 := Z.le_max_l (compat "8.3"). -Notation Zmax2 := Z.le_max_r (compat "8.3"). -Notation Zmax_irreducible_inf := Z.max_dec (compat "8.3"). -Notation Zmax_le_prime_inf := Z.max_le (compat "8.3"). -Notation Zpos_max := Pos2Z.inj_max (compat "8.3"). -Notation Zpos_minus := Pos2Z.inj_sub_max (compat "8.3"). +Notation Zmax_case := Z.max_case (compat "8.6"). +Notation Zmax_case_strong := Z.max_case_strong (compat "8.6"). +Notation Zmax_right := Z.max_r (only parsing). +Notation Zle_max_l := Z.le_max_l (compat "8.6"). +Notation Zle_max_r := Z.le_max_r (compat "8.6"). +Notation Zmax_lub := Z.max_lub (compat "8.6"). +Notation Zmax_lub_lt := Z.max_lub_lt (compat "8.6"). +Notation Zle_max_compat_r := Z.max_le_compat_r (only parsing). +Notation Zle_max_compat_l := Z.max_le_compat_l (only parsing). +Notation Zmax_idempotent := Z.max_id (only parsing). +Notation Zmax_n_n := Z.max_id (only parsing). +Notation Zmax_comm := Z.max_comm (compat "8.6"). +Notation Zmax_assoc := Z.max_assoc (compat "8.6"). +Notation Zmax_irreducible_dec := Z.max_dec (only parsing). +Notation Zmax_le_prime := Z.max_le (only parsing). +Notation Zsucc_max_distr := Z.succ_max_distr (compat "8.6"). +Notation Zmax_SS := Z.succ_max_distr (only parsing). +Notation Zplus_max_distr_l := Z.add_max_distr_l (only parsing). +Notation Zplus_max_distr_r := Z.add_max_distr_r (only parsing). +Notation Zmax_plus := Z.add_max_distr_r (only parsing). +Notation Zmax1 := Z.le_max_l (only parsing). +Notation Zmax2 := Z.le_max_r (only parsing). +Notation Zmax_irreducible_inf := Z.max_dec (only parsing). +Notation Zmax_le_prime_inf := Z.max_le (only parsing). +Notation Zpos_max := Pos2Z.inj_max (only parsing). +Notation Zpos_minus := Pos2Z.inj_sub_max (only parsing). (** Slightly different lemmas *) diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v index d9e3ab19ef..dd9203f33e 100644 --- a/theories/ZArith/Zmin.v +++ b/theories/ZArith/Zmin.v @@ -16,24 +16,24 @@ Local Open Scope Z_scope. (** Exact compatibility *) -Notation Zmin_case := Z.min_case (compat "8.3"). -Notation Zmin_case_strong := Z.min_case_strong (compat "8.3"). -Notation Zle_min_l := Z.le_min_l (compat "8.3"). -Notation Zle_min_r := Z.le_min_r (compat "8.3"). -Notation Zmin_glb := Z.min_glb (compat "8.3"). -Notation Zmin_glb_lt := Z.min_glb_lt (compat "8.3"). -Notation Zle_min_compat_r := Z.min_le_compat_r (compat "8.3"). -Notation Zle_min_compat_l := Z.min_le_compat_l (compat "8.3"). -Notation Zmin_idempotent := Z.min_id (compat "8.3"). -Notation Zmin_n_n := Z.min_id (compat "8.3"). -Notation Zmin_comm := Z.min_comm (compat "8.3"). -Notation Zmin_assoc := Z.min_assoc (compat "8.3"). -Notation Zmin_irreducible_inf := Z.min_dec (compat "8.3"). -Notation Zsucc_min_distr := Z.succ_min_distr (compat "8.3"). -Notation Zmin_SS := Z.succ_min_distr (compat "8.3"). -Notation Zplus_min_distr_r := Z.add_min_distr_r (compat "8.3"). -Notation Zmin_plus := Z.add_min_distr_r (compat "8.3"). -Notation Zpos_min := Pos2Z.inj_min (compat "8.3"). +Notation Zmin_case := Z.min_case (compat "8.6"). +Notation Zmin_case_strong := Z.min_case_strong (compat "8.6"). +Notation Zle_min_l := Z.le_min_l (compat "8.6"). +Notation Zle_min_r := Z.le_min_r (compat "8.6"). +Notation Zmin_glb := Z.min_glb (compat "8.6"). +Notation Zmin_glb_lt := Z.min_glb_lt (compat "8.6"). +Notation Zle_min_compat_r := Z.min_le_compat_r (only parsing). +Notation Zle_min_compat_l := Z.min_le_compat_l (only parsing). +Notation Zmin_idempotent := Z.min_id (only parsing). +Notation Zmin_n_n := Z.min_id (only parsing). +Notation Zmin_comm := Z.min_comm (compat "8.6"). +Notation Zmin_assoc := Z.min_assoc (compat "8.6"). +Notation Zmin_irreducible_inf := Z.min_dec (only parsing). +Notation Zsucc_min_distr := Z.succ_min_distr (compat "8.6"). +Notation Zmin_SS := Z.succ_min_distr (only parsing). +Notation Zplus_min_distr_r := Z.add_min_distr_r (only parsing). +Notation Zmin_plus := Z.add_min_distr_r (only parsing). +Notation Zpos_min := Pos2Z.inj_min (only parsing). (** Slightly different lemmas *) @@ -46,7 +46,7 @@ Qed. Lemma Zmin_irreducible n m : Z.min n m = n \/ Z.min n m = m. Proof. destruct (Z.min_dec n m); auto. Qed. -Notation Zmin_or := Zmin_irreducible (compat "8.3"). +Notation Zmin_or := Zmin_irreducible (only parsing). Lemma Zmin_le_prime_inf n m p : Z.min n m <= p -> {n <= p} + {m <= p}. Proof. apply Z.min_case; auto. Qed. diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v index 7e62d6689b..4a149f2f2b 100644 --- a/theories/ZArith/Zminmax.v +++ b/theories/ZArith/Zminmax.v @@ -12,11 +12,11 @@ Require Import Orders BinInt Zcompare Zorder. (*begin hide*) (* Compatibility with names of the old Zminmax file *) -Notation Zmin_max_absorption_r_r := Z.min_max_absorption (compat "8.3"). -Notation Zmax_min_absorption_r_r := Z.max_min_absorption (compat "8.3"). -Notation Zmax_min_distr_r := Z.max_min_distr (compat "8.3"). -Notation Zmin_max_distr_r := Z.min_max_distr (compat "8.3"). -Notation Zmax_min_modular_r := Z.max_min_modular (compat "8.3"). -Notation Zmin_max_modular_r := Z.min_max_modular (compat "8.3"). -Notation max_min_disassoc := Z.max_min_disassoc (compat "8.3"). +Notation Zmin_max_absorption_r_r := Z.min_max_absorption (only parsing). +Notation Zmax_min_absorption_r_r := Z.max_min_absorption (only parsing). +Notation Zmax_min_distr_r := Z.max_min_distr (only parsing). +Notation Zmin_max_distr_r := Z.min_max_distr (only parsing). +Notation Zmax_min_modular_r := Z.max_min_modular (only parsing). +Notation Zmin_max_modular_r := Z.min_max_modular (only parsing). +Notation max_min_disassoc := Z.max_min_disassoc (only parsing). (*end hide*) diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v index a6f29936b3..651cda00b9 100644 --- a/theories/ZArith/Zmisc.v +++ b/theories/ZArith/Zmisc.v @@ -18,7 +18,7 @@ Local Open Scope Z_scope. (** [n]th iteration of the function [f] *) -Notation iter := @Z.iter (compat "8.3"). +Notation iter := @Z.iter (only parsing). Lemma iter_nat_of_Z : forall n A f x, 0 <= n -> Z.iter n f x = iter_nat (Z.abs_nat n) A f x. diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v index be712db6b0..402dfe33a6 100644 --- a/theories/ZArith/Znat.v +++ b/theories/ZArith/Znat.v @@ -951,65 +951,65 @@ Definition inj_gt n m := proj1 (Nat2Z.inj_gt n m). (** For the others, a Notation is fine *) -Notation inj_0 := Nat2Z.inj_0 (compat "8.3"). -Notation inj_S := Nat2Z.inj_succ (compat "8.3"). -Notation inj_compare := Nat2Z.inj_compare (compat "8.3"). -Notation inj_eq_rev := Nat2Z.inj (compat "8.3"). -Notation inj_eq_iff := (fun n m => iff_sym (Nat2Z.inj_iff n m)) (compat "8.3"). -Notation inj_le_iff := Nat2Z.inj_le (compat "8.3"). -Notation inj_lt_iff := Nat2Z.inj_lt (compat "8.3"). -Notation inj_ge_iff := Nat2Z.inj_ge (compat "8.3"). -Notation inj_gt_iff := Nat2Z.inj_gt (compat "8.3"). -Notation inj_le_rev := (fun n m => proj2 (Nat2Z.inj_le n m)) (compat "8.3"). -Notation inj_lt_rev := (fun n m => proj2 (Nat2Z.inj_lt n m)) (compat "8.3"). -Notation inj_ge_rev := (fun n m => proj2 (Nat2Z.inj_ge n m)) (compat "8.3"). -Notation inj_gt_rev := (fun n m => proj2 (Nat2Z.inj_gt n m)) (compat "8.3"). -Notation inj_plus := Nat2Z.inj_add (compat "8.3"). -Notation inj_mult := Nat2Z.inj_mul (compat "8.3"). -Notation inj_minus1 := Nat2Z.inj_sub (compat "8.3"). -Notation inj_minus := Nat2Z.inj_sub_max (compat "8.3"). -Notation inj_min := Nat2Z.inj_min (compat "8.3"). -Notation inj_max := Nat2Z.inj_max (compat "8.3"). - -Notation Z_of_nat_of_P := positive_nat_Z (compat "8.3"). +Notation inj_0 := Nat2Z.inj_0 (only parsing). +Notation inj_S := Nat2Z.inj_succ (only parsing). +Notation inj_compare := Nat2Z.inj_compare (only parsing). +Notation inj_eq_rev := Nat2Z.inj (only parsing). +Notation inj_eq_iff := (fun n m => iff_sym (Nat2Z.inj_iff n m)) (only parsing). +Notation inj_le_iff := Nat2Z.inj_le (only parsing). +Notation inj_lt_iff := Nat2Z.inj_lt (only parsing). +Notation inj_ge_iff := Nat2Z.inj_ge (only parsing). +Notation inj_gt_iff := Nat2Z.inj_gt (only parsing). +Notation inj_le_rev := (fun n m => proj2 (Nat2Z.inj_le n m)) (only parsing). +Notation inj_lt_rev := (fun n m => proj2 (Nat2Z.inj_lt n m)) (only parsing). +Notation inj_ge_rev := (fun n m => proj2 (Nat2Z.inj_ge n m)) (only parsing). +Notation inj_gt_rev := (fun n m => proj2 (Nat2Z.inj_gt n m)) (only parsing). +Notation inj_plus := Nat2Z.inj_add (only parsing). +Notation inj_mult := Nat2Z.inj_mul (only parsing). +Notation inj_minus1 := Nat2Z.inj_sub (only parsing). +Notation inj_minus := Nat2Z.inj_sub_max (only parsing). +Notation inj_min := Nat2Z.inj_min (only parsing). +Notation inj_max := Nat2Z.inj_max (only parsing). + +Notation Z_of_nat_of_P := positive_nat_Z (only parsing). Notation Zpos_eq_Z_of_nat_o_nat_of_P := - (fun p => eq_sym (positive_nat_Z p)) (compat "8.3"). - -Notation Z_of_nat_of_N := N_nat_Z (compat "8.3"). -Notation Z_of_N_of_nat := nat_N_Z (compat "8.3"). - -Notation Z_of_N_eq := (f_equal Z.of_N) (compat "8.3"). -Notation Z_of_N_eq_rev := N2Z.inj (compat "8.3"). -Notation Z_of_N_eq_iff := (fun n m => iff_sym (N2Z.inj_iff n m)) (compat "8.3"). -Notation Z_of_N_compare := N2Z.inj_compare (compat "8.3"). -Notation Z_of_N_le_iff := N2Z.inj_le (compat "8.3"). -Notation Z_of_N_lt_iff := N2Z.inj_lt (compat "8.3"). -Notation Z_of_N_ge_iff := N2Z.inj_ge (compat "8.3"). -Notation Z_of_N_gt_iff := N2Z.inj_gt (compat "8.3"). -Notation Z_of_N_le := (fun n m => proj1 (N2Z.inj_le n m)) (compat "8.3"). -Notation Z_of_N_lt := (fun n m => proj1 (N2Z.inj_lt n m)) (compat "8.3"). -Notation Z_of_N_ge := (fun n m => proj1 (N2Z.inj_ge n m)) (compat "8.3"). -Notation Z_of_N_gt := (fun n m => proj1 (N2Z.inj_gt n m)) (compat "8.3"). -Notation Z_of_N_le_rev := (fun n m => proj2 (N2Z.inj_le n m)) (compat "8.3"). -Notation Z_of_N_lt_rev := (fun n m => proj2 (N2Z.inj_lt n m)) (compat "8.3"). -Notation Z_of_N_ge_rev := (fun n m => proj2 (N2Z.inj_ge n m)) (compat "8.3"). -Notation Z_of_N_gt_rev := (fun n m => proj2 (N2Z.inj_gt n m)) (compat "8.3"). -Notation Z_of_N_pos := N2Z.inj_pos (compat "8.3"). -Notation Z_of_N_abs := N2Z.inj_abs_N (compat "8.3"). -Notation Z_of_N_le_0 := N2Z.is_nonneg (compat "8.3"). -Notation Z_of_N_plus := N2Z.inj_add (compat "8.3"). -Notation Z_of_N_mult := N2Z.inj_mul (compat "8.3"). -Notation Z_of_N_minus := N2Z.inj_sub_max (compat "8.3"). -Notation Z_of_N_succ := N2Z.inj_succ (compat "8.3"). -Notation Z_of_N_min := N2Z.inj_min (compat "8.3"). -Notation Z_of_N_max := N2Z.inj_max (compat "8.3"). -Notation Zabs_of_N := Zabs2N.id (compat "8.3"). -Notation Zabs_N_succ_abs := Zabs2N.inj_succ_abs (compat "8.3"). -Notation Zabs_N_succ := Zabs2N.inj_succ (compat "8.3"). -Notation Zabs_N_plus_abs := Zabs2N.inj_add_abs (compat "8.3"). -Notation Zabs_N_plus := Zabs2N.inj_add (compat "8.3"). -Notation Zabs_N_mult_abs := Zabs2N.inj_mul_abs (compat "8.3"). -Notation Zabs_N_mult := Zabs2N.inj_mul (compat "8.3"). + (fun p => eq_sym (positive_nat_Z p)) (only parsing). + +Notation Z_of_nat_of_N := N_nat_Z (only parsing). +Notation Z_of_N_of_nat := nat_N_Z (only parsing). + +Notation Z_of_N_eq := (f_equal Z.of_N) (only parsing). +Notation Z_of_N_eq_rev := N2Z.inj (only parsing). +Notation Z_of_N_eq_iff := (fun n m => iff_sym (N2Z.inj_iff n m)) (only parsing). +Notation Z_of_N_compare := N2Z.inj_compare (only parsing). +Notation Z_of_N_le_iff := N2Z.inj_le (only parsing). +Notation Z_of_N_lt_iff := N2Z.inj_lt (only parsing). +Notation Z_of_N_ge_iff := N2Z.inj_ge (only parsing). +Notation Z_of_N_gt_iff := N2Z.inj_gt (only parsing). +Notation Z_of_N_le := (fun n m => proj1 (N2Z.inj_le n m)) (only parsing). +Notation Z_of_N_lt := (fun n m => proj1 (N2Z.inj_lt n m)) (only parsing). +Notation Z_of_N_ge := (fun n m => proj1 (N2Z.inj_ge n m)) (only parsing). +Notation Z_of_N_gt := (fun n m => proj1 (N2Z.inj_gt n m)) (only parsing). +Notation Z_of_N_le_rev := (fun n m => proj2 (N2Z.inj_le n m)) (only parsing). +Notation Z_of_N_lt_rev := (fun n m => proj2 (N2Z.inj_lt n m)) (only parsing). +Notation Z_of_N_ge_rev := (fun n m => proj2 (N2Z.inj_ge n m)) (only parsing). +Notation Z_of_N_gt_rev := (fun n m => proj2 (N2Z.inj_gt n m)) (only parsing). +Notation Z_of_N_pos := N2Z.inj_pos (only parsing). +Notation Z_of_N_abs := N2Z.inj_abs_N (only parsing). +Notation Z_of_N_le_0 := N2Z.is_nonneg (only parsing). +Notation Z_of_N_plus := N2Z.inj_add (only parsing). +Notation Z_of_N_mult := N2Z.inj_mul (only parsing). +Notation Z_of_N_minus := N2Z.inj_sub_max (only parsing). +Notation Z_of_N_succ := N2Z.inj_succ (only parsing). +Notation Z_of_N_min := N2Z.inj_min (only parsing). +Notation Z_of_N_max := N2Z.inj_max (only parsing). +Notation Zabs_of_N := Zabs2N.id (only parsing). +Notation Zabs_N_succ_abs := Zabs2N.inj_succ_abs (only parsing). +Notation Zabs_N_succ := Zabs2N.inj_succ (only parsing). +Notation Zabs_N_plus_abs := Zabs2N.inj_add_abs (only parsing). +Notation Zabs_N_plus := Zabs2N.inj_add (only parsing). +Notation Zabs_N_mult_abs := Zabs2N.inj_mul_abs (only parsing). +Notation Zabs_N_mult := Zabs2N.inj_mul (only parsing). Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z.of_nat (n - m) = 0. Proof. diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index 5dfc370955..521d6789ee 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -25,20 +25,20 @@ Open Scope Z_scope. - properties of the efficient [Z.gcd] function *) -Notation Zgcd := Z.gcd (compat "8.3"). -Notation Zggcd := Z.ggcd (compat "8.3"). -Notation Zggcd_gcd := Z.ggcd_gcd (compat "8.3"). -Notation Zggcd_correct_divisors := Z.ggcd_correct_divisors (compat "8.3"). -Notation Zgcd_divide_l := Z.gcd_divide_l (compat "8.3"). -Notation Zgcd_divide_r := Z.gcd_divide_r (compat "8.3"). -Notation Zgcd_greatest := Z.gcd_greatest (compat "8.3"). -Notation Zgcd_nonneg := Z.gcd_nonneg (compat "8.3"). -Notation Zggcd_opp := Z.ggcd_opp (compat "8.3"). +Notation Zgcd := Z.gcd (compat "8.6"). +Notation Zggcd := Z.ggcd (compat "8.6"). +Notation Zggcd_gcd := Z.ggcd_gcd (compat "8.6"). +Notation Zggcd_correct_divisors := Z.ggcd_correct_divisors (compat "8.6"). +Notation Zgcd_divide_l := Z.gcd_divide_l (compat "8.6"). +Notation Zgcd_divide_r := Z.gcd_divide_r (compat "8.6"). +Notation Zgcd_greatest := Z.gcd_greatest (compat "8.6"). +Notation Zgcd_nonneg := Z.gcd_nonneg (compat "8.6"). +Notation Zggcd_opp := Z.ggcd_opp (compat "8.6"). (** The former specialized inductive predicate [Z.divide] is now a generic existential predicate. *) -Notation Zdivide := Z.divide (compat "8.3"). +Notation Zdivide := Z.divide (compat "8.6"). (** Its former constructor is now a pseudo-constructor. *) @@ -46,17 +46,17 @@ Definition Zdivide_intro a b q (H:b=q*a) : Z.divide a b := ex_intro _ q H. (** Results concerning divisibility*) -Notation Zdivide_refl := Z.divide_refl (compat "8.3"). -Notation Zone_divide := Z.divide_1_l (compat "8.3"). -Notation Zdivide_0 := Z.divide_0_r (compat "8.3"). -Notation Zmult_divide_compat_l := Z.mul_divide_mono_l (compat "8.3"). -Notation Zmult_divide_compat_r := Z.mul_divide_mono_r (compat "8.3"). -Notation Zdivide_plus_r := Z.divide_add_r (compat "8.3"). -Notation Zdivide_minus_l := Z.divide_sub_r (compat "8.3"). -Notation Zdivide_mult_l := Z.divide_mul_l (compat "8.3"). -Notation Zdivide_mult_r := Z.divide_mul_r (compat "8.3"). -Notation Zdivide_factor_r := Z.divide_factor_l (compat "8.3"). -Notation Zdivide_factor_l := Z.divide_factor_r (compat "8.3"). +Notation Zdivide_refl := Z.divide_refl (compat "8.6"). +Notation Zone_divide := Z.divide_1_l (only parsing). +Notation Zdivide_0 := Z.divide_0_r (only parsing). +Notation Zmult_divide_compat_l := Z.mul_divide_mono_l (only parsing). +Notation Zmult_divide_compat_r := Z.mul_divide_mono_r (only parsing). +Notation Zdivide_plus_r := Z.divide_add_r (only parsing). +Notation Zdivide_minus_l := Z.divide_sub_r (only parsing). +Notation Zdivide_mult_l := Z.divide_mul_l (only parsing). +Notation Zdivide_mult_r := Z.divide_mul_r (only parsing). +Notation Zdivide_factor_r := Z.divide_factor_l (only parsing). +Notation Zdivide_factor_l := Z.divide_factor_r (only parsing). Lemma Zdivide_opp_r a b : (a | b) -> (a | - b). Proof. apply Z.divide_opp_r. Qed. @@ -91,12 +91,12 @@ Qed. (** Only [1] and [-1] divide [1]. *) -Notation Zdivide_1 := Z.divide_1_r (compat "8.3"). +Notation Zdivide_1 := Z.divide_1_r (only parsing). (** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *) -Notation Zdivide_antisym := Z.divide_antisym (compat "8.3"). -Notation Zdivide_trans := Z.divide_trans (compat "8.3"). +Notation Zdivide_antisym := Z.divide_antisym (compat "8.6"). +Notation Zdivide_trans := Z.divide_trans (compat "8.6"). (** If [a] divides [b] and [b<>0] then [|a| <= |b|]. *) @@ -734,7 +734,7 @@ Qed. (** we now prove that [Z.gcd] is indeed a gcd in the sense of [Zis_gcd]. *) -Notation Zgcd_is_pos := Z.gcd_nonneg (compat "8.3"). +Notation Zgcd_is_pos := Z.gcd_nonneg (only parsing). Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Z.gcd a b). Proof. @@ -767,8 +767,8 @@ Proof. - subst. now case (Z.gcd a b). Qed. -Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (compat "8.3"). -Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (compat "8.3"). +Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (only parsing). +Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (only parsing). Theorem Zgcd_div_swap0 : forall a b : Z, 0 < Z.gcd a b -> @@ -798,16 +798,16 @@ Proof. rewrite <- Zdivide_Zdiv_eq; auto. Qed. -Notation Zgcd_comm := Z.gcd_comm (compat "8.3"). +Notation Zgcd_comm := Z.gcd_comm (compat "8.6"). Lemma Zgcd_ass a b c : Z.gcd (Z.gcd a b) c = Z.gcd a (Z.gcd b c). Proof. symmetry. apply Z.gcd_assoc. Qed. -Notation Zgcd_Zabs := Z.gcd_abs_l (compat "8.3"). -Notation Zgcd_0 := Z.gcd_0_r (compat "8.3"). -Notation Zgcd_1 := Z.gcd_1_r (compat "8.3"). +Notation Zgcd_Zabs := Z.gcd_abs_l (only parsing). +Notation Zgcd_0 := Z.gcd_0_r (only parsing). +Notation Zgcd_1 := Z.gcd_1_r (only parsing). Hint Resolve Z.gcd_0_r Z.gcd_1_r : zarith. diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v index ff8e22029c..d188681fe4 100644 --- a/theories/ZArith/Zorder.v +++ b/theories/ZArith/Zorder.v @@ -38,9 +38,9 @@ Qed. (**********************************************************************) (** * Decidability of equality and order on Z *) -Notation dec_eq := Z.eq_decidable (compat "8.3"). -Notation dec_Zle := Z.le_decidable (compat "8.3"). -Notation dec_Zlt := Z.lt_decidable (compat "8.3"). +Notation dec_eq := Z.eq_decidable (only parsing). +Notation dec_Zle := Z.le_decidable (only parsing). +Notation dec_Zlt := Z.lt_decidable (only parsing). Theorem dec_Zne n m : decidable (Zne n m). Proof. @@ -64,12 +64,12 @@ Qed. (** * Relating strict and large orders *) -Notation Zgt_lt := Z.gt_lt (compat "8.3"). -Notation Zlt_gt := Z.lt_gt (compat "8.3"). -Notation Zge_le := Z.ge_le (compat "8.3"). -Notation Zle_ge := Z.le_ge (compat "8.3"). -Notation Zgt_iff_lt := Z.gt_lt_iff (compat "8.3"). -Notation Zge_iff_le := Z.ge_le_iff (compat "8.3"). +Notation Zgt_lt := Z.gt_lt (compat "8.6"). +Notation Zlt_gt := Z.lt_gt (compat "8.6"). +Notation Zge_le := Z.ge_le (compat "8.6"). +Notation Zle_ge := Z.le_ge (compat "8.6"). +Notation Zgt_iff_lt := Z.gt_lt_iff (only parsing). +Notation Zge_iff_le := Z.ge_le_iff (only parsing). Lemma Zle_not_lt n m : n <= m -> ~ m < n. Proof. @@ -121,18 +121,18 @@ Qed. (** Reflexivity *) -Notation Zle_refl := Z.le_refl (compat "8.3"). -Notation Zeq_le := Z.eq_le_incl (compat "8.3"). +Notation Zle_refl := Z.le_refl (compat "8.6"). +Notation Zeq_le := Z.eq_le_incl (only parsing). Hint Resolve Z.le_refl: zarith. (** Antisymmetry *) -Notation Zle_antisym := Z.le_antisymm (compat "8.3"). +Notation Zle_antisym := Z.le_antisymm (only parsing). (** Asymmetry *) -Notation Zlt_asym := Z.lt_asymm (compat "8.3"). +Notation Zlt_asym := Z.lt_asymm (only parsing). Lemma Zgt_asym n m : n > m -> ~ m > n. Proof. @@ -141,8 +141,8 @@ Qed. (** Irreflexivity *) -Notation Zlt_irrefl := Z.lt_irrefl (compat "8.3"). -Notation Zlt_not_eq := Z.lt_neq (compat "8.3"). +Notation Zlt_irrefl := Z.lt_irrefl (compat "8.6"). +Notation Zlt_not_eq := Z.lt_neq (only parsing). Lemma Zgt_irrefl n : ~ n > n. Proof. @@ -151,8 +151,8 @@ Qed. (** Large = strict or equal *) -Notation Zlt_le_weak := Z.lt_le_incl (compat "8.3"). -Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (compat "8.3"). +Notation Zlt_le_weak := Z.lt_le_incl (only parsing). +Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (only parsing). Lemma Zle_lt_or_eq n m : n <= m -> n < m \/ n = m. Proof. @@ -161,11 +161,11 @@ Qed. (** Dichotomy *) -Notation Zle_or_lt := Z.le_gt_cases (compat "8.3"). +Notation Zle_or_lt := Z.le_gt_cases (only parsing). (** Transitivity of strict orders *) -Notation Zlt_trans := Z.lt_trans (compat "8.3"). +Notation Zlt_trans := Z.lt_trans (compat "8.6"). Lemma Zgt_trans n m p : n > m -> m > p -> n > p. Proof. @@ -174,8 +174,8 @@ Qed. (** Mixed transitivity *) -Notation Zlt_le_trans := Z.lt_le_trans (compat "8.3"). -Notation Zle_lt_trans := Z.le_lt_trans (compat "8.3"). +Notation Zlt_le_trans := Z.lt_le_trans (compat "8.6"). +Notation Zle_lt_trans := Z.le_lt_trans (compat "8.6"). Lemma Zle_gt_trans n m p : m <= n -> m > p -> n > p. Proof. @@ -189,7 +189,7 @@ Qed. (** Transitivity of large orders *) -Notation Zle_trans := Z.le_trans (compat "8.3"). +Notation Zle_trans := Z.le_trans (compat "8.6"). Lemma Zge_trans n m p : n >= m -> m >= p -> n >= p. Proof. @@ -240,8 +240,8 @@ Qed. (** Special base instances of order *) -Notation Zlt_succ := Z.lt_succ_diag_r (compat "8.3"). -Notation Zlt_pred := Z.lt_pred_l (compat "8.3"). +Notation Zlt_succ := Z.lt_succ_diag_r (only parsing). +Notation Zlt_pred := Z.lt_pred_l (only parsing). Lemma Zgt_succ n : Z.succ n > n. Proof. @@ -255,8 +255,8 @@ Qed. (** Relating strict and large order using successor or predecessor *) -Notation Zlt_succ_r := Z.lt_succ_r (compat "8.3"). -Notation Zle_succ_l := Z.le_succ_l (compat "8.3"). +Notation Zlt_succ_r := Z.lt_succ_r (compat "8.6"). +Notation Zle_succ_l := Z.le_succ_l (compat "8.6"). Lemma Zgt_le_succ n m : m > n -> Z.succ n <= m. Proof. @@ -295,10 +295,10 @@ Qed. (** Weakening order *) -Notation Zle_succ := Z.le_succ_diag_r (compat "8.3"). -Notation Zle_pred := Z.le_pred_l (compat "8.3"). -Notation Zlt_lt_succ := Z.lt_lt_succ_r (compat "8.3"). -Notation Zle_le_succ := Z.le_le_succ_r (compat "8.3"). +Notation Zle_succ := Z.le_succ_diag_r (only parsing). +Notation Zle_pred := Z.le_pred_l (only parsing). +Notation Zlt_lt_succ := Z.lt_lt_succ_r (only parsing). +Notation Zle_le_succ := Z.le_le_succ_r (only parsing). Lemma Zle_succ_le n m : Z.succ n <= m -> n <= m. Proof. @@ -334,8 +334,8 @@ Qed. (** Special cases of ordered integers *) -Notation Zlt_0_1 := Z.lt_0_1 (compat "8.3"). -Notation Zle_0_1 := Z.le_0_1 (compat "8.3"). +Notation Zlt_0_1 := Z.lt_0_1 (compat "8.6"). +Notation Zle_0_1 := Z.le_0_1 (compat "8.6"). Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q. Proof. @@ -375,10 +375,10 @@ Qed. (** ** Addition *) (** Compatibility of addition wrt to order *) -Notation Zplus_lt_le_compat := Z.add_lt_le_mono (compat "8.3"). -Notation Zplus_le_lt_compat := Z.add_le_lt_mono (compat "8.3"). -Notation Zplus_le_compat := Z.add_le_mono (compat "8.3"). -Notation Zplus_lt_compat := Z.add_lt_mono (compat "8.3"). +Notation Zplus_lt_le_compat := Z.add_lt_le_mono (only parsing). +Notation Zplus_le_lt_compat := Z.add_le_lt_mono (only parsing). +Notation Zplus_le_compat := Z.add_le_mono (only parsing). +Notation Zplus_lt_compat := Z.add_lt_mono (only parsing). Lemma Zplus_gt_compat_l n m p : n > m -> p + n > p + m. Proof. @@ -412,7 +412,7 @@ Qed. (** Compatibility of addition wrt to being positive *) -Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (compat "8.3"). +Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (only parsing). (** Simplification of addition wrt to order *) @@ -570,9 +570,9 @@ Qed. (** Compatibility of multiplication by a positive wrt to being positive *) -Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (compat "8.3"). -Notation Zmult_lt_0_compat := Z.mul_pos_pos (compat "8.3"). -Notation Zmult_lt_O_compat := Z.mul_pos_pos (compat "8.3"). +Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (only parsing). +Notation Zmult_lt_0_compat := Z.mul_pos_pos (only parsing). +Notation Zmult_lt_O_compat := Z.mul_pos_pos (only parsing). Lemma Zmult_gt_0_compat n m : n > 0 -> m > 0 -> n * m > 0. Proof. @@ -624,9 +624,9 @@ Qed. (** * Equivalence between inequalities *) -Notation Zle_plus_swap := Z.le_add_le_sub_r (compat "8.3"). -Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (compat "8.3"). -Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (compat "8.3"). +Notation Zle_plus_swap := Z.le_add_le_sub_r (only parsing). +Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (only parsing). +Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (only parsing). Lemma Zeq_plus_swap n m p : n + p = m <-> n = m - p. Proof. diff --git a/theories/ZArith/Zpow_def.v b/theories/ZArith/Zpow_def.v index a768868bdb..a3a3b97274 100644 --- a/theories/ZArith/Zpow_def.v +++ b/theories/ZArith/Zpow_def.v @@ -14,12 +14,12 @@ Local Open Scope Z_scope. (** Nota : this file is mostly deprecated. The definition of [Z.pow] and its usual properties are now provided by module [BinInt.Z]. *) -Notation Zpower_pos := Z.pow_pos (compat "8.3"). -Notation Zpower := Z.pow (compat "8.3"). -Notation Zpower_0_r := Z.pow_0_r (compat "8.3"). -Notation Zpower_succ_r := Z.pow_succ_r (compat "8.3"). -Notation Zpower_neg_r := Z.pow_neg_r (compat "8.3"). -Notation Zpower_Ppow := Pos2Z.inj_pow (compat "8.3"). +Notation Zpower_pos := Z.pow_pos (only parsing). +Notation Zpower := Z.pow (only parsing). +Notation Zpower_0_r := Z.pow_0_r (only parsing). +Notation Zpower_succ_r := Z.pow_succ_r (only parsing). +Notation Zpower_neg_r := Z.pow_neg_r (only parsing). +Notation Zpower_Ppow := Pos2Z.inj_pow (only parsing). Lemma Zpower_theory : power_theory 1 Z.mul (@eq Z) Z.of_N Z.pow. Proof. diff --git a/theories/ZArith/Zpow_facts.v b/theories/ZArith/Zpow_facts.v index 3ea3ae4ab0..e0d62b99c6 100644 --- a/theories/ZArith/Zpow_facts.v +++ b/theories/ZArith/Zpow_facts.v @@ -29,17 +29,17 @@ Proof. now apply (Z.pow_0_l (Zpos p)). Qed. Lemma Zpower_pos_pos x p : 0 < x -> 0 < Z.pow_pos x p. Proof. intros. now apply (Z.pow_pos_nonneg x (Zpos p)). Qed. -Notation Zpower_1_r := Z.pow_1_r (compat "8.3"). -Notation Zpower_1_l := Z.pow_1_l (compat "8.3"). -Notation Zpower_0_l := Z.pow_0_l' (compat "8.3"). -Notation Zpower_0_r := Z.pow_0_r (compat "8.3"). -Notation Zpower_2 := Z.pow_2_r (compat "8.3"). -Notation Zpower_gt_0 := Z.pow_pos_nonneg (compat "8.3"). -Notation Zpower_ge_0 := Z.pow_nonneg (compat "8.3"). -Notation Zpower_Zabs := Z.abs_pow (compat "8.3"). -Notation Zpower_Zsucc := Z.pow_succ_r (compat "8.3"). -Notation Zpower_mult := Z.pow_mul_r (compat "8.3"). -Notation Zpower_le_monotone2 := Z.pow_le_mono_r (compat "8.3"). +Notation Zpower_1_r := Z.pow_1_r (only parsing). +Notation Zpower_1_l := Z.pow_1_l (only parsing). +Notation Zpower_0_l := Z.pow_0_l' (only parsing). +Notation Zpower_0_r := Z.pow_0_r (only parsing). +Notation Zpower_2 := Z.pow_2_r (only parsing). +Notation Zpower_gt_0 := Z.pow_pos_nonneg (only parsing). +Notation Zpower_ge_0 := Z.pow_nonneg (only parsing). +Notation Zpower_Zabs := Z.abs_pow (only parsing). +Notation Zpower_Zsucc := Z.pow_succ_r (only parsing). +Notation Zpower_mult := Z.pow_mul_r (only parsing). +Notation Zpower_le_monotone2 := Z.pow_le_mono_r (only parsing). Theorem Zpower_le_monotone a b c : 0 < a -> 0 <= b <= c -> a^b <= a^c. @@ -231,7 +231,7 @@ Qed. (** * Z.square: a direct definition of [z^2] *) -Notation Psquare := Pos.square (compat "8.3"). -Notation Zsquare := Z.square (compat "8.3"). -Notation Psquare_correct := Pos.square_spec (compat "8.3"). -Notation Zsquare_correct := Z.square_spec (compat "8.3"). +Notation Psquare := Pos.square (compat "8.6"). +Notation Zsquare := Z.square (compat "8.6"). +Notation Psquare_correct := Pos.square_spec (only parsing). +Notation Zsquare_correct := Z.square_spec (only parsing). diff --git a/theories/ZArith/Zquot.v b/theories/ZArith/Zquot.v index efb56c4695..808a32ea24 100644 --- a/theories/ZArith/Zquot.v +++ b/theories/ZArith/Zquot.v @@ -31,21 +31,21 @@ Local Open Scope Z_scope. exploiting the arbitrary value of division by 0). *) -Notation Ndiv_Zquot := N2Z.inj_quot (compat "8.3"). -Notation Nmod_Zrem := N2Z.inj_rem (compat "8.3"). -Notation Z_quot_rem_eq := Z.quot_rem' (compat "8.3"). -Notation Zrem_lt := Z.rem_bound_abs (compat "8.3"). -Notation Zquot_unique := Z.quot_unique (compat "8.3"). -Notation Zrem_unique := Z.rem_unique (compat "8.3"). -Notation Zrem_1_r := Z.rem_1_r (compat "8.3"). -Notation Zquot_1_r := Z.quot_1_r (compat "8.3"). -Notation Zrem_1_l := Z.rem_1_l (compat "8.3"). -Notation Zquot_1_l := Z.quot_1_l (compat "8.3"). -Notation Z_quot_same := Z.quot_same (compat "8.3"). -Notation Z_quot_mult := Z.quot_mul (compat "8.3"). -Notation Zquot_small := Z.quot_small (compat "8.3"). -Notation Zrem_small := Z.rem_small (compat "8.3"). -Notation Zquot2_quot := Zquot2_quot (compat "8.3"). +Notation Ndiv_Zquot := N2Z.inj_quot (only parsing). +Notation Nmod_Zrem := N2Z.inj_rem (only parsing). +Notation Z_quot_rem_eq := Z.quot_rem' (only parsing). +Notation Zrem_lt := Z.rem_bound_abs (only parsing). +Notation Zquot_unique := Z.quot_unique (compat "8.6"). +Notation Zrem_unique := Z.rem_unique (compat "8.6"). +Notation Zrem_1_r := Z.rem_1_r (compat "8.6"). +Notation Zquot_1_r := Z.quot_1_r (compat "8.6"). +Notation Zrem_1_l := Z.rem_1_l (compat "8.6"). +Notation Zquot_1_l := Z.quot_1_l (compat "8.6"). +Notation Z_quot_same := Z.quot_same (compat "8.6"). +Notation Z_quot_mult := Z.quot_mul (only parsing). +Notation Zquot_small := Z.quot_small (compat "8.6"). +Notation Zrem_small := Z.rem_small (compat "8.6"). +Notation Zquot2_quot := Zquot2_quot (compat "8.6"). (** Particular values taken for [a÷0] and [(Z.rem a 0)]. We avise to not rely on these arbitrary values. *) diff --git a/toplevel/coqargs.ml b/toplevel/coqargs.ml index a7065c0315..673cfdb994 100644 --- a/toplevel/coqargs.ml +++ b/toplevel/coqargs.ml @@ -146,10 +146,9 @@ let add_vo_require opts d p export = let add_compat_require opts v = match v with - | Flags.V8_5 -> add_vo_require opts "Coq.Compat.Coq85" None (Some false) | Flags.V8_6 -> add_vo_require opts "Coq.Compat.Coq86" None (Some false) | Flags.V8_7 -> add_vo_require opts "Coq.Compat.Coq87" None (Some false) - | Flags.VOld | Flags.Current -> opts + | Flags.Current -> opts let set_batch_mode opts = Flags.quiet := true; diff --git a/toplevel/coqinit.ml b/toplevel/coqinit.ml index d8aaf3db86..6f461fd53c 100644 --- a/toplevel/coqinit.ml +++ b/toplevel/coqinit.ml @@ -26,7 +26,7 @@ let load_rcfile ~rcfile ~time ~state = match rcfile with | Some rcfile -> if CUnix.file_readable_p rcfile then - Vernac.load_vernac ~time ~verbosely:false ~interactive:false ~check:true ~state rcfile + Vernac.load_vernac ~time ~echo:false ~interactive:false ~check:true ~state rcfile else raise (Sys_error ("Cannot read rcfile: "^ rcfile)) | None -> try @@ -37,7 +37,7 @@ let load_rcfile ~rcfile ~time ~state = Envars.home ~warn / "."^rcdefaultname^"."^Coq_config.version; Envars.home ~warn / "."^rcdefaultname ] in - Vernac.load_vernac ~time ~verbosely:false ~interactive:false ~check:true ~state inferedrc + Vernac.load_vernac ~time ~echo:false ~interactive:false ~check:true ~state inferedrc with Not_found -> state (* Flags.if_verbose diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml index ae0b944760..7ad8e2c05e 100644 --- a/toplevel/coqloop.ml +++ b/toplevel/coqloop.ml @@ -339,6 +339,8 @@ let loop_flush_all () = Format.pp_print_flush !Topfmt.std_ft (); Format.pp_print_flush !Topfmt.err_ft () +let drop_last_doc = ref None + let rec loop ~time ~state = let open Vernac.State in Sys.catch_break true; @@ -353,7 +355,14 @@ let rec loop ~time ~state = not possible due exceptions. *) in vernac_loop ~state with - | CErrors.Drop -> state + | CErrors.Drop -> + (* Due to using exceptions as a form of control, state here goes + out of sync as [do_vernac] will never return. We must thus do + this hack until we make `Drop` a toplevel-only command. See + bug #6872. *) + let state = { state with sid = Stm.get_current_state ~doc:state.doc } in + drop_last_doc := Some state; + state | CErrors.Quit -> exit 0 | any -> top_stderr (str "Anomaly: main loop exited with exception: " ++ diff --git a/toplevel/coqloop.mli b/toplevel/coqloop.mli index 1c13090515..928f3609a1 100644 --- a/toplevel/coqloop.mli +++ b/toplevel/coqloop.mli @@ -35,3 +35,6 @@ val do_vernac : time:bool -> state:Vernac.State.t -> Vernac.State.t (** Main entry point of Coq: read and execute vernac commands. *) val loop : time:bool -> state:Vernac.State.t -> Vernac.State.t + +(** Last document seen after `Drop` *) +val drop_last_doc : Vernac.State.t option ref diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml index 26ede18347..5afc4e1823 100644 --- a/toplevel/coqtop.ml +++ b/toplevel/coqtop.ml @@ -34,7 +34,6 @@ let warning s = Flags.(with_option warn Feedback.msg_warning (strbrk s)) will not be generally be initialized, thus stateid, etc... may be bogus. For now we just print to the console too *) let coqtop_init_feed = Coqloop.coqloop_feed -let drop_last_doc = ref None (* Default toplevel loop *) let console_toploop_run opts ~state = @@ -44,9 +43,8 @@ let console_toploop_run opts ~state = Flags.if_verbose warning "Dumpglob cannot be used in interactive mode."; Dumpglob.noglob () end; - let state = Coqloop.loop ~time:opts.time ~state in + let _ = Coqloop.loop ~time:opts.time ~state in (* Initialise and launch the Ocaml toplevel *) - drop_last_doc := Some state; Coqinit.init_ocaml_path(); Mltop.ocaml_toploop(); (* We let the feeder in place for users of Drop *) @@ -92,10 +90,10 @@ let outputstate opts = (******************************************************************************) let load_vernacular opts ~state = List.fold_left - (fun state (f_in, verbosely) -> + (fun state (f_in, echo) -> let s = Loadpath.locate_file f_in in (* Should make the beautify logic clearer *) - let load_vernac f = Vernac.load_vernac ~time:opts.time ~verbosely ~interactive:false ~check:true ~state f in + let load_vernac f = Vernac.load_vernac ~time:opts.time ~echo ~interactive:false ~check:true ~state f in if !Flags.beautify then Flags.with_option Flags.beautify_file load_vernac f_in else load_vernac s @@ -194,7 +192,7 @@ let ensure_exists f = fatal_error (hov 0 (str "Can't find file" ++ spc () ++ str f)) (* Compile a vernac file *) -let compile opts ~verbosely ~f_in ~f_out = +let compile opts ~echo ~f_in ~f_out = let open Vernac.State in let check_pending_proofs () = let pfs = Proof_global.get_all_proof_names () in @@ -232,7 +230,7 @@ let compile opts ~verbosely ~f_in ~f_out = Dumpglob.start_dump_glob ~vfile:long_f_dot_v ~vofile:long_f_dot_vo; Dumpglob.dump_string ("F" ^ Names.DirPath.to_string ldir ^ "\n"); let wall_clock1 = Unix.gettimeofday () in - let state = Vernac.load_vernac ~time:opts.time ~verbosely ~check:true ~interactive:false ~state long_f_dot_v in + let state = Vernac.load_vernac ~time:opts.time ~echo ~check:true ~interactive:false ~state long_f_dot_v in let _doc = Stm.join ~doc:state.doc in let wall_clock2 = Unix.gettimeofday () in check_pending_proofs (); @@ -273,7 +271,7 @@ let compile opts ~verbosely ~f_in ~f_out = let state = { doc; sid; proof = None } in let state = load_init_vernaculars opts ~state in let ldir = Stm.get_ldir ~doc:state.doc in - let state = Vernac.load_vernac ~time:opts.time ~verbosely ~check:false ~interactive:false ~state long_f_dot_v in + let state = Vernac.load_vernac ~time:opts.time ~echo ~check:false ~interactive:false ~state long_f_dot_v in let doc = Stm.finish ~doc:state.doc in check_pending_proofs (); let _doc = Stm.snapshot_vio ~doc ldir long_f_dot_vio in @@ -288,17 +286,17 @@ let compile opts ~verbosely ~f_in ~f_out = let univs, proofs = Stm.finish_tasks lfdv univs disch proofs tasks in Library.save_library_raw lfdv sum lib univs proofs -let compile opts ~verbosely ~f_in ~f_out = +let compile opts ~echo ~f_in ~f_out = ignore(CoqworkmgrApi.get 1); - compile opts ~verbosely ~f_in ~f_out; + compile opts ~echo ~f_in ~f_out; CoqworkmgrApi.giveback 1 -let compile_file opts (f_in, verbosely) = +let compile_file opts (f_in, echo) = if !Flags.beautify then Flags.with_option Flags.beautify_file - (fun f_in -> compile opts ~verbosely ~f_in ~f_out:None) f_in + (fun f_in -> compile opts ~echo ~f_in ~f_out:None) f_in else - compile opts ~verbosely ~f_in ~f_out:None + compile opts ~echo ~f_in ~f_out:None let compile_files opts = let compile_list = List.rev opts.compile_list in diff --git a/toplevel/coqtop.mli b/toplevel/coqtop.mli index dedb298e2a..510e10dd16 100644 --- a/toplevel/coqtop.mli +++ b/toplevel/coqtop.mli @@ -15,9 +15,6 @@ val init_toplevel : string list -> Vernac.State.t option * Coqargs.coq_cmdopts val start : unit -> unit -(* Last document seen after `Drop` *) -val drop_last_doc : Vernac.State.t option ref - (* For other toploops *) val toploop_init : (Coqargs.coq_cmdopts -> string list -> string list) ref val toploop_run : (Coqargs.coq_cmdopts -> state:Vernac.State.t -> unit) ref diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml index 92dee84f32..5d3addfec2 100644 --- a/toplevel/vernac.ml +++ b/toplevel/vernac.ml @@ -40,37 +40,6 @@ let vernac_echo ?loc in_chan = let open Loc in Feedback.msg_notice @@ str @@ really_input_string in_chan len ) loc -(* vernac parses the given stream, executes interpfun on the syntax tree it - * parses, and is verbose on "primitives" commands if verbosely is true *) - -let beautify_suffix = ".beautified" - -let set_formatter_translator ch = - let out s b e = output_substring ch s b e in - let ft = Format.make_formatter out (fun () -> flush ch) in - Format.pp_set_max_boxes ft max_int; - ft - -let pr_new_syntax_in_context ?loc ft_beautify ocom = - let loc = Option.cata Loc.unloc (0,0) loc in - let fs = States.freeze ~marshallable:`No in - (* Side-effect: order matters *) - let before = comment (CLexer.extract_comments (fst loc)) in - let com = match ocom with - | Some com -> Ppvernac.pr_vernac com - | None -> mt() in - let after = comment (CLexer.extract_comments (snd loc)) in - if !Flags.beautify_file then - (Pp.pp_with ft_beautify (hov 0 (before ++ com ++ after)); - Format.pp_print_flush ft_beautify ()) - else - Feedback.msg_info (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com))); - States.unfreeze fs - -let pr_new_syntax ?loc po ft_beautify ocom = - (* Reinstall the context of parsing which includes the bindings of comments to locations *) - Pcoq.Gram.with_parsable po (pr_new_syntax_in_context ?loc ft_beautify) ocom - (* For coqtop -time, we display the position in the file, and a glimpse of the executed command *) @@ -120,16 +89,9 @@ module State = struct end -let rec interp_vernac ~time ~check ~interactive ~state (loc,com) = +let interp_vernac ~time ~check ~interactive ~state (loc,com) = let open State in - let interp v = - match under_control v with - | VernacLoad (verbosely, fname) -> - let fname = Envars.expand_path_macros ~warn:(fun x -> Feedback.msg_warning (str x)) fname in - let fname = CUnix.make_suffix fname ".v" in - let f = Loadpath.locate_file fname in - load_vernac ~time ~verbosely ~check ~interactive ~state f - | _ -> + try (* XXX: We need to run this before add as the classification is highly dynamic and depends on the structure of the document. Hopefully this is fixed when VtMeta can be removed @@ -139,13 +101,17 @@ let rec interp_vernac ~time ~check ~interactive ~state (loc,com) = against that... *) let wflags = CWarnings.get_flags () in CWarnings.set_flags "none"; - let is_proof_step = match fst (Vernac_classifier.classify_vernac v) with + let is_proof_step = match fst (Vernac_classifier.classify_vernac com) with | VtProofStep _ | VtMeta | VtStartProof _ -> true | _ -> false in CWarnings.set_flags wflags; - let doc, nsid, ntip = Stm.add ~doc:state.doc ~ontop:state.sid (not !Flags.quiet) (loc,v) in + (* The -time option is only supported from console-based + clients due to the way it prints. *) + if time then print_cmd_header ?loc com; + let com = if time then VernacTime(time,(CAst.make ?loc com)) else com in + let doc, nsid, ntip = Stm.add ~doc:state.doc ~ontop:state.sid (not !Flags.quiet) (loc,com) in (* Main STM interaction *) if ntip <> `NewTip then @@ -165,13 +131,6 @@ let rec interp_vernac ~time ~check ~interactive ~state (loc,com) = if print_goals then Feedback.msg_notice (pr_open_cur_subgoals ()); let new_proof = Proof_global.give_me_the_proof_opt () in { doc = ndoc; sid = nsid; proof = new_proof } - in - try - (* The -time option is only supported from console-based - clients due to the way it prints. *) - if time then print_cmd_header ?loc com; - let com = if time then VernacTime(time, CAst.make ?loc com) else com in - interp com with reraise -> (* XXX: In non-interactive mode edit_at seems to do very weird things, so we better avoid it while we investigate *) @@ -184,18 +143,16 @@ let rec interp_vernac ~time ~check ~interactive ~state (loc,com) = end in iraise (reraise, info) (* Load a vernac file. CErrors are annotated with file and location *) -and load_vernac ~time ~verbosely ~check ~interactive ~state file = - let ft_beautify, close_beautify = - if !Flags.beautify_file then - let chan_beautify = open_out (file^beautify_suffix) in - set_formatter_translator chan_beautify, fun () -> close_out chan_beautify; - else - !Topfmt.std_ft, fun () -> () - in +let load_vernac_core ~time ~echo ~check ~interactive ~state file = + (* Keep in sync *) let in_chan = open_utf8_file_in file in - let in_echo = if verbosely then Some (open_utf8_file_in file) else None in + let in_echo = if echo then Some (open_utf8_file_in file) else None in + let input_cleanup () = close_in in_chan; Option.iter close_in in_echo in + let in_pa = Pcoq.Gram.parsable ~file:(Loc.InFile file) (Stream.of_channel in_chan) in let rstate = ref state in + (* For beautify, list of parsed sids *) + let rids = ref [] in let open State in try (* we go out of the following infinite loop when a End_of_input is @@ -222,36 +179,78 @@ and load_vernac ~time ~verbosely ~check ~interactive ~state file = *) in (* Printing of vernacs *) - if !Flags.beautify then pr_new_syntax ?loc in_pa ft_beautify (Some ast); Option.iter (vernac_echo ?loc) in_echo; checknav_simple (loc, ast); let state = Flags.silently (interp_vernac ~time ~check ~interactive ~state:!rstate) (loc, ast) in + rids := state.sid :: !rids; rstate := state; done; - !rstate + input_cleanup (); + !rstate, !rids, Pcoq.Gram.comment_state in_pa with any -> (* whatever the exception *) let (e, info) = CErrors.push any in - close_in in_chan; - Option.iter close_in in_echo; + input_cleanup (); match e with - | Stm.End_of_input -> - (* Is this called so comments at EOF are printed? *) - if !Flags.beautify then - pr_new_syntax ~loc:(Loc.make_loc (max_int,max_int)) in_pa ft_beautify None; - if !Flags.beautify_file then close_beautify (); - !rstate - | reraise -> - if !Flags.beautify_file then close_beautify (); - iraise (disable_drop e, info) - -(** [eval_expr : ?preserving:bool -> Loc.t * Vernacexpr.vernac_expr -> unit] - It executes one vernacular command. By default the command is - considered as non-state-preserving, in which case we add it to the - Backtrack stack (triggering a save of a frozen state and the generation - of a new state label). An example of state-preserving command is one coming - from the query panel of Coqide. *) + | Stm.End_of_input -> !rstate, !rids, Pcoq.Gram.comment_state in_pa + | reraise -> iraise (disable_drop e, info) let process_expr ~time ~state loc_ast = checknav_deep loc_ast; interp_vernac ~time ~interactive:true ~check:true ~state loc_ast + +(******************************************************************************) +(* Beautify-specific code *) +(******************************************************************************) + +(* vernac parses the given stream, executes interpfun on the syntax tree it + * parses, and is verbose on "primitives" commands if verbosely is true *) +let beautify_suffix = ".beautified" + +let set_formatter_translator ch = + let out s b e = output_substring ch s b e in + let ft = Format.make_formatter out (fun () -> flush ch) in + Format.pp_set_max_boxes ft max_int; + ft + +let pr_new_syntax ?loc ft_beautify ocom = + let loc = Option.cata Loc.unloc (0,0) loc in + let before = comment (Pputils.extract_comments (fst loc)) in + let com = Option.cata Ppvernac.pr_vernac (mt ()) ocom in + let after = comment (Pputils.extract_comments (snd loc)) in + if !Flags.beautify_file then + (Pp.pp_with ft_beautify (hov 0 (before ++ com ++ after)); + Format.pp_print_flush ft_beautify ()) + else + Feedback.msg_info (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com))) + +(* load_vernac with beautify *) +let beautify_pass ~doc ~comments ~ids ~filename = + let ft_beautify, close_beautify = + if !Flags.beautify_file then + let chan_beautify = open_out (filename^beautify_suffix) in + set_formatter_translator chan_beautify, fun () -> close_out chan_beautify; + else + !Topfmt.std_ft, fun () -> () + in + (* The interface to the comment printer is imperative, so we first + set the comments, then we call print. This has to be done for + each file. *) + Pputils.beautify_comments := comments; + List.iter (fun id -> + Option.iter (fun (loc,ast) -> + pr_new_syntax ?loc ft_beautify (Some ast)) + (Stm.get_ast ~doc id)) ids; + + (* Is this called so comments at EOF are printed? *) + pr_new_syntax ~loc:(Loc.make_loc (max_int,max_int)) ft_beautify None; + close_beautify () + +(* Main driver for file loading. For now, we only do one beautify + pass. *) +let load_vernac ~time ~echo ~check ~interactive ~state filename = + let ostate, ids, comments = load_vernac_core ~time ~echo ~check ~interactive ~state filename in + (* Pass for beautify *) + if !Flags.beautify then beautify_pass ~doc:ostate.State.doc ~comments ~ids:List.(rev ids) ~filename; + (* End pass *) + ostate diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli index e909ada1e5..ca825197ba 100644 --- a/toplevel/vernac.mli +++ b/toplevel/vernac.mli @@ -26,5 +26,5 @@ val process_expr : time:bool -> state:State.t -> Vernacexpr.vernac_control Loc.l (** [load_vernac echo sid file] Loads [file] on top of [sid], will echo the commands if [echo] is set. Callers are expected to handle and print errors in form of exceptions. *) -val load_vernac : time:bool -> verbosely:bool -> check:bool -> interactive:bool -> +val load_vernac : time:bool -> echo:bool -> check:bool -> interactive:bool -> state:State.t -> string -> State.t diff --git a/vernac/classes.ml b/vernac/classes.ml index 695be74bbe..cd5eff4e7c 100644 --- a/vernac/classes.ml +++ b/vernac/classes.ml @@ -52,7 +52,7 @@ let _ = let open Vernacexpr in { info with hint_pattern = Option.map - (Constrintern.intern_constr_pattern (Global.env())) + (Constrintern.intern_constr_pattern (Global.env()) Evd.(from_env Global.(env()))) info.hint_pattern } in Flags.silently (fun () -> Hints.add_hints local [typeclasses_db] @@ -334,7 +334,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) let init_refine = Tacticals.New.tclTHENLIST [ Refine.refine ~typecheck:false (fun sigma -> (sigma,EConstr.of_constr (Option.get term))); - Proofview.Unsafe.tclNEWGOALS gls; + Proofview.Unsafe.tclNEWGOALS (CList.map Proofview.with_empty_state gls); Tactics.New.reduce_after_refine; ] in diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml index 7e5b941ad5..9fd2153cbc 100644 --- a/vernac/comAssumption.ml +++ b/vernac/comAssumption.ml @@ -10,7 +10,6 @@ open Pp open CErrors open Util open Vars -open Environ open Declare open Names open Globnames @@ -87,7 +86,6 @@ match local with let interp_assumption sigma env impls bl c = let c = mkCProdN ?loc:(local_binders_loc bl) bl c in let sigma, (ty, impls) = interp_type_evars_impls env sigma ~impls c in - let ty = EConstr.Unsafe.to_constr ty in sigma, (ty, impls) (* When monomorphic the universe constraints are declared with the first declaration only. *) @@ -151,9 +149,9 @@ let do_assumptions kind nl l = let (sigma,_,_),l = List.fold_left_map (fun (sigma,env,ienv) (is_coe,(idl,c)) -> let sigma,(t,imps) = interp_assumption sigma env ienv [] c in let env = - push_named_context (List.map (fun {CAst.v=id} -> LocalAssum (id,t)) idl) env in + EConstr.push_named_context (List.map (fun {CAst.v=id} -> LocalAssum (id,t)) idl) env in let ienv = List.fold_right (fun {CAst.v=id} ienv -> - let impls = compute_internalization_data env Variable t imps in + let impls = compute_internalization_data env sigma Variable t imps in Id.Map.add id impls ienv) idl ienv in ((sigma,env,ienv),((is_coe,idl),t,imps))) (sigma,env,empty_internalization_env) l @@ -161,7 +159,7 @@ let do_assumptions kind nl l = let sigma = solve_remaining_evars all_and_fail_flags env sigma Evd.empty in (* The universe constraints come from the whole telescope. *) let sigma = Evd.nf_constraints sigma in - let nf_evar c = EConstr.to_constr sigma (EConstr.of_constr c) in + let nf_evar c = EConstr.to_constr sigma c in let uvars, l = List.fold_left_map (fun uvars (coe,t,imps) -> let t = nf_evar t in let uvars = Univ.LSet.union uvars (Univops.universes_of_constr env t) in diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml index 489f299a20..edfe7aa819 100644 --- a/vernac/comFixpoint.ml +++ b/vernac/comFixpoint.ml @@ -212,8 +212,7 @@ let interp_recursive ~program_mode ~cofix fixl notations = let env_rec = push_named_context rec_sign env in (* Get interpretation metadatas *) - let fixtypes = List.map EConstr.Unsafe.to_constr fixtypes in - let impls = compute_internalization_env env Recursive fixnames fixtypes fiximps in + let impls = compute_internalization_env env sigma Recursive fixnames fixtypes fiximps in (* Interp bodies with rollback because temp use of notations/implicit *) let sigma, fixdefs = @@ -226,10 +225,9 @@ let interp_recursive ~program_mode ~cofix fixl notations = (* Instantiate evars and check all are resolved *) let sigma = solve_unif_constraints_with_heuristics env_rec sigma in - let sigma, nf = nf_evars_and_universes sigma in - let fixdefs = List.map (fun c -> Option.map EConstr.Unsafe.to_constr c) fixdefs in - let fixdefs = List.map (Option.map nf) fixdefs in - let fixtypes = List.map nf fixtypes in + let sigma, _ = nf_evars_and_universes sigma in + let fixdefs = List.map (fun c -> Option.map EConstr.(to_constr sigma) c) fixdefs in + let fixtypes = List.map EConstr.(to_constr sigma) fixtypes in let fixctxs = List.map (fun (_,ctx) -> ctx) fixctxs in (* Build the fix declaration block *) diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml index c650e9e40c..cef5546c62 100644 --- a/vernac/comInductive.ml +++ b/vernac/comInductive.ml @@ -11,7 +11,6 @@ open CErrors open Sorts open Util open Constr -open Termops open Environ open Declare open Names @@ -51,7 +50,7 @@ let rec complete_conclusion a cs = CAst.map_with_loc (fun ?loc -> function ) let push_types env idl tl = - List.fold_left2 (fun env id t -> Environ.push_rel (LocalAssum (Name id,t)) env) + List.fold_left2 (fun env id t -> EConstr.push_rel (LocalAssum (Name id,t)) env) env idl tl type structured_one_inductive_expr = { @@ -90,7 +89,7 @@ let check_all_names_different indl = | _ -> raise (InductiveError (SameNamesOverlap l)) let mk_mltype_data sigma env assums arity indname = - let is_ml_type = is_sort env sigma (EConstr.of_constr arity) in + let is_ml_type = is_sort env sigma arity in (is_ml_type,indname,assums) let prepare_param = function @@ -130,14 +129,13 @@ let is_impredicative env u = u = Prop Null || (is_impredicative_set env && u = Prop Pos) let interp_ind_arity env sigma ind = - let c = intern_gen IsType env ind.ind_arity in + let c = intern_gen IsType env sigma ind.ind_arity in let impls = Implicit_quantifiers.implicits_of_glob_constr ~with_products:true c in let sigma,t = understand_tcc env sigma ~expected_type:IsType c in let pseudo_poly = check_anonymous_type c in let () = if not (Reductionops.is_arity env sigma t) then user_err ?loc:(constr_loc ind.ind_arity) (str "Not an arity") in - let t = EConstr.Unsafe.to_constr t in sigma, (t, pseudo_poly, impls) let interp_cstrs env sigma impls mldata arity ind = @@ -272,7 +270,6 @@ let interp_mutual_inductive (paramsl,indl) notations cum poly prv finite = let sigma, (impls, ((env_params, ctx_params), userimpls)) = interp_context_evars env0 sigma paramsl in - let ctx_params = List.map (fun d -> map_rel_decl EConstr.Unsafe.to_constr d) ctx_params in let indnames = List.map (fun ind -> ind.ind_name) indl in (* Names of parameters as arguments of the inductive type (defs removed) *) @@ -282,16 +279,16 @@ let interp_mutual_inductive (paramsl,indl) notations cum poly prv finite = (* Interpret the arities *) let sigma, arities = List.fold_left_map (fun sigma -> interp_ind_arity env_params sigma) sigma indl in - let fullarities = List.map (fun (c, _, _) -> Term.it_mkProd_or_LetIn c ctx_params) arities in + let fullarities = List.map (fun (c, _, _) -> EConstr.it_mkProd_or_LetIn c ctx_params) arities in let env_ar = push_types env0 indnames fullarities in - let env_ar_params = push_rel_context ctx_params env_ar in + let env_ar_params = EConstr.push_rel_context ctx_params env_ar in (* Compute interpretation metadatas *) let indimpls = List.map (fun (_, _, impls) -> userimpls @ lift_implicits (Context.Rel.nhyps ctx_params) impls) arities in let arities = List.map pi1 arities and aritypoly = List.map pi2 arities in - let impls = compute_internalization_env env0 ~impls (Inductive (params,true)) indnames fullarities indimpls in - let ntn_impls = compute_internalization_env env0 (Inductive (params,true)) indnames fullarities indimpls in + let impls = compute_internalization_env env0 sigma ~impls (Inductive (params,true)) indnames fullarities indimpls in + let ntn_impls = compute_internalization_env env0 sigma (Inductive (params,true)) indnames fullarities indimpls in let mldatas = List.map2 (mk_mltype_data sigma env_params params) arities indnames in let sigma, constructors = @@ -306,15 +303,14 @@ let interp_mutual_inductive (paramsl,indl) notations cum poly prv finite = let sigma = solve_remaining_evars all_and_fail_flags env_params sigma Evd.empty in (* Compute renewed arities *) let sigma, nf = nf_evars_and_universes sigma in - let arities = List.map nf arities in let constructors = List.map (fun (idl,cl,impsl) -> (idl,List.map nf cl,impsl)) constructors in + let arities = List.map EConstr.(to_constr sigma) arities in let sigma = List.fold_left2 (fun sigma ty poly -> make_conclusion_flexible sigma ty poly) sigma arities aritypoly in let sigma, arities = inductive_levels env_ar_params sigma poly arities constructors in let sigma, nf' = nf_evars_and_universes sigma in - let nf x = nf' (nf x) in let arities = List.map nf' arities in let constructors = List.map (fun (idl,cl,impsl) -> (idl,List.map nf' cl,impsl)) constructors in - let ctx_params = Context.Rel.map nf ctx_params in + let ctx_params = List.map Termops.(map_rel_decl (EConstr.to_constr sigma)) ctx_params in let uctx = Evd.check_univ_decl ~poly sigma decl in List.iter (fun c -> check_evars env_params Evd.empty sigma (EConstr.of_constr c)) arities; Context.Rel.iter (fun c -> check_evars env0 Evd.empty sigma (EConstr.of_constr c)) ctx_params; diff --git a/vernac/comProgramFixpoint.ml b/vernac/comProgramFixpoint.ml index af34f8b299..bd7ee0978f 100644 --- a/vernac/comProgramFixpoint.ml +++ b/vernac/comProgramFixpoint.ml @@ -171,8 +171,8 @@ let build_wellfounded (recname,pl,n,bl,arityc,body) poly r measure notation = let sigma, intern_body = let ctx = LocalAssum (Name recname, get_type curry_fun) :: binders_rel in let (r, l, impls, scopes) = - Constrintern.compute_internalization_data env - Constrintern.Recursive (EConstr.Unsafe.to_constr full_arity) impls + Constrintern.compute_internalization_data env sigma + Constrintern.Recursive full_arity impls in let newimpls = Id.Map.singleton recname (r, l, impls @ [(Some (Id.of_string "recproof", Impargs.Manual, (true, false)))], diff --git a/vernac/obligations.ml b/vernac/obligations.ml index e4bcbc4bb6..6447fc3502 100644 --- a/vernac/obligations.ml +++ b/vernac/obligations.ml @@ -816,13 +816,13 @@ let solve_by_tac name evi t poly ctx = let id = name in let concl = EConstr.of_constr evi.evar_concl in (* spiwack: the status is dropped. *) - let (entry,_,ctx') = Pfedit.build_constant_by_tactic + let (entry,_,ctx') = Pfedit.build_constant_by_tactic id ~goal_kind:(goal_kind poly) ctx evi.evar_hyps concl (Tacticals.New.tclCOMPLETE t) in let env = Global.env () in let entry = Safe_typing.inline_private_constants_in_definition_entry env entry in let body, () = Future.force entry.const_entry_body in let ctx' = Evd.merge_context_set ~sideff:true Evd.univ_rigid (Evd.from_ctx ctx') (snd body) in - Inductiveops.control_only_guard (Global.env ()) (fst body); + Inductiveops.control_only_guard env ctx' (EConstr.of_constr (fst body)); (fst body), entry.const_entry_type, Evd.evar_universe_context ctx' let obligation_terminator name num guard hook auto pf = @@ -838,7 +838,7 @@ let obligation_terminator name num guard hook auto pf = let (body, cstr), () = Future.force entry.Entries.const_entry_body in let sigma = Evd.from_ctx uctx in let sigma = Evd.merge_context_set ~sideff:true Evd.univ_rigid sigma cstr in - Inductiveops.control_only_guard (Global.env ()) body; + Inductiveops.control_only_guard (Global.env ()) sigma (EConstr.of_constr body); (** Declare the obligation ourselves and drop the hook *) let prg = get_info (ProgMap.find name !from_prg) in (** Ensure universes are substituted properly in body and type *) diff --git a/vernac/record.ml b/vernac/record.ml index 1140e3d375..44113bfadb 100644 --- a/vernac/record.ml +++ b/vernac/record.ml @@ -70,7 +70,7 @@ let interp_fields_evars env sigma impls_env nots l = let impls = match i with | Anonymous -> impls - | Name id -> Id.Map.add id (compute_internalization_data env Constrintern.Method (EConstr.to_constr sigma t') impl) impls + | Name id -> Id.Map.add id (compute_internalization_data env sigma Constrintern.Method t' impl) impls in let d = match b' with | None -> LocalAssum (i,t') @@ -145,7 +145,7 @@ let typecheck_params_and_fields finite def id poly pl t ps nots fs = let assums = List.filter is_local_assum newps in let params = List.map (RelDecl.get_name %> Name.get_id) assums in let ty = Inductive (params,(finite != Declarations.BiFinite)) in - let impls_env = compute_internalization_env env0 ~impls:impls_env ty [id] [EConstr.to_constr sigma arity] [imps] in + let impls_env = compute_internalization_env env0 sigma ~impls:impls_env ty [id] [arity] [imps] in let env2,sigma,impls,newfs,data = interp_fields_evars env_ar sigma impls_env nots (binders_of_decls fs) in diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index 4613100fc3..6b7746db41 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -1025,7 +1025,9 @@ let vernac_arguments ~atts reference args more_implicits nargs_for_red flags = let sr = smart_global reference in let inf_names = let ty, _ = Global.type_of_global_in_context (Global.env ()) sr in - Impargs.compute_implicits_names (Global.env ()) ty + let env = Global.env () in + let sigma = Evd.from_env env in + Impargs.compute_implicits_names env sigma (EConstr.of_constr ty) in let prev_names = try Arguments_renaming.arguments_names sr with Not_found -> inf_names @@ -1253,7 +1255,7 @@ let vernac_reserve bl = let env = Global.env() in let sigma = Evd.from_env env in let t,ctx = Constrintern.interp_type env sigma c in - let t = Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_ctx ctx) (EConstr.of_constr t) in + let t = Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_ctx ctx) t in let t,_ = Notation_ops.notation_constr_of_glob_constr (default_env ()) t in Reserve.declare_reserved_type idl t) in List.iter sb_decl bl @@ -1627,6 +1629,7 @@ let vernac_global_check c = let senv = Global.safe_env() in let uctx = UState.context_set uctx in let senv = Safe_typing.push_context_set false uctx senv in + let c = EConstr.to_constr sigma c in let j = Safe_typing.typing senv c in let env = Safe_typing.env_of_safe_env senv in print_safe_judgment env sigma j ++ @@ -1747,10 +1750,10 @@ let interp_search_restriction = function open Search -let interp_search_about_item env = +let interp_search_about_item env sigma = function | SearchSubPattern pat -> - let _,pat = intern_constr_pattern env pat in + let _,pat = intern_constr_pattern env sigma pat in GlobSearchSubPattern pat | SearchString (s,None) when Id.is_valid s -> GlobSearchString s @@ -1796,13 +1799,13 @@ let vernac_search ~atts s gopt r = (* if goal selector is given and wrong, then let exceptions be raised. *) | Some g -> snd (Pfedit.get_goal_context g) , Some g in - let get_pattern c = snd (intern_constr_pattern env c) in + let get_pattern c = snd (intern_constr_pattern env Evd.(from_env env) c) in let pr_search ref env c = let pr = pr_global ref in let pp = if !search_output_name_only then pr else begin - let pc = pr_lconstr_env env Evd.empty c in + let pc = pr_lconstr_env env Evd.(from_env env) c in hov 2 (pr ++ str":" ++ spc () ++ pc) end in Feedback.msg_notice pp @@ -1815,7 +1818,8 @@ let vernac_search ~atts s gopt r = | SearchHead c -> (Search.search_by_head gopt (get_pattern c) r |> Search.prioritize_search) pr_search | SearchAbout sl -> - (Search.search_about gopt (List.map (on_snd (interp_search_about_item env)) sl) r |> Search.prioritize_search) pr_search + (Search.search_about gopt (List.map (on_snd (interp_search_about_item env Evd.(from_env env))) sl) r |> + Search.prioritize_search) pr_search let vernac_locate = function | LocateAny (AN qid) -> print_located_qualid qid @@ -1910,8 +1914,7 @@ let vernac_check_guard () = let message = try let { Evd.it=gl ; sigma=sigma } = Proof.V82.top_goal pts in - Inductiveops.control_only_guard (Goal.V82.env sigma gl) - (EConstr.Unsafe.to_constr pfterm); + Inductiveops.control_only_guard (Goal.V82.env sigma gl) sigma pfterm; (str "The condition holds up to here") with UserError(_,s) -> (str ("Condition violated: ") ++s) @@ -1926,6 +1929,8 @@ exception End_of_input without a considerable amount of refactoring. *) let vernac_load interp fname = + if Proof_global.there_are_pending_proofs () then + CErrors.user_err Pp.(str "Load is not supported inside proofs."); let interp x = let proof_mode = Proof_global.get_default_proof_mode_name () [@ocaml.warning "-3"] in Proof_global.activate_proof_mode proof_mode [@ocaml.warning "-3"]; @@ -1942,8 +1947,13 @@ let vernac_load interp fname = let longfname = Loadpath.locate_file fname in let in_chan = open_utf8_file_in longfname in Pcoq.Gram.parsable ~file:(Loc.InFile longfname) (Stream.of_channel in_chan) in - try while true do interp (snd (parse_sentence input)) done - with End_of_input -> () + begin + try while true do interp (snd (parse_sentence input)) done + with End_of_input -> () + end; + (* If Load left a proof open, we fail too. *) + if Proof_global.there_are_pending_proofs () then + CErrors.user_err Pp.(str "Files processed by Load cannot leave open proofs.") (* "locality" is the prefix "Local" attribute, while the "local" component * is the outdated/deprecated "Local" attribute of some vernacular commands @@ -1954,6 +1964,7 @@ let interp ?proof ~atts ~st c = vernac_pperr_endline (fun () -> str "interpreting: " ++ Ppvernac.pr_vernac_expr c); match c with + (* Loading a file requires access to the control interpreter *) | VernacLoad _ -> assert false (* The STM should handle that, but LOAD bypasses the STM... *) |