diff options
| author |  Benjamin Barenblat <bbaren@debian.org> | 2019-02-02 19:29:23 -0500 |
|---|---|---|
| committer | Benjamin Barenblat <bbaren@debian.org> | 2019-02-02 19:29:23 -0500 |
| commit | 9ebf44d84754adc5b64fcf612c6816c02c80462d (patch) | |
| tree | bf5e06a28488e0e06a2f2011ff0d110e2e02f8fc /test-suite | |
| parent | 9043add656177eeac1491a73d2f3ab92bec0013c (diff) | |
Imported Upstream version 8.9.0upstream/8.9.0upstream
Diffstat (limited to 'test-suite')
244 files changed, 6684 insertions, 1266 deletions
diff --git a/test-suite/Makefile b/test-suite/Makefile index 85076418..598d6db2 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -8,9 +8,6 @@ ## # (see LICENSE file for the text of the license) ## ########################################################################## -# This is a standalone Makefile to run the test-suite. It can be used -# outside of the Coq source tree (if BIN is overridden). - # There is one %.v.log target per %.v test file. The target will be # filled with the output, timings and status of the test. There is # also one target per directory containing %.v files, that runs all @@ -23,6 +20,14 @@ # The "run" target runs all tests that have not been run yet. To force # all tests to be run, use the "clean" target. + +########################################################################### +# Includes +########################################################################### + +-include ../config/Makefile +include ../Makefile.common + ####################################################################### # Variables ####################################################################### @@ -79,6 +84,8 @@ log_anomaly = "==========> FAILURE <==========" log_failure = "==========> FAILURE <==========" log_intro = "==========> TESTING $(1) <==========" +FAIL = >&2 echo 'FAILED $@' + ####################################################################### # Testing subsystems ####################################################################### @@ -92,10 +99,10 @@ INTERACTIVE := interactive VSUBSYSTEMS := prerequisite success failure $(BUGS) output \ output-modulo-time $(INTERACTIVE) micromega $(COMPLEXITY) modules stm \ - coqdoc + coqdoc ssr # All subsystems -SUBSYSTEMS := $(VSUBSYSTEMS) misc bugs ide vio coqchk coqwc coq-makefile +SUBSYSTEMS := $(VSUBSYSTEMS) misc bugs ide vio coqchk coqwc coq-makefile tools unit-tests PREREQUISITELOG = prerequisite/admit.v.log \ prerequisite/make_local.v.log prerequisite/make_notation.v.log \ @@ -116,25 +123,27 @@ run: $(SUBSYSTEMS) bugs: $(BUGS) clean: - rm -f trace .lia.cache - $(SHOW) "RM <**/*.stamp> <**/*.vo> <**/*.vio> <**/*.log>" + rm -f trace .lia.cache output/MExtraction.out + $(SHOW) 'RM <**/*.stamp> <**/*.vo> <**/*.vio> <**/*.log> <**/*.glob>' $(HIDE)find . \( \ - -name '*.stamp' -o -name '*.vo' -o -name '*.vio' -o -name '*.log' \ - \) -print0 | xargs -0 rm -f - + -name '*.stamp' -o -name '*.vo' -o -name '*.vio' -o -name '*.log' -o -name '*.glob' \ + \) -print0 | xargs -0 rm -f + $(SHOW) 'RM <**/*.cmx> <**/*.cmi> <**/*.o> <**/*.test>' + $(HIDE)find unit-tests \( \ + -name '*.cmx' -o -name '*.cmi' -o -name '*.o' -o -name '*.test' \ + \) -print0 | xargs -0 rm -f distclean: clean - $(HIDE)find . -name '*.log' -print0 | xargs -0 rm -f + $(SHOW) 'RM <**/*.aux>' + $(HIDE)find . -name '*.aux' -print0 | xargs -0 rm -f ####################################################################### # Per-subsystem targets ####################################################################### -define mkstamp -$(1): $(1).stamp ; @true -$(1).stamp: $(patsubst %.v,%.v.log,$(wildcard $(1)/*.v)) ; \ - $(HIDE)touch $$@ +define vdeps +$(1): $(patsubst %.v,%.v.log,$(wildcard $(1)/*.v)) endef -$(foreach S,$(VSUBSYSTEMS),$(eval $(call mkstamp,$(S)))) +$(foreach S,$(VSUBSYSTEMS),$(eval $(call vdeps,$(S)))) ####################################################################### # Summary @@ -158,18 +167,21 @@ summary: $(call summary_dir, "Complexity tests", complexity); \ $(call summary_dir, "Module tests", modules); \ $(call summary_dir, "STM tests", stm); \ + $(call summary_dir, "SSR tests", ssr); \ $(call summary_dir, "IDE tests", ide); \ $(call summary_dir, "VI tests", vio); \ $(call summary_dir, "Coqchk tests", coqchk); \ $(call summary_dir, "Coqwc tests", coqwc); \ $(call summary_dir, "Coq makefile", coq-makefile); \ $(call summary_dir, "Coqdoc tests", coqdoc); \ + $(call summary_dir, "tools/ tests", tools); \ + $(call summary_dir, "Unit tests", unit-tests); \ nb_success=`find . -name '*.log' -exec tail -n2 '{}' \; | grep -e $(log_success) | wc -l`; \ nb_failure=`find . -name '*.log' -exec tail -n2 '{}' \; | grep -e $(log_failure) | wc -l`; \ nb_tests=`expr $$nb_success + $$nb_failure`; \ - pourcentage=`expr 100 \* $$nb_success / $$nb_tests`; \ + percentage=`expr 100 \* $$nb_success / $$nb_tests`; \ echo; \ - echo "$$nb_success tests passed over $$nb_tests, i.e. $$pourcentage %"; \ + echo "$$nb_success tests passed over $$nb_tests, i.e. $$percentage %"; \ } summary.log: @@ -185,10 +197,7 @@ PRINT_LOGS:=APPVEYOR endif #APPVEYOR report: summary.log - $(HIDE)bash save-logs.sh - $(HIDE)if [ -n "${TRAVIS}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo "travis_fold:start:coq.logs.$$(echo '{}' | sed s,/,.,g)"' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo "travis_fold:end:coq.logs.$$(echo '{}' | sed s,/,.,g)"' ';'; fi - $(HIDE)if [ -n "${PRINT_LOGS}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo {}' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo' ';'; fi - $(HIDE)if grep -q -F 'Error!' summary.log ; then echo FAILURES; grep -F 'Error!' summary.log; false; else echo NO FAILURES; fi + $(HIDE)bash report.sh ####################################################################### # Regression (and progression) tests @@ -218,6 +227,7 @@ $(addsuffix .log,$(wildcard bugs/opened/*.v)): %.v.log: %.v else \ echo $(log_failure); \ echo " $<...Error! (bug seems to be closed, please check)"; \ + $(FAIL); \ fi; \ } > "$@" @@ -233,10 +243,49 @@ $(addsuffix .log,$(wildcard bugs/closed/*.v)): %.v.log: %.v else \ echo $(log_failure); \ echo " $<...Error! (bug seems to be opened, please check)"; \ + $(FAIL); \ fi; \ } > "$@" ####################################################################### +# Unit tests +####################################################################### + +OCAMLOPT := $(OCAMLFIND) opt $(CAMLFLAGS) +SYSMOD:=-package num,str,unix,dynlink,threads + +COQSRCDIRS:=$(addprefix -I $(LIB)/,$(CORESRCDIRS)) +COQCMXS:=$(addprefix $(LIB)/,$(LINKCMX)) + +# ML files from unit-test framework, not containing tests +UNIT_SRCFILES:=$(shell find ./unit-tests/src -name *.ml) +UNIT_ALLMLFILES:=$(shell find ./unit-tests -name *.ml) +UNIT_MLFILES:=$(filter-out $(UNIT_SRCFILES),$(UNIT_ALLMLFILES)) +UNIT_LOGFILES:=$(patsubst %.ml,%.ml.log,$(UNIT_MLFILES)) + +UNIT_CMXS=utest.cmx + +unit-tests/src/utest.cmx: unit-tests/src/utest.ml unit-tests/src/utest.cmi + $(SHOW) 'OCAMLOPT $<' + $(HIDE)$(OCAMLOPT) -c -I unit-tests/src -package oUnit $< +unit-tests/src/utest.cmi: unit-tests/src/utest.mli + $(SHOW) 'OCAMLOPT $<' + $(HIDE)$(OCAMLOPT) -package oUnit $< + +$(UNIT_LOGFILES): unit-tests/src/utest.cmx + +unit-tests: $(UNIT_LOGFILES) + +# Build executable, run it to generate log file +unit-tests/%.ml.log: unit-tests/%.ml + $(SHOW) 'TEST $<' + $(HIDE)$(OCAMLOPT) -linkall -linkpkg -cclib -lcoqrun \ + $(SYSMOD) -package camlp5.gramlib,oUnit \ + -I unit-tests/src $(COQSRCDIRS) $(COQCMXS) \ + $(UNIT_CMXS) $< -o $<.test; + $(HIDE)./$<.test + +####################################################################### # Other generic tests ####################################################################### @@ -248,13 +297,15 @@ $(addsuffix .log,$(wildcard prerequisite/*.v)): %.v.log: %.v if [ $$R != 0 ]; then \ echo $(log_failure); \ echo " $<...could not be prepared" ; \ + $(FAIL); \ else \ echo $(log_success); \ echo " $<...correctly prepared" ; \ fi; \ } > "$@" -$(addsuffix .log,$(wildcard success/*.v micromega/*.v modules/*.v)): %.v.log: %.v $(PREREQUISITELOG) +ssr: $(wildcard ssr/*.v:%.v=%.v.log) +$(addsuffix .log,$(wildcard ssr/*.v success/*.v micromega/*.v modules/*.v)): %.v.log: %.v $(PREREQUISITELOG) @echo "TEST $< $(call get_coq_prog_args_in_parens,"$<")" $(HIDE){ \ opts="$(if $(findstring modules/,$<),-R modules Mods -impredicative-set)"; \ @@ -266,6 +317,7 @@ $(addsuffix .log,$(wildcard success/*.v micromega/*.v modules/*.v)): %.v.log: %. else \ echo $(log_failure); \ echo " $<...Error! (should be accepted)"; \ + $(FAIL); \ fi; \ } > "$@" @@ -282,6 +334,7 @@ $(addsuffix .log,$(wildcard stm/*.v)): %.v.log: %.v else \ echo $(log_failure); \ echo " $<...Error! (should be accepted)"; \ + $(FAIL); \ fi; \ } > "$@" @@ -296,6 +349,7 @@ $(addsuffix .log,$(wildcard failure/*.v)): %.v.log: %.v $(PREREQUISITELOG) else \ echo $(log_failure); \ echo " $<...Error! (should be rejected)"; \ + $(FAIL); \ fi; \ } > "$@" @@ -303,25 +357,33 @@ $(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out $(PREREQUISITELOG) @echo "TEST $< $(call get_coq_prog_args_in_parens,"$<")" $(HIDE){ \ echo $(call log_intro,$<); \ - tmpoutput=`mktemp /tmp/coqcheck.XXXXXX`; \ + output=$*.out.real; \ $(call get_command_based_on_flags,"$<") "$<" $(call get_coq_prog_args,"$<") 2>&1 \ | grep -v "Welcome to Coq" \ | grep -v "\[Loading ML file" \ | grep -v "Skipping rcfile loading" \ | grep -v "^<W>" \ | sed 's/File "[^"]*"/File "stdin"/' \ - > $$tmpoutput; \ - diff -u --strip-trailing-cr $*.out $$tmpoutput 2>&1; R=$$?; times; \ + > $$output; \ + diff -u --strip-trailing-cr $*.out $$output 2>&1; R=$$?; times; \ if [ $$R = 0 ]; then \ echo $(log_success); \ echo " $<...Ok"; \ + rm $$output; \ else \ echo $(log_failure); \ echo " $<...Error! (unexpected output)"; \ + $(FAIL); \ fi; \ - rm $$tmpoutput; \ } > "$@" +.PHONY: approve-output +approve-output: output + $(HIDE)for f in output/*.out.real; do \ + mv "$$f" "$${f%.real}"; \ + echo "Updated $${f%.real}!"; \ + done + # the expected output for the MExtraction test is # /plugins/micromega/micromega.ml except with additional newline output/MExtraction.out: ../plugins/micromega/micromega.ml @@ -360,6 +422,7 @@ $(addsuffix .log,$(wildcard output-modulo-time/*.v)): %.v.log: %.v %.out else \ echo $(log_failure); \ echo " $<...Error! (unexpected output)"; \ + $(FAIL); \ fi; \ rm $$tmpoutput; \ rm $$tmpexpected; \ @@ -376,6 +439,7 @@ $(addsuffix .log,$(wildcard interactive/*.v)): %.v.log: %.v $(PREREQUISITELOG) else \ echo $(log_failure); \ echo " $<...Error! (should be accepted)"; \ + $(FAIL); \ fi; \ } > "$@" @@ -408,6 +472,7 @@ $(addsuffix .log,$(wildcard complexity/*.v)): %.v.log: %.v $(PREREQUISITELOG) else \ echo $(log_failure); \ echo " $<...Error! (should run faster)"; \ + $(FAIL); \ fi; \ fi; \ } > "$@" @@ -425,6 +490,7 @@ $(addsuffix .log,$(wildcard ideal-features/*.v)): %.v.log: %.v $(PREREQUISITELOG else \ echo $(log_failure); \ echo " $<...Good news! (wish seems to be granted, please check)"; \ + $(FAIL); \ fi; \ } > "$@" @@ -448,6 +514,7 @@ $(patsubst %.sh,%.log,$(wildcard misc/*.sh)): %.log: %.sh $(PREREQUISITELOG) @echo "TEST $<" $(HIDE){ \ echo $(call log_intro,$<); \ + export BIN="$(BIN)"; \ export coqc="$(coqc)"; \ export coqtop="$(coqtop)"; \ export coqdep="$(coqdep)"; \ @@ -459,6 +526,7 @@ $(patsubst %.sh,%.log,$(wildcard misc/*.sh)): %.log: %.sh $(PREREQUISITELOG) else \ echo $(log_failure); \ echo " $<...Error!"; \ + $(FAIL); \ fi; \ } > "$@" @@ -477,6 +545,7 @@ ide : $(patsubst %.fake,%.fake.log,$(wildcard ide/*.fake)) else \ echo $(log_failure); \ echo " $<...Error!"; \ + $(FAIL); \ fi; \ } > "$@" @@ -496,6 +565,7 @@ vio: $(patsubst %.v,%.vio.log,$(wildcard vio/*.v)) else \ echo $(log_failure); \ echo " $<...Error!"; \ + $(FAIL); \ fi; \ } > "$@" @@ -514,6 +584,7 @@ coqchk: $(patsubst %.v,%.chk.log,$(wildcard coqchk/*.v)) else \ echo $(log_failure); \ echo " $<...Error!"; \ + $(FAIL); \ fi; \ } > "$@" @@ -533,6 +604,7 @@ coqwc/%.v.log : coqwc/%.v else \ echo $(log_failure); \ echo " $<...Error! (unexpected output)"; \ + $(FAIL); \ fi; \ rm $$tmpoutput; \ } > "$@" @@ -553,6 +625,7 @@ coq-makefile/%.log : coq-makefile/%/run.sh else \ echo $(log_failure); \ echo " $<...Error!"; \ + $(FAIL); \ fi; \ ) > "$@" @@ -577,5 +650,26 @@ $(addsuffix .log,$(wildcard coqdoc/*.v)): %.v.log: %.v %.html.out %.tex.out $(PR else \ echo $(log_failure); \ echo " $<...Error! (unexpected output)"; \ + $(FAIL); \ fi; \ } > "$@" + +# tools/ + +tools: $(patsubst %/run.sh,%.log,$(wildcard tools/*/run.sh)) + +tools/%.log : tools/%/run.sh + @echo "TEST tools/$*" + $(HIDE)(\ + export COQBIN=$(BIN);\ + cd tools/$* && \ + bash run.sh 2>&1; \ + if [ $$? = 0 ]; then \ + echo $(log_success); \ + echo " $<...Ok"; \ + else \ + echo $(log_failure); \ + echo " $<...Error!"; \ + $(FAIL); \ + fi; \ + ) > "$@" diff --git a/test-suite/README.md b/test-suite/README.md index 1d119564..e81da083 100644 --- a/test-suite/README.md +++ b/test-suite/README.md @@ -62,14 +62,37 @@ BUILDING SUMMARY FILE NO FAILURES ``` -See [`test-suite/Makefile`](/test-suite/Makefile) for more information. +See [`test-suite/Makefile`](Makefile) for more information. ## Adding a test -Regression tests for closed bugs should be added to `test-suite/bugs/closed`, as `1234.v` where `1234` is the bug number. +Regression tests for closed bugs should be added to +[`bugs/closed`](bugs/closed), as `1234.v` where `1234` is the bug number. Files in this directory are tested for successful compilation. When you fix a bug, you should usually add a regression test here as well. -The error "(bug seems to be opened, please check)" when running `make test-suite` means that a test in `bugs/closed` failed to compile. +The error "(bug seems to be opened, please check)" when running +`make test-suite` means that a test in [`bugs/closed`](bugs/closed) failed to +compile. -There are also output tests in `test-suite/output` which consist of a `.v` file and a `.out` file with the expected output. +There are also output tests in [`output`](output) which consist of a `.v` file +and a `.out` file with the expected output. + +There are unit tests of OCaml code in [`unit-tests`](unit-tests). These tests +are contained in `.ml` files, and rely on the `OUnit` unit-test framework, as +described at <http://ounit.forge.ocamlcore.org/>. Use `make unit-tests` in the +[`unit-tests`](unit-tests) directory to run them. + +## Fixing output tests + +When an output test `output/foo.v` fails, the output is stored in +`output/foo.out.real`. Move that file to the reference file +`output/foo.out` to update the test, approving the new output. Target +`approve-output` will do this for all failing output tests +automatically. + +Don't forget to check the updated `.out` files into git! + +Note that `output/MExtraction.out` is special: it is copied from +[`micromega/micromega.ml`](../plugins/micromega/micromega.ml) in the plugin +source directory. Automatic approval will incorrectly update the copy. diff --git a/test-suite/bugs/closed/1341.v b/test-suite/bugs/closed/1341.v index 8c5a3885..79a0a14d 100644 --- a/test-suite/bugs/closed/1341.v +++ b/test-suite/bugs/closed/1341.v @@ -8,7 +8,7 @@ Hypothesis Xst : forall A, Equivalence (Xeq A). Variable map : forall A B, (A -> B) -> X A -> X B. -Implicit Arguments map [A B]. +Arguments map [A B]. Goal forall A B (a b:X (B -> A)) (c:X A) (f:A -> B -> A), Xeq _ a b -> Xeq _ b (map f c) -> Xeq _ a (map f c). intros A B a b c f Hab Hbc. diff --git a/test-suite/bugs/closed/1844.v b/test-suite/bugs/closed/1844.v index 17eeb352..c41e4590 100644 --- a/test-suite/bugs/closed/1844.v +++ b/test-suite/bugs/closed/1844.v @@ -5,7 +5,7 @@ Definition zeq := Z.eq_dec. Definition update (A: Set) (x: Z) (v: A) (s: Z -> A) : Z -> A := fun y => if zeq x y then v else s y. -Implicit Arguments update [A]. +Arguments update [A]. Definition ident := Z. Parameter operator: Set. diff --git a/test-suite/bugs/closed/1891.v b/test-suite/bugs/closed/1891.v index 68581117..5024a5bc 100644 --- a/test-suite/bugs/closed/1891.v +++ b/test-suite/bugs/closed/1891.v @@ -3,7 +3,7 @@ Definition f (A: Set) (l: T A): unit := tt. - Implicit Arguments f [A]. + Arguments f [A]. Lemma L (x: T unit): (unit -> T unit) -> unit. Proof. diff --git a/test-suite/bugs/closed/1951.v b/test-suite/bugs/closed/1951.v index 7558b0b8..e950554c 100644 --- a/test-suite/bugs/closed/1951.v +++ b/test-suite/bugs/closed/1951.v @@ -42,7 +42,7 @@ match s as a return (S a) with pair (ind2 a0) IHl) l) end. (* some induction principle *) -Implicit Arguments ind [S]. +Arguments ind [S]. Lemma k : a -> Type. (* some ininteresting lemma *) intro;pattern H;apply ind;intros. diff --git a/test-suite/bugs/closed/1981.v b/test-suite/bugs/closed/1981.v index 99952682..a3d94293 100644 --- a/test-suite/bugs/closed/1981.v +++ b/test-suite/bugs/closed/1981.v @@ -1,4 +1,4 @@ -Implicit Arguments ex_intro [A]. +Arguments ex_intro [A]. Goal exists n : nat, True. eapply ex_intro. exact 0. exact I. diff --git a/test-suite/bugs/closed/2362.v b/test-suite/bugs/closed/2362.v index febb9c7b..10e86cd1 100644 --- a/test-suite/bugs/closed/2362.v +++ b/test-suite/bugs/closed/2362.v @@ -8,7 +8,7 @@ Class Pointed (M:Type -> Type) := Unset Implicit Arguments. Inductive FPair (A B:Type) (neutral: B) : Type:= fpair : forall (a:A) (b:B), FPair A B neutral. -Implicit Arguments fpair [[A] [B] [neutral]]. +Arguments fpair {A B neutral}. Set Implicit Arguments. diff --git a/test-suite/bugs/closed/2378.v b/test-suite/bugs/closed/2378.v index 23a58501..b9dd6540 100644 --- a/test-suite/bugs/closed/2378.v +++ b/test-suite/bugs/closed/2378.v @@ -63,7 +63,7 @@ Fixpoint lpSat st f: Prop := end. End PropLogic. -Implicit Arguments lpSat. +Arguments lpSat : default implicits. Fixpoint LPTransfo Pred1 Pred2 p2lp (f: LP Pred1): LP Pred2 := match f with @@ -71,9 +71,9 @@ Fixpoint LPTransfo Pred1 Pred2 p2lp (f: LP Pred1): LP Pred2 := | LPAnd _ f1 f2 => LPAnd _ (LPTransfo Pred1 Pred2 p2lp f1) (LPTransfo Pred1 Pred2 p2lp f2) | LPNot _ f1 => LPNot _ (LPTransfo Pred1 Pred2 p2lp f1) end. -Implicit Arguments LPTransfo. +Arguments LPTransfo : default implicits. -Definition addIndex (Ind:Type) (Pred: Ind -> Type) (i: Ind) f := +Definition addIndex (Ind:Type) (Pred: Ind -> Type) (i: Ind) f := LPTransfo (fun p => LPPred _ (existT (fun i => Pred i) i p)) f. Section TTS. @@ -121,8 +121,8 @@ Record simu (Pred: Type) (a: TTS StateA) (c: TTS StateC) (tra: Pred -> LP (Predi Delay _ a (mabs m ex1 st1) d (mabs m (mDelay m ex1 st1 d) st2); simuNext: forall ex1 st1 st2, Next _ c st1 st2 -> inv ex1 st1 -> Next _ a (mabs m ex1 st1) (mabs m (mNext m ex1 st1) st2); - simuPred: forall ext st, inv ext st -> - (forall p, lpSat (Satisfy _ c) st (trc p) <-> lpSat (Satisfy _ a) (mabs m ext st) (tra p)) + simuPred: forall ext st, inv ext st -> + (forall p, lpSat (Satisfy _ c) st (trc p) <-> lpSat (Satisfy _ a) (mabs m ext st) (tra p)) }. Theorem satProd: forall State Ind Pred (Sat: forall i, State -> Pred i -> Prop) (st:State) i (f: LP (Pred i)), @@ -137,15 +137,15 @@ Qed. Definition trProd (State: Type) Ind (Pred: Ind -> Type) (tts: Ind -> TTS State) (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))): {i:Ind & Pred i} -> LP (Predicate _ (TTSIndexedProduct _ Ind tts)) := - fun p => addIndex Ind _ (projS1 p) (tr (projS1 p) (projS2 p)). + fun p => addIndex Ind _ (projT1 p) (tr (projT1 p) (projT2 p)). -Implicit Arguments trProd. +Arguments trProd : default implicits. Require Import Setoid. Theorem satTrProd: - forall State Ind Pred (tts: Ind -> TTS State) + forall State Ind Pred (tts: Ind -> TTS State) (tr: forall i, (Pred i) -> LP (Predicate _ (tts i))) (st:State) (p: {i:Ind & (Pred i)}), - lpSat (Satisfy _ (tts (projS1 p))) st (tr (projS1 p) (projS2 p)) + lpSat (Satisfy _ (tts (projT1 p))) st (tr (projT1 p) (projT2 p)) <-> lpSat (Satisfy _ (TTSIndexedProduct _ _ tts)) st (trProd _ tts tr p). Proof. @@ -154,11 +154,11 @@ Proof. (fun i => Satisfy _ (tts i))); tauto. Qed. -Theorem simuProd: - forall Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) +Theorem simuProd: + forall Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), - (forall i, simu _ (tta i) (ttc i) (tra i) (trc i)) -> + (forall i, simu _ (tta i) (ttc i) (tra i) (trc i)) -> simu _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) (trProd Pred tta tra) (trProd Pred ttc trc). Proof. @@ -171,11 +171,11 @@ Proof. eapply simuDelay; eauto. eapply simuNext; eauto. split; simpl; intros. - generalize (proj1 (simuPred _ _ _ _ _ (X (projS1 p)) ext st (H (projS1 p)) (projS2 p))); simpl; intro. + generalize (proj1 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. rewrite <- (satTrProd StateA Ind Pred tta tra); apply H1. rewrite (satTrProd StateC Ind Pred ttc trc); apply H0. - generalize (proj2 (simuPred _ _ _ _ _ (X (projS1 p)) ext st (H (projS1 p)) (projS2 p))); simpl; intro. + generalize (proj2 (simuPred _ _ _ _ _ (X (projT1 p)) ext st (H (projT1 p)) (projT2 p))); simpl; intro. rewrite <- (satTrProd StateC Ind Pred ttc trc); apply H1. rewrite (satTrProd StateA Ind Pred tta tra); apply H0. Qed. @@ -189,11 +189,11 @@ Record simu_equiv StateA StateC m1 m2 Pred (a: TTS StateA) (c: TTS StateC) (tra: simuRL: simu StateC StateA m2 Pred c a trc tra }. -Theorem simu_equivProd: - forall StateA StateC m1 m2 Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) +Theorem simu_equivProd: + forall StateA StateC m1 m2 Ind (Pred: Ind -> Type) (tta: Ind -> TTS StateA) (ttc: Ind -> TTS StateC) (tra: forall i, (Pred i) -> LP (Predicate _ (tta i))) (trc: forall i, (Pred i) -> LP (Predicate _ (ttc i))), - (forall i, simu_equiv StateA StateC m1 m2 _ (tta i) (ttc i) (tra i) (trc i)) -> + (forall i, simu_equiv StateA StateC m1 m2 _ (tta i) (ttc i) (tra i) (trc i)) -> simu_equiv StateA StateC m1 m2 _ (TTSIndexedProduct _ Ind tta) (TTSIndexedProduct _ Ind ttc) (trProd _ _ Pred tta tra) (trProd _ _ Pred ttc trc). Proof. @@ -237,7 +237,7 @@ Definition pPredicate (L: RTLanguage) (sys: PSyntax L) := { i : pIndex L sys & M (* product with shared state *) -Definition PLanguage (L: RTLanguage): RTLanguage := +Definition PLanguage (L: RTLanguage): RTLanguage := mkRTLanguage (PSyntax L) (pState L) @@ -246,7 +246,7 @@ Definition PLanguage (L: RTLanguage): RTLanguage := eq_refl => Semantic L (pComponents L mdl i) end)) (pPredicate L) - (fun mdl => trProd _ _ _ _ + (fun mdl => trProd _ _ _ _ (fun i pi => match pIsShared L mdl i as e in (_ = y) return (LP (Predicate y match e in (_ = y0) return (TTS y0) with @@ -259,22 +259,22 @@ Definition PLanguage (L: RTLanguage): RTLanguage := Inductive Empty: Type :=. Record isSharedTransfo l1 l2 tr: Prop := isSharedTransfoPrf { -sameState: forall mdl i j, +sameState: forall mdl i j, DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) = DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl j)); -sameMState: forall mdl i j, +sameMState: forall mdl i j, mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl i)) = mState _ _ (Tl1l2 _ _ tr (pComponents l1 mdl j)); -sameM12: forall mdl i j, +sameM12: forall mdl i j, Tl1l2 _ _ tr (pComponents l1 mdl i) = match sym_eq (sameState mdl i j) in _=y return mapping _ y with eq_refl => match sym_eq (pIsShared l1 mdl i) in _=x return mapping x _ with eq_refl => match pIsShared l1 mdl j in _=x return mapping x _ with eq_refl => Tl1l2 _ _ tr (pComponents l1 mdl j) end - end + end end; -sameM21: forall mdl i j, +sameM21: forall mdl i j, Tl2l1 l1 l2 tr (pComponents l1 mdl i) = match sym_eq (sameState mdl i j) in (_ = y) @@ -301,7 +301,7 @@ end Definition PTransfoSyntax l1 l2 tr (h: isSharedTransfo l1 l2 tr) mdl := mkPSyntax l2 (pIndex l1 mdl) (pIsEmpty l1 mdl) - (match pIsEmpty l1 mdl return Type with + (match pIsEmpty l1 mdl return Type with inleft i => DynamicState l2 (Tmodel l1 l2 tr (pComponents l1 mdl i)) |inright h => pState l1 mdl end) @@ -314,7 +314,7 @@ Definition PTransfoSyntax l1 l2 tr (h: isSharedTransfo l1 l2 tr) mdl := | inright _ => pState l1 mdl end) with - inleft j => sameState l1 l2 tr h mdl i j + inleft j => sameState l1 l2 tr h mdl i j | inright h => match h i with end end). @@ -388,12 +388,12 @@ match pIsEmpty l1 mdl with addIndex (pIndex l1 mdl) (fun i => MdlPredicate l2 (Tmodel l1 l2 tr (pComponents l1 mdl i))) x (LPTransfo (Tpred l1 l2 tr (pComponents l1 mdl x)) (LPPred (MdlPredicate l1 (pComponents l1 mdl x)) p)) -| inright f => match f (projS1 pp) with end +| inright f => match f (projT1 pp) with end end. -Lemma simu_eqA: +Lemma simu_eqA: forall A1 A2 C m P sa sc tta ttc (h: A2=A1), - simu A1 C (match h in (_=y) return mapping _ C with eq_refl => m end) + simu A1 C (match h in (_=y) return mapping _ C with eq_refl => m end) P (match h in (_=y) return TTS y with eq_refl => sa end) sc (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => tta p end) ttc -> @@ -401,9 +401,9 @@ Lemma simu_eqA: admit. Qed. -Lemma simu_eqC: +Lemma simu_eqC: forall A C1 C2 m P sa sc tta ttc (h: C2=C1), - simu A C1 (match h in (_=y) return mapping A _ with eq_refl => m end) + simu A C1 (match h in (_=y) return mapping A _ with eq_refl => m end) P sa (match h in (_=y) return TTS y with eq_refl => sc end) tta (fun p => match h in (_=y) return LP (Predicate y _) with eq_refl => ttc p end) -> @@ -411,10 +411,10 @@ Lemma simu_eqC: admit. Qed. -Lemma simu_eqA1: +Lemma simu_eqA1: forall A1 A2 C m P sa sc tta ttc (h: A1=A2), - simu A1 C m - P + simu A1 C m + P (match (sym_eq h) in (_=y) return TTS y with eq_refl => sa end) sc (fun p => match (sym_eq h) as e in (_=y) return LP (Predicate y (match e in (_=z) return TTS z with eq_refl => sa end)) with eq_refl => tta p end) ttc -> @@ -422,32 +422,32 @@ Lemma simu_eqA1: admit. Qed. -Lemma simu_eqA2: +Lemma simu_eqA2: forall A1 A2 C m P sa sc tta ttc (h: A1=A2), simu A1 C (match (sym_eq h) in (_=y) return mapping _ C with eq_refl => m end) - P + P sa sc tta ttc -> simu A2 C m P - (match h in (_=y) return TTS y with eq_refl => sa end) sc + (match h in (_=y) return TTS y with eq_refl => sa end) sc (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sa end) with eq_refl => tta p end) ttc. admit. Qed. -Lemma simu_eqC2: +Lemma simu_eqC2: forall A C1 C2 m P sa sc tta ttc (h: C1=C2), simu A C1 (match (sym_eq h) in (_=y) return mapping A _ with eq_refl => m end) - P + P sa sc tta ttc -> simu A C2 m P - sa (match h in (_=y) return TTS y with eq_refl => sc end) + sa (match h in (_=y) return TTS y with eq_refl => sc end) tta (fun p => match h as e in (_=y) return LP (Predicate y match e in (_=y0) return TTS y0 with eq_refl => sc end) with eq_refl => ttc p end). admit. Qed. -Lemma simu_eqM: +Lemma simu_eqM: forall A C m1 m2 P sa sc tta ttc (h: m1=m2), simu A C m1 P sa sc tta ttc -> @@ -470,7 +470,7 @@ Lemma LPTransfo_addIndex: addIndex Ind tr1 (projT1 p0) (tr2 (projT1 p0) (projT2 p0))) (addIndex Ind Pred x p). Proof. - unfold addIndex; intros. + unfold addIndex; intros. rewrite LPTransfo_trans. rewrite LPTransfo_trans. simpl. @@ -491,7 +491,7 @@ Lemma LPTransfo_addIndex_tr: addIndex Ind tr1 (projT1 p0) (tr3 (projT1 p0) (tr2 (projT1 p0) (projT2 p0)))) (addIndex Ind Pred x p). Proof. - unfold addIndex; simpl; intros. + unfold addIndex; simpl; intros. rewrite LPTransfo_trans; simpl. rewrite <- LPTransfo_trans. f_equal. @@ -505,19 +505,19 @@ Qed. Require Export Coq.Logic.FunctionalExtensionality. Print PLanguage. -Program Definition PTransfo l1 l2 (tr: Transformation l1 l2) (h: isSharedTransfo l1 l2 tr): +Program Definition PTransfo l1 l2 (tr: Transformation l1 l2) (h: isSharedTransfo l1 l2 tr): Transformation (PLanguage l1) (PLanguage l2) := mkTransformation (PLanguage l1) (PLanguage l2) (PTransfoSyntax l1 l2 tr h) (Pmap12 l1 l2 tr h) (Pmap21 l1 l2 tr h) (PTpred l1 l2 tr h) - (fun mdl => simu_equivProd - (pState l1 mdl) - (pState l2 (PTransfoSyntax l1 l2 tr h mdl)) + (fun mdl => simu_equivProd + (pState l1 mdl) + (pState l2 (PTransfoSyntax l1 l2 tr h mdl)) (Pmap12 l1 l2 tr h mdl) (Pmap21 l1 l2 tr h mdl) - (pIndex l1 mdl) + (pIndex l1 mdl) (fun i => MdlPredicate l1 (pComponents l1 mdl i)) (compSemantic l1 mdl) (compSemantic l2 (PTransfoSyntax l1 l2 tr h mdl)) diff --git a/test-suite/bugs/closed/2404.v b/test-suite/bugs/closed/2404.v index 8ac696e9..f6ec6760 100644 --- a/test-suite/bugs/closed/2404.v +++ b/test-suite/bugs/closed/2404.v @@ -22,13 +22,13 @@ Section Derived. Definition bexportw := exportw base. Definition bwweak := wweak base. - Implicit Arguments bexportw [a b]. + Arguments bexportw [a b]. Inductive RstarSetProof {I : Type} (T : I -> I -> Type) : I -> I -> Type := starReflS : forall a, RstarSetProof T a a | starTransS : forall i j k, T i j -> (RstarSetProof T j k) -> RstarSetProof T i k. -Implicit Arguments starTransS [I T i j k]. +Arguments starTransS [I T i j k]. Definition RstarInv {A : Set} (rel : relation A) : A -> A -> Type := (flip (RstarSetProof (flip rel))). diff --git a/test-suite/bugs/closed/2456.v b/test-suite/bugs/closed/2456.v index de28c7f4..e5a392c4 100644 --- a/test-suite/bugs/closed/2456.v +++ b/test-suite/bugs/closed/2456.v @@ -6,7 +6,7 @@ Parameter Patch : nat -> nat -> Set. Inductive Catch (from to : nat) : Type := MkCatch : forall (p : Patch from to), Catch from to. -Implicit Arguments MkCatch [from to]. +Arguments MkCatch [from to]. Inductive CatchCommute5 : forall {from mid1 mid2 to : nat}, diff --git a/test-suite/bugs/closed/2584.v b/test-suite/bugs/closed/2584.v index ef2e4e35..b5a723b4 100644 --- a/test-suite/bugs/closed/2584.v +++ b/test-suite/bugs/closed/2584.v @@ -8,7 +8,7 @@ Inductive res (A: Type) : Type := | OK: A -> res A | Error: err -> res A. -Implicit Arguments Error [A]. +Arguments Error [A]. Set Printing Universes. diff --git a/test-suite/bugs/closed/2667.v b/test-suite/bugs/closed/2667.v index 0631e535..0e6d0108 100644 --- a/test-suite/bugs/closed/2667.v +++ b/test-suite/bugs/closed/2667.v @@ -1,11 +1,11 @@ -(* Check that extra arguments to Arguments Scope do not disturb use of *) +(* Check that extra arguments to Arguments do not disturb use of *) (* scopes in constructors *) Inductive stmt : Type := Sskip: stmt | Scall : nat -> stmt. Bind Scope Cminor with stmt. (* extra argument is ok because of possible coercion to funclass *) -Arguments Scope Scall [_ Cminor ]. +Arguments Scall _ _%Cminor : extra scopes. (* extra argument is ok because of possible coercion to funclass *) Fixpoint f (c: stmt) : Prop := match c with Scall _ => False | _ => False end. diff --git a/test-suite/bugs/closed/2670.v b/test-suite/bugs/closed/2670.v index c401420e..791889b2 100644 --- a/test-suite/bugs/closed/2670.v +++ b/test-suite/bugs/closed/2670.v @@ -15,6 +15,14 @@ Proof. refine (match e return _ with refl_equal => _ end). reflexivity. Undo 2. + (** Check insensitivity to alphabetic order *) + refine (match e as a in _ = b return _ with refl_equal => _ end). + reflexivity. + Undo 2. + (** Check insensitivity to alphabetic order *) + refine (match e as z in _ = y return _ with refl_equal => _ end). + reflexivity. + Undo 2. (* Next line similarly has a dependent and a non dependent solution *) refine (match e with refl_equal => _ end). reflexivity. diff --git a/test-suite/bugs/closed/2729.v b/test-suite/bugs/closed/2729.v index 7929b881..c9d65c12 100644 --- a/test-suite/bugs/closed/2729.v +++ b/test-suite/bugs/closed/2729.v @@ -82,8 +82,8 @@ Inductive SequenceBase (pu : PatchUniverse) (p : pu_type from mid) (qs : SequenceBase pu mid to), SequenceBase pu from to. -Implicit Arguments Nil [pu cxt]. -Implicit Arguments Cons [pu from mid to]. +Arguments Nil [pu cxt]. +Arguments Cons [pu from mid to]. Program Fixpoint insertBase {pu : PatchUniverse} {from mid to : NameSet} diff --git a/test-suite/bugs/closed/2733.v b/test-suite/bugs/closed/2733.v index 832de4f9..24dd30b3 100644 --- a/test-suite/bugs/closed/2733.v +++ b/test-suite/bugs/closed/2733.v @@ -16,6 +16,21 @@ match k,l with |B,l' => Bcons true (Ncons 0 l') end. +(* At some time, the success of trullynul was dependent on the name of + the variables! *) + +Definition trullynul2 k {a} (l : alt_list k a) := +match k,l with + |N,l' => Ncons 0 (Bcons true l') + |B,l' => Bcons true (Ncons 0 l') +end. + +Definition trullynul3 k {z} (l : alt_list k z) := +match k,l with + |N,l' => Ncons 0 (Bcons true l') + |B,l' => Bcons true (Ncons 0 l') +end. + Fixpoint app (P : forall {k k'}, alt_list k k' -> alt_list k k') {t1 t2} (l : alt_list t1 t2) {struct l}: forall {t3}, alt_list t2 t3 -> alt_list t1 t3 := match l with diff --git a/test-suite/bugs/closed/2830.v b/test-suite/bugs/closed/2830.v index bb607b78..07a5cf91 100644 --- a/test-suite/bugs/closed/2830.v +++ b/test-suite/bugs/closed/2830.v @@ -49,9 +49,9 @@ Record ageable_facts (A:Type) (level: A -> nat) (age1:A -> option A) := ; af_level2 : forall x y, age1 x = Some y -> level x = S (level y) }. -Implicit Arguments af_unage [[A] [level] [age1]]. -Implicit Arguments af_level1 [[A] [level] [age1]]. -Implicit Arguments af_level2 [[A] [level] [age1]]. +Arguments af_unage {A level age1}. +Arguments af_level1 {A level age1}. +Arguments af_level2 {A level age1}. Class ageable (A:Type) := mkAgeable { level : A -> nat @@ -77,7 +77,7 @@ Coercion app_pred : pred >-> Funclass. Global Opaque pred. Definition derives {A} `{ageable A} (P Q:pred A) := forall a:A, P a -> Q a. -Implicit Arguments derives. +Arguments derives : default implicits. Program Definition andp {A} `{ageable A} (P Q:pred A) : pred A := fun a:A => P a /\ Q a. @@ -170,7 +170,7 @@ Class Functor `(C:Category) `(D:Category) (im : C -> D) := { fmap g ∘ fmap f ≈ fmap (g ∘ f) }. Coercion functor_im : Functor >-> Funclass. -Implicit Arguments fmap [Object Hom C Object0 Hom0 D im a b]. +Arguments fmap [Object Hom C Object0 Hom0 D im] _ [a b]. Add Parametric Morphism `(C:Category) `(D:Category) (Im:C->D) (F:Functor C D Im) (a b:C) : (@fmap _ _ C _ _ D Im F a b) diff --git a/test-suite/bugs/closed/2969.v b/test-suite/bugs/closed/2969.v index a03adbd7..7b1a2617 100644 --- a/test-suite/bugs/closed/2969.v +++ b/test-suite/bugs/closed/2969.v @@ -12,6 +12,7 @@ eexists. reflexivity. Grab Existential Variables. admit. +Admitted. (* Alternative variant which failed but without raising anomaly *) @@ -24,3 +25,4 @@ clearbody n n0. exact I. Grab Existential Variables. admit. +Admitted. diff --git a/test-suite/bugs/closed/3068.v b/test-suite/bugs/closed/3068.v index 79671ce9..9811733d 100644 --- a/test-suite/bugs/closed/3068.v +++ b/test-suite/bugs/closed/3068.v @@ -33,7 +33,7 @@ Section Counted_list. End Counted_list. -Implicit Arguments counted_def_nth [A n]. +Arguments counted_def_nth [A n]. Section Finite_nat_set. diff --git a/test-suite/bugs/closed/3377.v b/test-suite/bugs/closed/3377.v index 8e9e3933..abfcf1d3 100644 --- a/test-suite/bugs/closed/3377.v +++ b/test-suite/bugs/closed/3377.v @@ -5,6 +5,7 @@ Record prod A B := pair { fst : A; snd : B}. Goal fst (@pair Type Type Type Type). Set Printing All. match goal with |- ?f ?x => set (foo := f x) end. +Abort. Goal forall x : prod Set Set, x = @pair _ _ (fst x) (snd x). Proof. @@ -12,6 +13,6 @@ Proof. lazymatch goal with | [ |- ?x = @pair _ _ (?f ?x) (?g ?x) ] => pose f end. - (* Toplevel input, characters 7-44: Error: No matching clauses for match. *) +Abort. diff --git a/test-suite/bugs/closed/3513.v b/test-suite/bugs/closed/3513.v index 1f0f3b0d..a1d0b910 100644 --- a/test-suite/bugs/closed/3513.v +++ b/test-suite/bugs/closed/3513.v @@ -21,7 +21,7 @@ Section ILogic_Fun. Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. End ILogic_Fun. -Implicit Arguments ILFunFrm [[ILOps] [e]]. +Arguments ILFunFrm _ {e} _ {ILOps}. Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; ltrue := True; land P Q := P /\ Q; diff --git a/test-suite/bugs/closed/3647.v b/test-suite/bugs/closed/3647.v index f5a22bd5..e91c004c 100644 --- a/test-suite/bugs/closed/3647.v +++ b/test-suite/bugs/closed/3647.v @@ -26,7 +26,7 @@ Record morphism T T' `{e : type T} `{e' : type T'} := mkMorph { morph :> T -> T'; morph_resp : setoid_resp morph}. -Implicit Arguments mkMorph [T T' e e0 e' e1]. +Arguments mkMorph [T T' e0 e e1 e']. Infix "-s>" := morphism (at level 45, right associativity). Section Morphisms. Context {S T U V} `{eS : type S} `{eT : type T} `{eU : type U} `{eV : type V}. @@ -334,8 +334,8 @@ Section ILogic_Fun. End ILogic_Fun. -Implicit Arguments ILFunFrm [[ILOps] [e]]. -Implicit Arguments mkILFunFrm [T Frm ILOps]. +Arguments ILFunFrm _ {e} _ {ILOps}. +Arguments mkILFunFrm [T] _ [Frm ILOps]. Program Definition ILFun_eq {T R} {ILOps: ILogicOps R} {ILogic: ILogic R} (P : T -> R) : @ILFunFrm T _ R ILOps := diff --git a/test-suite/bugs/closed/3690.v b/test-suite/bugs/closed/3690.v index fa30132a..9273a20e 100644 --- a/test-suite/bugs/closed/3690.v +++ b/test-suite/bugs/closed/3690.v @@ -41,8 +41,5 @@ Type@{Top.34} -> Type@{Top.37} Top.36 < Top.34 Top.37 < Top.36 *) *) -Fail Check @qux@{Set Set}. -Check @qux@{Type Type Type Type}. -(* [qux] should only need two universes *) -Check @qux@{i j k l}. (* Error: The command has not failed!, but I think this is suboptimal *) -Fail Check @qux@{i j}. +Check @qux@{Type Type}. +(* used to have 4 universes *) diff --git a/test-suite/bugs/closed/3732.v b/test-suite/bugs/closed/3732.v index 09f1149c..13d62b8f 100644 --- a/test-suite/bugs/closed/3732.v +++ b/test-suite/bugs/closed/3732.v @@ -16,7 +16,7 @@ Section machine. | Inj : forall G, Prop -> propX G | ExistsX : forall G A, propX (A :: G) -> propX G. - Implicit Arguments Inj [G]. + Arguments Inj [G]. Definition PropX := propX nil. Fixpoint last (G : list Type) : Type. diff --git a/test-suite/bugs/closed/3956.v b/test-suite/bugs/closed/3956.v index 4957cc74..ac30fc73 100644 --- a/test-suite/bugs/closed/3956.v +++ b/test-suite/bugs/closed/3956.v @@ -129,13 +129,13 @@ Module Comodality_Theory (F : Comodality). := IdmapM FPM. Module cip_FPM := FPM.coindpathsM FPM cmpinv_o_cmp_M idmap_FPM. Module cip_FPHM <: HomotopyM FPM cmpM.PM cip_FPM.fhM cip_FPM.fkM. - Definition m : forall x, cip_FPM.fhM.m@{i j} x = cip_FPM.fkM.m@{i j} x. + Definition m : forall x, cip_FPM.fhM.m x = cip_FPM.fkM.m x. Proof. intros x. - refine (concat (cmpinvM.m_beta@{i j} (cmpM.m@{i j} x)) _). + refine (concat (cmpinvM.m_beta (cmpM.m x)) _). apply path_prod@{i i i}; simpl. - - exact (cmpM.FfstM.mM.m_beta@{i j} x). - - exact (cmpM.FsndM.mM.m_beta@{i j} x). + - exact (cmpM.FfstM.mM.m_beta x). + - exact (cmpM.FsndM.mM.m_beta x). Defined. End cip_FPHM. End isequiv_F_prod_cmp_M. diff --git a/test-suite/bugs/closed/4069.v b/test-suite/bugs/closed/4069.v index 606c6e08..668f6bb4 100644 --- a/test-suite/bugs/closed/4069.v +++ b/test-suite/bugs/closed/4069.v @@ -41,6 +41,8 @@ Proof. f_equal. 8.5: 2 goals, skipn n l = l -> k ++ skipn n l = skipn n l and skipn n l = l *) +Abort. + Require Import List. Fixpoint replicate {A} (n : nat) (x : A) : list A := match n with 0 => nil | S n => x :: replicate n x end. diff --git a/test-suite/bugs/closed/4095.v b/test-suite/bugs/closed/4095.v index 8d7dfbd4..bc9380f9 100644 --- a/test-suite/bugs/closed/4095.v +++ b/test-suite/bugs/closed/4095.v @@ -23,7 +23,7 @@ Section ILogic_Fun. Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. End ILogic_Fun. -Implicit Arguments ILFunFrm [[ILOps] [e]]. +Arguments ILFunFrm _ {e} _ {ILOps}. Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; ltrue := True; land P Q := P /\ Q; diff --git a/test-suite/bugs/closed/4132.v b/test-suite/bugs/closed/4132.v index 806ffb77..67ecc308 100644 --- a/test-suite/bugs/closed/4132.v +++ b/test-suite/bugs/closed/4132.v @@ -26,6 +26,6 @@ Qed. Lemma foo3 x y (b := 0) (H1 : x <= y) (H2 : y <= b) : x <= b. omega. (* Pierre L: according to a comment of bug report #4132, - this might have triggered "Failure(occurence 2)" in the past, + this might have triggered "Failure(occurrence 2)" in the past, but I never managed to reproduce that. *) Qed. diff --git a/test-suite/bugs/closed/4198.v b/test-suite/bugs/closed/4198.v index eb37141b..28800ac0 100644 --- a/test-suite/bugs/closed/4198.v +++ b/test-suite/bugs/closed/4198.v @@ -13,6 +13,7 @@ Goal forall A (x x' : A) (xs xs' : list A) (H : x::xs = x'::xs'), match goal with | [ |- context G[@hd] ] => idtac end. +Abort. (* This second example comes from CFGV where inspecting subterms of a match is expecting to inspect first the term to match (even though @@ -35,3 +36,4 @@ Ltac mydestruct := Goal forall x, match x with 0 => 0 | _ => 0 end = 0. intros. mydestruct. +Abort. diff --git a/test-suite/bugs/closed/4306.v b/test-suite/bugs/closed/4306.v index 28f028ad..80c348d2 100644 --- a/test-suite/bugs/closed/4306.v +++ b/test-suite/bugs/closed/4306.v @@ -1,13 +1,13 @@ Require Import List. Require Import Arith. -Require Import Recdef. +Require Import Recdef. Require Import Omega. Function foo (xys : (list nat * list nat)) {measure (fun xys => length (fst xys) + length (snd xys))} : list nat := match xys with | (nil, _) => snd xys | (_, nil) => fst xys - | (x :: xs', y :: ys') => match Compare_dec.nat_compare x y with + | (x :: xs', y :: ys') => match Nat.compare x y with | Lt => x :: foo (xs', y :: ys') | Eq => x :: foo (xs', ys') | Gt => y :: foo (x :: xs', ys') @@ -24,7 +24,7 @@ Function bar (xys : (list nat * list nat)) {measure (fun xys => length (fst xys) match (xs, ys) with | (nil, _) => ys | (_, nil) => xs - | (x :: xs', y :: ys') => match Compare_dec.nat_compare x y with + | (x :: xs', y :: ys') => match Nat.compare x y with | Lt => x :: foo (xs', ys) | Eq => x :: foo (xs', ys') | Gt => y :: foo (xs, ys') diff --git a/test-suite/bugs/closed/4527.v b/test-suite/bugs/closed/4527.v index 117d6523..f8cedfff 100644 --- a/test-suite/bugs/closed/4527.v +++ b/test-suite/bugs/closed/4527.v @@ -23,7 +23,9 @@ Module Export Datatypes. Set Implicit Arguments. Notation nat := Coq.Init.Datatypes.nat. +Notation O := Coq.Init.Datatypes.O. Notation S := Coq.Init.Datatypes.S. +Notation two := (S (S O)). Record prod (A B : Type) := pair { fst : A ; snd : B }. @@ -159,7 +161,7 @@ End Adjointify. (n : nat) {A : Type@{i}} {B : Type@{j}} (f : A -> B) (C : B -> Type@{k}) : Type@{l} := match n with - | 0 => Unit@{l} + | O => Unit@{l} | S n => (forall (g : forall a, C (f a)), ExtensionAlong@{i j k l l} f C g) * forall (h k : forall b, C b), @@ -220,12 +222,12 @@ Section ORecursion. Definition O_indpaths {P Q : Type} {Q_inO : In O Q} (g h : O P -> Q) (p : g o to O P == h o to O P) : g == h - := (fst (snd (extendable_to_O O 2) g h) p).1. + := (fst (snd (extendable_to_O O two) g h) p).1. Definition O_indpaths_beta {P Q : Type} {Q_inO : In O Q} (g h : O P -> Q) (p : g o (to O P) == h o (to O P)) (x : P) : O_indpaths g h p (to O P x) = p x - := (fst (snd (extendable_to_O O 2) g h) p).2 x. + := (fst (snd (extendable_to_O O two) g h) p).2 x. End ORecursion. diff --git a/test-suite/bugs/closed/4533.v b/test-suite/bugs/closed/4533.v index c3e0da11..fd2380a0 100644 --- a/test-suite/bugs/closed/4533.v +++ b/test-suite/bugs/closed/4533.v @@ -17,7 +17,10 @@ Notation "A -> B" := (forall (_ : A), B) : type_scope. Module Export Datatypes. Set Implicit Arguments. Notation nat := Coq.Init.Datatypes.nat. + Notation O := Coq.Init.Datatypes.O. Notation S := Coq.Init.Datatypes.S. + Notation one := (S O). + Notation two := (S one). Record prod (A B : Type) := pair { fst : A ; snd : B }. Notation "x * y" := (prod x y) : type_scope. Delimit Scope nat_scope with nat. @@ -109,7 +112,7 @@ Fixpoint ExtendableAlong@{i j k l} (n : nat) {A : Type@{i}} {B : Type@{j}} (f : A -> B) (C : B -> Type@{k}) : Type@{l} := match n with - | 0 => Unit@{l} + | O => Unit@{l} | S n => (forall (g : forall a, C (f a)), ExtensionAlong@{i j k l l} f C g) * forall (h k : forall b, C b), @@ -160,17 +163,17 @@ Module ReflectiveSubuniverses_Theory (Os : ReflectiveSubuniverses). Definition O_rec {P Q : Type} {Q_inO : In O Q} (f : P -> Q) : O P -> Q - := (fst (extendable_to_O O 1%nat) f).1. + := (fst (extendable_to_O O one) f).1. Definition O_rec_beta {P Q : Type} {Q_inO : In O Q} (f : P -> Q) (x : P) : O_rec f (to O P x) = f x - := (fst (extendable_to_O O 1%nat) f).2 x. + := (fst (extendable_to_O O one) f).2 x. Definition O_indpaths {P Q : Type} {Q_inO : In O Q} (g h : O P -> Q) (p : g o to O P == h o to O P) : g == h - := (fst (snd (extendable_to_O O 2) g h) p).1. + := (fst (snd (extendable_to_O O two) g h) p).1. End ORecursion. diff --git a/test-suite/bugs/closed/4544.v b/test-suite/bugs/closed/4544.v index 4ad53bc6..13c47edc 100644 --- a/test-suite/bugs/closed/4544.v +++ b/test-suite/bugs/closed/4544.v @@ -19,6 +19,7 @@ Inductive sum (A B : Type) : Type := | inl : A -> sum A B | inr : B -> sum A B. Notation nat := Coq.Init.Datatypes.nat. +Notation O := Coq.Init.Datatypes.O. Notation S := Coq.Init.Datatypes.S. Notation "x + y" := (sum x y) : type_scope. @@ -449,7 +450,7 @@ Section Extensions. (n : nat) {A : Type@{i}} {B : Type@{j}} (f : A -> B) (C : B -> Type@{k}) : Type@{l} := match n with - | 0 => Unit@{l} + | O => Unit@{l} | S n => (forall (g : forall a, C (f a)), ExtensionAlong@{i j k l l} f C g) * forall (h k : forall b, C b), diff --git a/test-suite/bugs/closed/4782.v b/test-suite/bugs/closed/4782.v index dbd71035..1e1a4cb9 100644 --- a/test-suite/bugs/closed/4782.v +++ b/test-suite/bugs/closed/4782.v @@ -6,6 +6,7 @@ Inductive p : Prop := consp : forall (e : r) (x : type e), cond e x -> p. Goal p. Fail apply consp with (fun _ : bool => mk_r unit (fun x => True)) nil. +Abort. (* A simplification of an example from coquelicot, which was failing at some time after a fix #4782 was committed. *) @@ -21,4 +22,5 @@ Set Typeclasses Debug. Goal forall (A:T) (x:dom A), pairT A A = pairT A A. intros. apply (F _ _) with (x,x). +Abort. diff --git a/test-suite/bugs/closed/4798.v b/test-suite/bugs/closed/4798.v index 6f2bcb96..41a1251c 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.6"). +Notation "|" := 1 (compat "8.7"). Check match 2 with 0 => 0 | S n => n end. (* fails *) diff --git a/test-suite/bugs/closed/4865.v b/test-suite/bugs/closed/4865.v index c5bf3289..da4e53aa 100644 --- a/test-suite/bugs/closed/4865.v +++ b/test-suite/bugs/closed/4865.v @@ -48,5 +48,5 @@ Fail Check g 0 0 1. (* 2nd 0 in bool *) Fixpoint arr n := match n with 0%nat => nat | S n => nat -> arr n end. Fixpoint lam n : arr n := match n with 0%nat => 0%nat | S n => fun x => lam n end. Notation "0" := true. -Arguments Scope lam [nat_scope nat_scope]. +Arguments lam _%nat_scope _%nat_scope : extra scopes. Check (lam 1 0). diff --git a/test-suite/bugs/closed/4882.v b/test-suite/bugs/closed/4882.v deleted file mode 100644 index 8c26af70..00000000 --- a/test-suite/bugs/closed/4882.v +++ /dev/null @@ -1,50 +0,0 @@ - -Definition Foo {T}{a : T} : T := a. - -Module A. - - Declare Implicit Tactic eauto. - - Goal forall A (x : A), A. - intros. - apply Foo. (* Check defined evars are normalized *) - (* Qed. *) - Abort. - -End A. - -Module B. - - Definition Foo {T}{a : T} : T := a. - - Declare Implicit Tactic eassumption. - - Goal forall A (x : A), A. - intros. - apply Foo. - (* Qed. *) - Abort. - -End B. - -Module C. - - Declare Implicit Tactic first [exact True|assumption]. - - Goal forall (x : True), True. - intros. - apply (@Foo _ _). - Qed. - -End C. - -Module D. - - Declare Implicit Tactic assumption. - - Goal forall A (x : A), A. - intros. - exact _. - Qed. - -End D. diff --git a/test-suite/bugs/closed/5012.v b/test-suite/bugs/closed/5012.v new file mode 100644 index 00000000..5326c0fb --- /dev/null +++ b/test-suite/bugs/closed/5012.v @@ -0,0 +1,17 @@ +Class Foo := { foo : Set }. + +Axiom admit : forall {T}, T. + +Global Instance Foo0 : Foo + := {| foo := admit |}. + +Global Instance Foo1 : Foo + := { foo := admit }. + +Existing Class Foo. + +Global Instance Foo2 : Foo + := { foo := admit }. (* Error: Unbound method name foo of class Foo. *) + +Set Warnings "+already-existing-class". +Fail Existing Class Foo. diff --git a/test-suite/bugs/closed/5500.v b/test-suite/bugs/closed/5500.v new file mode 100644 index 00000000..aa63e2ab --- /dev/null +++ b/test-suite/bugs/closed/5500.v @@ -0,0 +1,35 @@ +(* Too weak check on the correctness of return clause was leading to an anomaly *) + +Inductive Vector A: nat -> Type := + nil: Vector A O +| cons: forall n, A -> Vector A n -> Vector A (S n). + +(* This could be made working with a better inference of inner return + predicates from the return predicate at the higher level of the + nested matching. Currently, we only check that it does not raise an + anomaly, but eventually, the "Fail" could be removed. *) + +Fail Definition hd_fst A x n (v: A * Vector A (S n)) := + match v as v0 return match v0 with + (l, r) => + match r in Vector _ n return match n with 0 => Type | S _ => Type end with + nil _ => A + | cons _ _ _ _ => A + end + end with + (_, nil _) => x + | (_, cons _ n hd tl) => hd + end. + +(* This is another example of failure but involving beta-reduction and + not iota-reduction. Thus, for this one, I don't see how it could be + solved by small inversion, whatever smart is small inversion. *) + +Inductive A : (Type->Type) -> Type := J : A (fun x => x). + +Fail Check fun x : nat * A (fun x => x) => + match x return match x with + (y,z) => match z in A f return f Type with J => bool end + end with + (y,J) => true + end. diff --git a/test-suite/bugs/closed/5547.v b/test-suite/bugs/closed/5547.v new file mode 100644 index 00000000..79633f48 --- /dev/null +++ b/test-suite/bugs/closed/5547.v @@ -0,0 +1,16 @@ +(* Checking typability of intermediate return predicates in nested pattern-matching *) + +Inductive A : (Type->Type) -> Type := J : A (fun x => x). +Definition ret (x : nat * A (fun x => x)) + := match x return Type with + | (y,z) => match z in A f return f Type with + | J => bool + end + end. +Definition foo : forall x, ret x. +Proof. +Fail refine (fun x + => match x return ret x with + | (y,J) => true + end + ). diff --git a/test-suite/bugs/closed/5696.v b/test-suite/bugs/closed/5696.v new file mode 100644 index 00000000..a20ad1b4 --- /dev/null +++ b/test-suite/bugs/closed/5696.v @@ -0,0 +1,5 @@ +(* Slightly improving interpretation of Ltac subterms in notations *) + +Notation "'var2' x .. y = z ; e" := (ltac:(exact z), (fun x => .. (fun y => e) +..)) (at level 200, x binder, y binder, e at level 220). +Check (var2 a = 1; a). diff --git a/test-suite/bugs/closed/5719.v b/test-suite/bugs/closed/5719.v new file mode 100644 index 00000000..0fad5f54 --- /dev/null +++ b/test-suite/bugs/closed/5719.v @@ -0,0 +1,9 @@ +Axiom cons_data_one : + forall (Aone : unit -> Set) (i : unit) (a : Aone i), nat. +Axiom P : nat -> Prop. +Axiom children_data_rect3 : forall {Aone : unit -> Set} + (cons_one_case : forall (i : unit) (b : Aone i), + nat -> nat -> P (cons_data_one Aone i b)), + P 0. +Fail Definition decide_children_equality IH := children_data_rect3 + (fun _ '(existT _ _ _) => match IH with tt => _ end). diff --git a/test-suite/bugs/closed/7011.v b/test-suite/bugs/closed/7011.v new file mode 100644 index 00000000..296e4e11 --- /dev/null +++ b/test-suite/bugs/closed/7011.v @@ -0,0 +1,16 @@ +(* Fix and Cofix were missing in tactic unification *) + +Goal exists e, (fix foo (n : nat) : nat := match n with O => e | S n' => foo n' end) + = (fix foo (n : nat) : nat := match n with O => O | S n' => foo n' end). +Proof. + eexists. + reflexivity. +Qed. + +CoInductive stream := cons : nat -> stream -> stream. + +Goal exists e, (cofix foo := cons e foo) = (cofix foo := cons 0 foo). +Proof. + eexists. + reflexivity. +Qed. diff --git a/test-suite/bugs/closed/7068.v b/test-suite/bugs/closed/7068.v new file mode 100644 index 00000000..9fadb195 --- /dev/null +++ b/test-suite/bugs/closed/7068.v @@ -0,0 +1,6 @@ +(* These tests are only about a subset of #7068 *) +(* The original issue is still open *) + +Inductive foo : let T := Type in T := . +Definition bob1 := Eval vm_compute in foo_rect. +Definition bob2 := Eval native_compute in foo_rect. diff --git a/test-suite/bugs/closed/7076.v b/test-suite/bugs/closed/7076.v new file mode 100644 index 00000000..0abc88c2 --- /dev/null +++ b/test-suite/bugs/closed/7076.v @@ -0,0 +1,4 @@ +(* These calls were raising an anomaly at some time *) +Inductive A : nat -> id (nat->Type) := . +Eval vm_compute in fun x => match x in A y z return y = z with end. +Eval native_compute in fun x => match x in A y z return y = z with end. diff --git a/test-suite/bugs/closed/7092.v b/test-suite/bugs/closed/7092.v new file mode 100644 index 00000000..d90de8b9 --- /dev/null +++ b/test-suite/bugs/closed/7092.v @@ -0,0 +1,70 @@ +(* Examples matching fix/cofix in Ltac pattern-matching *) + +Goal True. +lazymatch (eval cbv delta [Nat.add] in Nat.add) with +| (fix F (n : nat) (v : ?A) {struct n} : @?P n v + := match n with + | O => @?O_case v + | S n' => @?S_case n' v F + end) + => + unify A nat; + unify P (fun _ _ : nat => nat); + unify O_case (fun v : nat => v); + unify S_case (fun (p : nat) (m : nat) (add : nat -> nat -> nat) + => S (add p m)) + end. +Abort. + +Fixpoint f l n := match n with 0 => 0 | S n => g n (cons n l) end +with g n l := match n with 0 => 1 | S n => f (cons 0 l) n end. + +Goal True. + +lazymatch (eval cbv delta [f] in f) with +| fix myf (l : ?L) (n : ?N) {struct n} : nat := + match n as _ with + | 0 => ?Z + | S n0 => @?S myf myg n0 l + end + with myg (n' : ?N') (l' : ?L') {struct n'} : nat := + match n' as _ with + | 0 => ?Z' + | S n0' => @?S' myf myg n0' l' + end + for myf => + unify L (list nat); + unify L' (list nat); + unify N nat; + unify N' nat; + unify Z 0; + unify Z' 1; + unify S (fun (f : L -> N -> nat) (g : N -> L -> nat) n l => g n (cons n l)); + unify S' (fun (f : L -> N -> nat) (g : N -> L -> nat) (n:N) l => f (cons 0 l) n) +end. + +Abort. + +CoInductive S1 := C1 : nat -> S2 -> S1 with S2 := C2 : bool -> S1 -> S2. + +CoFixpoint f' n l := C1 n (g' (cons n l) n n) +with g' l n p := C2 true (f' (S n) l). + +Goal True. + +lazymatch (eval cbv delta [f'] in f') with +| cofix myf (n : ?N) (l : ?L) : ?T := @?X n g l + with g (l' : ?L') (n' : ?N') (p' : ?N'') : ?T' := @?X' n' myf l' + for myf => + unify L (list nat); + unify L' (list nat); + unify N nat; + unify N' nat; + unify N'' nat; + unify T S1; + unify T' S2; + unify X (fun n g l => C1 n (g (cons n l) n n)); + unify X' (fun n f (l : list nat) => C2 true (f (S n) l)) +end. + +Abort. diff --git a/test-suite/bugs/closed/7421.v b/test-suite/bugs/closed/7421.v new file mode 100644 index 00000000..afcdd35f --- /dev/null +++ b/test-suite/bugs/closed/7421.v @@ -0,0 +1,39 @@ + + +Universe i j. + +Goal False. +Proof. + Check Type@{i} : Type@{j}. + Fail constr_eq_strict Type@{i} Type@{j}. + assert_succeeds constr_eq Type@{i} Type@{j}. (* <- i=j is forgotten after assert_succeeds *) + Fail constr_eq_strict Type@{i} Type@{j}. + + constr_eq Type@{i} Type@{j}. (* <- i=j is retained *) + constr_eq_strict Type@{i} Type@{j}. + Fail Check Type@{i} : Type@{j}. + + Fail constr_eq Prop Set. + Fail constr_eq Prop Type. + + Fail constr_eq_strict Type Type. + constr_eq Type Type. + + constr_eq_strict Set Set. + constr_eq Set Set. + constr_eq Prop Prop. + + let x := constr:(Type) in constr_eq_strict x x. + let x := constr:(Type) in constr_eq x x. + + Fail lazymatch type of prod with + | ?A -> ?B -> _ => constr_eq_strict A B + end. + lazymatch type of prod with + | ?A -> ?B -> _ => constr_eq A B + end. + lazymatch type of prod with + | ?A -> ?B -> ?C => constr_eq A C + end. + +Abort. diff --git a/test-suite/bugs/closed/7631.v b/test-suite/bugs/closed/7631.v index 34eb8b86..93aeb83e 100644 --- a/test-suite/bugs/closed/7631.v +++ b/test-suite/bugs/closed/7631.v @@ -7,6 +7,7 @@ Section Foo. Let bar := foo. Eval native_compute in bar. +Eval vm_compute in bar. End Foo. @@ -17,5 +18,6 @@ Module RelContext. Definition foo := true. Definition bar (x := foo) := Eval native_compute in x. +Definition barvm (x := foo) := Eval vm_compute in x. End RelContext. diff --git a/test-suite/bugs/closed/7900.v b/test-suite/bugs/closed/7900.v new file mode 100644 index 00000000..583ef0ef --- /dev/null +++ b/test-suite/bugs/closed/7900.v @@ -0,0 +1,53 @@ +Require Import Coq.Program.Program. +(* Set Universe Polymorphism. *) +Set Printing Universes. + +Axiom ALL : forall {T:Prop}, T. + +Inductive Expr : Set := E (a : Expr). + +Parameter Value : Set. + +Fixpoint eval (e: Expr): Value := + match e with + | E a => eval a + end. + +Class Quote (n: Value) : Set := + { quote: Expr + ; eval_quote: eval quote = n }. + +Program Definition quote_mult n + `{!Quote n} : Quote n := + {| quote := E (quote (n:=n)) |}. + +Set Printing Universes. +Next Obligation. +Proof. + Show Universes. + destruct Quote0 as [q eq]. + Show Universes. + rewrite <- eq. + clear n eq. + Show Universes. + apply ALL. + Show Universes. +Qed. +Print quote_mult_obligation_1. +(* quote_mult_obligation_1@{} = +let Top_internal_eq_rew_dep := + fun (A : Type@{Coq.Init.Logic.8}) (x : A) (P : forall a : A, x = a -> Type@{Top.5} (* <- XXX *)) + (f : P x eq_refl) (y : A) (e : x = y) => + match e as e0 in (_ = y0) return (P y0 e0) with + | eq_refl => f + end in +fun (n : Value) (Quote0 : Quote n) => +match Quote0 as q return (eval quote = n) with +| {| quote := q; eval_quote := eq0 |} => + Top_internal_eq_rew_dep Value (eval q) (fun (n0 : Value) (eq1 : eval q = n0) => eval quote = n0) + ALL n eq0 +end + : forall (n : Value) (Quote0 : Quote n), eval (E quote) = n + +quote_mult_obligation_1 is universe polymorphic +*) diff --git a/test-suite/bugs/closed/7903.v b/test-suite/bugs/closed/7903.v new file mode 100644 index 00000000..55c7ee99 --- /dev/null +++ b/test-suite/bugs/closed/7903.v @@ -0,0 +1,4 @@ +(* Slightly improving interpretation of Ltac subterms in notations *) + +Notation bar x f := (let z := ltac:(exact 1) in (fun x : nat => f)). +Check bar x (x + x). diff --git a/test-suite/bugs/closed/8081.v b/test-suite/bugs/closed/8081.v new file mode 100644 index 00000000..0f2501aa --- /dev/null +++ b/test-suite/bugs/closed/8081.v @@ -0,0 +1,4 @@ +Section foo. +End foo. +Section foo. +End foo. diff --git a/test-suite/bugs/closed/8106.v b/test-suite/bugs/closed/8106.v new file mode 100644 index 00000000..a711c5ad --- /dev/null +++ b/test-suite/bugs/closed/8106.v @@ -0,0 +1,4 @@ +(* Was raising an anomaly "already assigned a level" on the second line *) + +Notation "c1 ; c2" := (c1 + c2) (only printing, at level 76, right associativity, c1 at level 76, c2 at level 76). +Notation "c1 ; c2" := (c1 + c2) (only parsing, at level 76, right associativity, c2 at level 76). diff --git a/test-suite/bugs/closed/8126.v b/test-suite/bugs/closed/8126.v new file mode 100644 index 00000000..f52dfc6b --- /dev/null +++ b/test-suite/bugs/closed/8126.v @@ -0,0 +1,13 @@ +(* See also output test Notations4.v *) + +Inductive foo := tt. +Bind Scope foo_scope with foo. +Delimit Scope foo_scope with foo. +Notation "'HI'" := tt : foo_scope. +Definition myfoo (x : nat) (y : nat) (z : foo) := y. +Notation myfoo0 := (@myfoo 0). +Notation myfoo01 := (@myfoo0 1). +Check myfoo 0 1 HI. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo0 1 HI. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo01 tt. (* prints [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo01 HI. (* was failing *) diff --git a/test-suite/bugs/closed/8270.v b/test-suite/bugs/closed/8270.v new file mode 100644 index 00000000..f36f757f --- /dev/null +++ b/test-suite/bugs/closed/8270.v @@ -0,0 +1,15 @@ +(* Don't do zeta in cbn when not asked for *) + +Goal let x := 0 in + let y := x in + y = 0. + (* We use "cofix" as an example because there are obviously no + cofixpoints in sight. This problem arises with any set of + reduction flags (not including zeta where the lets are of course reduced away) *) + cbn cofix. + intro x. + unfold x at 1. (* Should succeed *) + Undo 2. + cbn zeta. + Fail unfold x at 1. +Abort. diff --git a/test-suite/bugs/closed/8553.v b/test-suite/bugs/closed/8553.v new file mode 100644 index 00000000..4a1afabe --- /dev/null +++ b/test-suite/bugs/closed/8553.v @@ -0,0 +1,7 @@ +(* Using tactic "change" under binders *) + +Definition add2 n := n +2. +Goal (fun n => n) = (fun n => n+2). +change (?n + 2) with (add2 n). +match goal with |- _ = (fun n => add2 n) => idtac end. (* To test the presence of add2 *) +Abort. diff --git a/test-suite/bugs/closed/8672.v b/test-suite/bugs/closed/8672.v new file mode 100644 index 00000000..66cd6dfa --- /dev/null +++ b/test-suite/bugs/closed/8672.v @@ -0,0 +1,5 @@ +(* Was generating a dangling "pat" variable at some time *) + +Notation "'plet' x := e 'in' t" := + ((fun H => let x := id H in t) e) (at level 0, x pattern). +Definition bla := plet (pair x y) := pair 1 2 in x. diff --git a/test-suite/bugs/closed/bug_8544.v b/test-suite/bugs/closed/bug_8544.v new file mode 100644 index 00000000..674d1125 --- /dev/null +++ b/test-suite/bugs/closed/bug_8544.v @@ -0,0 +1,6 @@ +Require Import ssreflect. +Goal True \/ True -> False. +Proof. +(* the following should fail: 2 subgoals, but only one intro pattern *) +Fail case => [a]. +Abort. diff --git a/test-suite/bugs/closed/bug_8755.v b/test-suite/bugs/closed/bug_8755.v new file mode 100644 index 00000000..cd5aee4f --- /dev/null +++ b/test-suite/bugs/closed/bug_8755.v @@ -0,0 +1,6 @@ + +Lemma f : Type. +Fail let i := ident:(i) in +let t := context i [Type] in +idtac. +Abort. diff --git a/test-suite/bugs/closed/bug_8794.v b/test-suite/bugs/closed/bug_8794.v new file mode 100644 index 00000000..5ff0b302 --- /dev/null +++ b/test-suite/bugs/closed/bug_8794.v @@ -0,0 +1,11 @@ +(* This used to raise an anomaly in 8.8 *) + +Inductive T := Tau (t : T). + +Notation idT t := (match t with Tau t => Tau t end). + +Lemma match_itree : forall (t : T), t = idT t. +Proof. destruct t; auto. Qed. + +Lemma what (k : unit -> T) : k tt = k tt. +Proof. rewrite match_itree. Abort. diff --git a/test-suite/bugs/closed/bug_8885.v b/test-suite/bugs/closed/bug_8885.v new file mode 100644 index 00000000..9d86c08d --- /dev/null +++ b/test-suite/bugs/closed/bug_8885.v @@ -0,0 +1,8 @@ +From Coq Require Import Cyclic31. + +Definition Nat `(int31) := nat. +Definition Zero (_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _: digits) := 0. + +Check (eq_refl (int31_rect Nat Zero 1) : 0 = 0). +Check (eq_refl (int31_rect Nat Zero 1) <: 0 = 0). +Check (eq_refl (int31_rect Nat Zero 1) <<: 0 = 0). diff --git a/test-suite/bugs/opened/3295.v b/test-suite/bugs/opened/3295.v index 2a156e33..c09649de 100644 --- a/test-suite/bugs/opened/3295.v +++ b/test-suite/bugs/opened/3295.v @@ -5,7 +5,7 @@ Class lops := lmk_ops { weq: relation car }. -Implicit Arguments car []. +Arguments car : clear implicits. Coercion car: lops >-> Sortclass. @@ -23,7 +23,7 @@ Class ops := mk_ops { dot: forall n m p, mor n m -> mor m p -> mor n p }. Coercion mor: ops >-> Funclass. -Implicit Arguments ob []. +Arguments ob : clear implicits. Instance dot_weq `{ops} n m p: Proper (weq ==> weq ==> weq) (dot n m p). Proof. diff --git a/test-suite/check b/test-suite/check deleted file mode 100755 index 3d14f6bc..00000000 --- a/test-suite/check +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh - -MAKE="${MAKE:=make}" - -${MAKE} clean > /dev/null 2>&1 -${MAKE} all > /dev/null 2>&1 -cat summary.log diff --git a/test-suite/complexity/injection.v b/test-suite/complexity/injection.v index 08f489d7..a76fa19d 100644 --- a/test-suite/complexity/injection.v +++ b/test-suite/complexity/injection.v @@ -47,7 +47,7 @@ Parameter mkJoinmap : forall (key: Type) (t: Type) (j: joinable t), joinmap key j. Parameter ADMIT: forall p: Prop, p. -Implicit Arguments ADMIT [p]. +Arguments ADMIT [p]. Module Share. Parameter jb : joinable bool. diff --git a/test-suite/coq-makefile/coqdoc1/run.sh b/test-suite/coq-makefile/coqdoc1/run.sh index dc5a500d..88237815 100755 --- a/test-suite/coq-makefile/coqdoc1/run.sh +++ b/test-suite/coq-makefile/coqdoc1/run.sh @@ -9,7 +9,15 @@ make html mlihtml make install DSTROOT="$PWD/tmp" make install-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual + +# to learn about <(cmd) see https://www.gnu.org/software/bash/manual/html_node/Process-Substitution.html +( + while IFS= read -r -d '' d + do + pushd "$d" >/dev/null && find . && popd >/dev/null + done < <(find tmp -name user-contrib -print0) +) | sort -u > actual + sort -u > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/coqdoc2/run.sh b/test-suite/coq-makefile/coqdoc2/run.sh index dc5a500d..5811dd17 100755 --- a/test-suite/coq-makefile/coqdoc2/run.sh +++ b/test-suite/coq-makefile/coqdoc2/run.sh @@ -9,7 +9,13 @@ make html mlihtml make install DSTROOT="$PWD/tmp" make install-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual +( + while IFS= read -r -d '' d + do + pushd "$d" >/dev/null && find . && popd >/dev/null + done < <(find tmp -name user-contrib -print0) +) | sort -u > actual + sort -u > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/findlib-package/run.sh b/test-suite/coq-makefile/findlib-package/run.sh index 5b24df63..5cab400c 100755 --- a/test-suite/coq-makefile/findlib-package/run.sh +++ b/test-suite/coq-makefile/findlib-package/run.sh @@ -7,7 +7,8 @@ export OCAMLPATH=$OCAMLPATH:$PWD/findlib if which cygpath 2>/dev/null; then # the only way I found to pass OCAMLPATH on win is to have it contain # only one entry - export OCAMLPATH=`cygpath -w $PWD/findlib` + OCAMLPATH=$(cygpath -w "$PWD"/findlib) + export OCAMLPATH fi make -C findlib/foo clean coq_makefile -f _CoqProject -o Makefile diff --git a/test-suite/coq-makefile/mlpack1/run.sh b/test-suite/coq-makefile/mlpack1/run.sh index 03df9cf0..bbd2fc46 100755 --- a/test-suite/coq-makefile/mlpack1/run.sh +++ b/test-suite/coq-makefile/mlpack1/run.sh @@ -8,7 +8,7 @@ make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib` && find .) | sort > actual +(cd "$(find tmp -name user-contrib)" && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/mlpack2/run.sh b/test-suite/coq-makefile/mlpack2/run.sh index 03df9cf0..bbd2fc46 100755 --- a/test-suite/coq-makefile/mlpack2/run.sh +++ b/test-suite/coq-makefile/mlpack2/run.sh @@ -8,7 +8,7 @@ make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib` && find .) | sort > actual +(cd "$(find tmp -name user-contrib)" && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/multiroot/run.sh b/test-suite/coq-makefile/multiroot/run.sh index d3bb5310..45bf1481 100755 --- a/test-suite/coq-makefile/multiroot/run.sh +++ b/test-suite/coq-makefile/multiroot/run.sh @@ -11,7 +11,12 @@ make html mlihtml make install DSTROOT="$PWD/tmp" make install-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual +( + while IFS= read -r -d '' d + do + pushd "$d" >/dev/null && find . && popd >/dev/null + done < <(find tmp -name user-contrib -print0) +) | sort -u > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/native1/run.sh b/test-suite/coq-makefile/native1/run.sh index 89bafe9a..8f9ab9a7 100755 --- a/test-suite/coq-makefile/native1/run.sh +++ b/test-suite/coq-makefile/native1/run.sh @@ -1,17 +1,17 @@ #!/usr/bin/env bash -NATIVECOMP=`grep "let no_native_compiler = false" ../../../config/coq_config.ml`||true -if [[ `which ocamlopt` && $NATIVECOMP ]]; then +NATIVECOMP=$(grep "let no_native_compiler = false" ../../../config/coq_config.ml)||true +if [[ $(which ocamlopt) && $NATIVECOMP ]]; then . ../template/init.sh - + coq_makefile -f _CoqProject -o Makefile cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib` && find .) | sort > actual +(cd "$(find tmp -name user-contrib)" && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/plugin1/run.sh b/test-suite/coq-makefile/plugin1/run.sh index 5433d9e9..1e2bd979 100755 --- a/test-suite/coq-makefile/plugin1/run.sh +++ b/test-suite/coq-makefile/plugin1/run.sh @@ -9,7 +9,7 @@ make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib` && find .) | sort > actual +(cd "$(find tmp -name user-contrib)" && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/plugin2/run.sh b/test-suite/coq-makefile/plugin2/run.sh index 5433d9e9..1e2bd979 100755 --- a/test-suite/coq-makefile/plugin2/run.sh +++ b/test-suite/coq-makefile/plugin2/run.sh @@ -9,7 +9,7 @@ make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib` && find .) | sort > actual +(cd "$(find tmp -name user-contrib)" && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/plugin3/run.sh b/test-suite/coq-makefile/plugin3/run.sh index 5433d9e9..1e2bd979 100755 --- a/test-suite/coq-makefile/plugin3/run.sh +++ b/test-suite/coq-makefile/plugin3/run.sh @@ -9,7 +9,7 @@ make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib` && find .) | sort > actual +(cd "$(find tmp -name user-contrib)" && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/quick2vo/run.sh b/test-suite/coq-makefile/quick2vo/run.sh index 9e681223..dda51dd2 100755 --- a/test-suite/coq-makefile/quick2vo/run.sh +++ b/test-suite/coq-makefile/quick2vo/run.sh @@ -1,11 +1,11 @@ #!/usr/bin/env bash -a=`uname` +a=$(uname) . ../template/init.sh coq_makefile -f _CoqProject -o Makefile # vio2vo is broken on Windows (#6720) -if [ "$a" = "Darwin" -o "$a" = "Linux" ]; then +if [ "$a" = "Darwin" ] || [ "$a" = "Linux" ]; then make quick2vo J=2 test -f theories/test.vo make validate diff --git a/test-suite/coq-makefile/template/init.sh b/test-suite/coq-makefile/template/init.sh index e19d168c..2e066d30 100755 --- a/test-suite/coq-makefile/template/init.sh +++ b/test-suite/coq-makefile/template/init.sh @@ -1,10 +1,11 @@ +#!/bin/sh . ../template/path-init.sh rm -rf _test mkdir _test find . -maxdepth 1 -not -name . -not -name _test -exec cp -r '{}' -t _test ';' -cd _test +cd _test || exit 1 mkdir -p src mkdir -p theories/sub diff --git a/test-suite/coq-makefile/template/path-init.sh b/test-suite/coq-makefile/template/path-init.sh index dd19ab2b..c79b5665 100755 --- a/test-suite/coq-makefile/template/path-init.sh +++ b/test-suite/coq-makefile/template/path-init.sh @@ -1,3 +1,4 @@ +#!/bin/sh set -e set -o pipefail diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh b/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh index a918cceb..9f3b648a 100755 --- a/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh +++ b/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh @@ -4,7 +4,8 @@ set -x set -e cd "$(dirname "${BASH_SOURCE[0]}")" -export COQLIB="$(cd ../../../.. && pwd)" +COQLIB="$(cd ../../../.. && pwd)" +export COQLIB -./001-correct-diff-sorting-order/run.sh || exit $? -./002-single-file-sorting/run.sh || exit $? +./001-correct-diff-sorting-order/run.sh +./002-single-file-sorting/run.sh diff --git a/test-suite/coq-makefile/timing/run.sh b/test-suite/coq-makefile/timing/run.sh index f0e036ee..78a3f7c6 100755 --- a/test-suite/coq-makefile/timing/run.sh +++ b/test-suite/coq-makefile/timing/run.sh @@ -62,16 +62,14 @@ TO_SED_IN_PER_LINE=( -e s'/ */ /g' # Sometimes 0 will show up as 0m00.s, sometimes it'll end up being more like 0m00.001s; we must strip out the spaces that result from left-aligning numbers of different widths based on how many digits Coq's [-time] gives ) -for ext in "" .desired; do - for file in time-of-build-before.log time-of-build-after.log time-of-build-both.log; do - cat ${file}${ext} | grep -v 'warning: undefined variable' | sed "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_FILE[@]}" > ${file}${ext}.processed - done -done for file in time-of-build-before.log time-of-build-after.log time-of-build-both.log; do - echo "cat $file" - cat "$file" - echo - diff -u $file.desired.processed $file.processed || exit $? + for ext in "" .desired; do + grep -v 'warning: undefined variable' < ${file}${ext} | sed "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_FILE[@]}" > ${file}${ext}.processed + done + echo "cat $file" + cat "$file" + echo + diff -u $file.desired.processed $file.processed || exit $? done cd ../per-file-before @@ -96,13 +94,12 @@ echo "cat A.v.timing.diff" cat A.v.timing.diff echo +file=A.v.timing.diff + for ext in "" .desired; do - for file in A.v.timing.diff; do - cat ${file}${ext} | sed "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_LINE[@]}" | sort > ${file}${ext}.processed - done -done -for file in A.v.timing.diff; do - diff -u $file.desired.processed $file.processed || exit $? + sed "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_LINE[@]}" < "${file}${ext}" | sort > "${file}${ext}.processed" done +diff -u "$file.desired.processed" "$file.processed" || exit $? + exit 0 diff --git a/test-suite/coq-makefile/uninstall1/run.sh b/test-suite/coq-makefile/uninstall1/run.sh index 5354f794..fc95d84b 100755 --- a/test-suite/coq-makefile/uninstall1/run.sh +++ b/test-suite/coq-makefile/uninstall1/run.sh @@ -11,7 +11,12 @@ make install-doc DSTROOT="$PWD/tmp" make uninstall DSTROOT="$PWD/tmp" make uninstall-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual +( + while IFS= read -r -d '' d + do + pushd "$d" >/dev/null && find . && popd >/dev/null + done < <(find tmp -name user-contrib -print0) +) | sort -u > actual sort -u > desired <<EOT . EOT diff --git a/test-suite/coq-makefile/uninstall2/run.sh b/test-suite/coq-makefile/uninstall2/run.sh index 5354f794..fc95d84b 100755 --- a/test-suite/coq-makefile/uninstall2/run.sh +++ b/test-suite/coq-makefile/uninstall2/run.sh @@ -11,7 +11,12 @@ make install-doc DSTROOT="$PWD/tmp" make uninstall DSTROOT="$PWD/tmp" make uninstall-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual +( + while IFS= read -r -d '' d + do + pushd "$d" >/dev/null && find . && popd >/dev/null + done < <(find tmp -name user-contrib -print0) +) | sort -u > actual sort -u > desired <<EOT . EOT diff --git a/test-suite/coq-makefile/vio2vo/run.sh b/test-suite/coq-makefile/vio2vo/run.sh index 85656da4..e555d62f 100755 --- a/test-suite/coq-makefile/vio2vo/run.sh +++ b/test-suite/coq-makefile/vio2vo/run.sh @@ -1,12 +1,12 @@ #!/usr/bin/env bash -a=`uname` +a=$(uname) . ../template/init.sh coq_makefile -f _CoqProject -o Makefile make quick # vio2vo is broken on Windows (#6720) -if [ "$a" = "Darwin" -o "$a" = "Linux" ]; then +if [ "$a" = "Darwin" ] || [ "$a" = "Linux" ]; then make vio2vo J=2 test -f theories/test.vo make validate diff --git a/test-suite/coqchk/bug_8655.v b/test-suite/coqchk/bug_8655.v new file mode 100644 index 00000000..06d08b20 --- /dev/null +++ b/test-suite/coqchk/bug_8655.v @@ -0,0 +1 @@ +Inductive IND2 (A:Type) (T:=fun _ : Type->Type => A) := CONS2 : IND2 A -> IND2 (T IND2). diff --git a/test-suite/coqchk/bug_8876.v b/test-suite/coqchk/bug_8876.v new file mode 100644 index 00000000..2d20511a --- /dev/null +++ b/test-suite/coqchk/bug_8876.v @@ -0,0 +1,19 @@ +(* -*- coq-prog-args: ("-noinit"); -*- *) +Require Import Coq.Init.Notations. + +Notation "x -> y" := (forall _ : x, y). + +Inductive eq {A:Type} (a:A) : A -> Prop := eq_refl : eq a a. + +Set Universe Polymorphism. +Set Polymorphic Inductive Cumulativity. +Set Printing Universes. + +(* Constructors for an inductive with indices *) +Module WithIndex. + Inductive foo@{i} : (Prop -> Prop) -> Prop := mkfoo: foo (fun x => x). + + Monomorphic Universes i j. + Monomorphic Constraint i < j. + Definition bar : eq mkfoo@{i} mkfoo@{j} := eq_refl _. +End WithIndex. diff --git a/test-suite/coqchk/bug_8881.v b/test-suite/coqchk/bug_8881.v new file mode 100644 index 00000000..dfc209b3 --- /dev/null +++ b/test-suite/coqchk/bug_8881.v @@ -0,0 +1,23 @@ + +(* Check use of equivalence on inductive types (bug #1242) *) + +Module Type ASIG. + Inductive t : Set := a | b : t. + Definition f := fun x => match x with a => true | b => false end. +End ASIG. + +Module Type BSIG. + Declare Module A : ASIG. + Definition f := fun x => match x with A.a => true | A.b => false end. +End BSIG. + +Module C (A : ASIG) (B : BSIG with Module A:=A). + + (* Check equivalence is considered in "case_info" *) + Lemma test : forall x, A.f x = B.f x. + Proof. + intro x. unfold B.f, A.f. + destruct x; reflexivity. + Qed. + +End C. diff --git a/test-suite/coqchk/include_primproj.v b/test-suite/coqchk/include_primproj.v new file mode 100644 index 00000000..804ba1d3 --- /dev/null +++ b/test-suite/coqchk/include_primproj.v @@ -0,0 +1,13 @@ +(* #7329 *) +Set Primitive Projections. + +Module M. + Module Bar. + Record Box := box { unbox : Type }. + + Axiom foo : Box. + Axiom baz : forall _ : unbox foo, unbox foo. + End Bar. +End M. + +Include M. diff --git a/test-suite/coqdoc/links.html.out b/test-suite/coqdoc/links.html.out index 5e4b676c..d2d4d5d7 100644 --- a/test-suite/coqdoc/links.html.out +++ b/test-suite/coqdoc/links.html.out @@ -60,32 +60,32 @@ Various checks for coqdoc <span class="id" title="keyword">Definition</span> <a name="f"><span class="id" title="definition">f</span></a> := <span class="id" title="keyword">∀</span> <span class="id" title="var">C</span>:<span class="id" title="keyword">Prop</span>, <a class="idref" href="Coqdoc.links.html#C"><span class="id" title="variable">C</span></a>.<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>).<br/> +<span class="id" title="keyword">Notation</span> <a name="f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#mult"><span class="id" title="abbreviation">mult</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>). +<span class="id" title="keyword">Notation</span> <a name="f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#mult"><span class="id" title="abbreviation">mult</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>). <br/> -<span class="id" title="keyword">Notation</span> <a name="6b97e27793a3d22f5c0d1dd63170fd68"><span class="id" title="notation">"</span></a>n ** m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> +<span class="id" title="keyword">Notation</span> <a name="f07b3676d96b68749d342542fd80e2b0"><span class="id" title="notation">"</span></a>n ** m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="3e01fbae4590c7b7699ff99ce61580e1"><span class="id" title="notation">"</span></a>n ▵ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> +<span class="id" title="keyword">Notation</span> <a name="a647c51c9816a1b44fcfa5312db8344a"><span class="id" title="notation">"</span></a>n ▵ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">"</span></a>n '_' ++ 'x' m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 3).<br/> +<span class="id" title="keyword">Notation</span> <a name="3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">"</span></a>n '_' ++ 'x' m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 3).<br/> <br/> -<span class="id" title="keyword">Inductive</span> <a name="eq"><span class="id" title="inductive">eq</span></a> (<span class="id" title="var">A</span>:<span class="id" title="keyword">Type</span>) (<span class="id" title="var">x</span>:<a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#d43e996736952df71ebeeae74d10a287"><span class="id" title="notation">→</span></a> <span class="id" title="keyword">Prop</span> := <a name="eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:></span></a><a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a><br/> +<span class="id" title="keyword">Inductive</span> <a name="eq"><span class="id" title="inductive">eq</span></a> (<span class="id" title="var">A</span>:<span class="id" title="keyword">Type</span>) (<span class="id" title="var">x</span>:<a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#1c93e43e07fbeaeb6a625cb6614beb5d"><span class="id" title="notation">→</span></a> <span class="id" title="keyword">Prop</span> := <a name="eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">:></span></a><a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a><br/> <br/> -<span class="id" title="keyword">where</span> <a name="8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">"</span></a>x = y :> A" := (@<a class="idref" href="Coqdoc.links.html#eq"><span class="id" title="inductive">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/> +<span class="id" title="keyword">where</span> <a name="b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">"</span></a>x = y :> A" := (@<a class="idref" href="Coqdoc.links.html#eq"><span class="id" title="inductive">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="eq0"><span class="id" title="definition">eq0</span></a> := 0 <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> 0 <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:></span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a name="eq0"><span class="id" title="definition">eq0</span></a> := 0 <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">=</span></a> 0 <a class="idref" href="Coqdoc.links.html#b8b2ebc8e1a8b9aa935c0702efb5dccf"><span class="id" title="notation">:></span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> -<span class="id" title="keyword">Notation</span> <a name="548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">"</span></a>( x # y ; .. ; z )" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> .. (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) .. <span class="id" title="var">z</span>).<br/> +<span class="id" title="keyword">Notation</span> <a name="2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">"</span></a>( x # y ; .. ; z )" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> .. (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) .. <span class="id" title="var">z</span>).<br/> <br/> -<span class="id" title="keyword">Definition</span> <a name="9f5a1d89cbd4d38f5e289576db7123d1"><span class="id" title="definition">b_α</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">(</span></a><a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">(</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">#</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">;</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">)</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">,</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">(</span></a>0 <a class="idref" href="Coqdoc.links.html#6b97e27793a3d22f5c0d1dd63170fd68"><span class="id" title="notation">**</span></a> 0<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">))</span></a>.<br/> +<span class="id" title="keyword">Definition</span> <a name="9f5a1d89cbd4d38f5e289576db7123d1"><span class="id" title="definition">b_α</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">(</span></a><a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">(</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">#</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">;</span></a>0<a class="idref" href="Coqdoc.links.html#2c0c193cd2aedf7ecdb713db64dbfce6"><span class="id" title="notation">)</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">,</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">(</span></a>0 <a class="idref" href="Coqdoc.links.html#f07b3676d96b68749d342542fd80e2b0"><span class="id" title="notation">**</span></a> 0<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e6756e10c36f149b18b4a8741ed83079"><span class="id" title="notation">))</span></a>.<br/> <br/> <span class="id" title="keyword">Notation</span> <a name="h"><span class="id" title="abbreviation">h</span></a> := <a class="idref" href="Coqdoc.links.html#a"><span class="id" title="definition">a</span></a>.<br/> @@ -97,7 +97,7 @@ Various checks for coqdoc <span class="id" title="keyword">Variables</span> <a name="test.b'"><span class="id" title="variable">b'</span></a> <a name="test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> - <span class="id" title="keyword">Notation</span> <a name="4ab0449b36c75cf94e08c5822ea83e3d"><span class="id" title="notation">"</span></a>n + m" := (<span class="id" title="var">n</span> <a class="idref" href="Coqdoc.links.html#3e01fbae4590c7b7699ff99ce61580e1"><span class="id" title="notation">▵</span></a> <span class="id" title="var">m</span>) : <span class="id" title="var">my_scope</span>.<br/> + <span class="id" title="keyword">Notation</span> <a name="2158f15740ce05a939b657be222c26d6"><span class="id" title="notation">"</span></a>n + m" := (<span class="id" title="var">n</span> <a class="idref" href="Coqdoc.links.html#a647c51c9816a1b44fcfa5312db8344a"><span class="id" title="notation">▵</span></a> <span class="id" title="var">m</span>) : <span class="id" title="var">my_scope</span>.<br/> <br/> <span class="id" title="keyword">Delimit</span> <span class="id" title="keyword">Scope</span> <span class="id" title="var">my_scope</span> <span class="id" title="keyword">with</span> <span class="id" title="var">my</span>.<br/> @@ -106,19 +106,19 @@ Various checks for coqdoc <span class="id" title="keyword">Notation</span> <a name="l"><span class="id" title="abbreviation">l</span></a> := 0.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="ab410a966ac148e9b78c65c6cdf301fd"><span class="id" title="definition">α</span></a> := (0 <a class="idref" href="Coqdoc.links.html#4ab0449b36c75cf94e08c5822ea83e3d"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#l"><span class="id" title="abbreviation">l</span></a>)%<span class="id" title="var">my</span>.<br/> + <span class="id" title="keyword">Definition</span> <a name="ab410a966ac148e9b78c65c6cdf301fd"><span class="id" title="definition">α</span></a> := (0 <a class="idref" href="Coqdoc.links.html#2158f15740ce05a939b657be222c26d6"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#l"><span class="id" title="abbreviation">l</span></a>)%<span class="id" title="var">my</span>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="a'"><span class="id" title="definition">a'</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test.b'"><span class="id" title="variable">b'</span></a><a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a>0<a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/> + <span class="id" title="keyword">Definition</span> <a name="a'"><span class="id" title="definition">a'</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test.b'"><span class="id" title="variable">b'</span></a><a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a>0<a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="c"><span class="id" title="definition">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">}+{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">}</span></a>.<br/> + <span class="id" title="keyword">Definition</span> <a name="c"><span class="id" title="definition">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">}+{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#87727981cdc1579fef00b9d9c1d3b9da"><span class="id" title="notation">}</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> := (1<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#b3eea360671e1b32b18a26e15b3aace3"><span class="id" title="notation">+</span></a>2)%<span class="id" title="var">nat</span>.<br/> + <span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> := (1<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a>2)%<span class="id" title="var">nat</span>.<br/> <br/> - <span class="id" title="keyword">Lemma</span> <a name="e"><span class="id" title="lemma">e</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#3dcaec3b772747610227247939f96b01"><span class="id" title="notation">+</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + <span class="id" title="keyword">Lemma</span> <a name="e"><span class="id" title="lemma">e</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#e03f39daf98516fa530d3f6f5a1b4d92"><span class="id" title="notation">+</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <span class="id" title="var">Admitted</span>.<br/> <br/> @@ -137,7 +137,7 @@ Various checks for coqdoc <span class="id" title="keyword">Variables</span> <a name="test2.test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> <br/> - <span class="id" title="keyword">Definition</span> <a name="a''"><span class="id" title="definition">a''</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test2.b'"><span class="id" title="variable">b'</span></a> <a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#O"><span class="id" title="constructor">O</span></a> <a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#test2.test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#b3eea360671e1b32b18a26e15b3aace3"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#h"><span class="id" title="abbreviation">h</span></a> 0.<br/> + <span class="id" title="keyword">Definition</span> <a name="a''"><span class="id" title="definition">a''</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test2.b'"><span class="id" title="variable">b'</span></a> <a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#O"><span class="id" title="constructor">O</span></a> <a class="idref" href="Coqdoc.links.html#f03f7a04ef75ff3ac66ca5c23554e52e"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#test2.test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#3dd9eae9daa65efe5444f5fc3529a2e7"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#0dacc1786c5ba797d47dd85006231633"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#h"><span class="id" title="abbreviation">h</span></a> 0.<br/> <br/> <span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test2.test"><span class="id" title="section">test</span></a>.<br/> diff --git a/test-suite/coqdoc/links.tex.out b/test-suite/coqdoc/links.tex.out index f42db99d..24f96ff1 100644 --- a/test-suite/coqdoc/links.tex.out +++ b/test-suite/coqdoc/links.tex.out @@ -51,34 +51,34 @@ Various checks for coqdoc \coqdockw{Definition} \coqdef{Coqdoc.links.f}{f}{\coqdocdefinition{f}} := \coqdockw{\ensuremath{\forall}} \coqdocvar{C}:\coqdockw{Prop}, \coqdocvariable{C}.\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x '++' x}{"}{"}n ++ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x '++' x}{"}{"}n ++ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x '++' x}{"}{"}n ++ m" := (\coqexternalref{mult}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{mult}} \coqdocvar{n} \coqdocvar{m}). \coqdocemptyline +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x '++' x}{"}{"}n ++ m" := (\coqexternalref{mult}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{mult}} \coqdocvar{n} \coqdocvar{m}). \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x '**' x}{"}{"}n ** m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x '**' x}{"}{"}n ** m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x 'xE2x96xB5' x}{"}{"}n ▵ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x 'xE2x96xB5' x}{"}{"}n ▵ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::x ''' ''' '++' 'x' x}{"}{"}n '\_' ++ 'x' m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 3).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::x ''' ''' '++' 'x' x}{"}{"}n '\_' ++ 'x' m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 3).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Inductive} \coqdef{Coqdoc.links.eq}{eq}{\coqdocinductive{eq}} (\coqdocvar{A}:\coqdockw{Type}) (\coqdocvar{x}:\coqdocvariable{A}) : \coqdocvar{A} \coqexternalref{:type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqdockw{Prop} := \coqdef{Coqdoc.links.eq refl}{eq\_refl}{\coqdocconstructor{eq\_refl}} : \coqdocvariable{x} \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{=}} \coqdocvariable{x} \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{:>}}\coqdocvariable{A}\coqdoceol +\coqdockw{Inductive} \coqdef{Coqdoc.links.eq}{eq}{\coqdocinductive{eq}} (\coqdocvar{A}:\coqdockw{Type}) (\coqdocvar{x}:\coqdocvariable{A}) : \coqdocvar{A} \coqexternalref{::type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqdockw{Prop} := \coqdef{Coqdoc.links.eq refl}{eq\_refl}{\coqdocconstructor{eq\_refl}} : \coqdocvariable{x} \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{=}} \coqdocvariable{x} \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{:>}}\coqdocvariable{A}\coqdoceol \coqdocnoindent \coqdoceol \coqdocnoindent -\coqdockw{where} \coqdef{Coqdoc.links.:type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqref{Coqdoc.links.eq}{\coqdocinductive{eq}} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol +\coqdockw{where} \coqdef{Coqdoc.links.::type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqref{Coqdoc.links.eq}{\coqdocinductive{eq}} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Definition} \coqdef{Coqdoc.links.eq0}{eq0}{\coqdocdefinition{eq0}} := 0 \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{=}} 0 \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{:>}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.eq0}{eq0}{\coqdocdefinition{eq0}} := 0 \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{=}} 0 \coqref{Coqdoc.links.::type scope:x '=' x ':>' x}{\coqdocnotation{:>}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Notation} \coqdef{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{"}{"}( x \# y ; .. ; z )" := (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} .. (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} \coqdocvar{x} \coqdocvar{y}) .. \coqdocvar{z}).\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{"}{"}( x \# y ; .. ; z )" := (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} .. (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} \coqdocvar{x} \coqdocvar{y}) .. \coqdocvar{z}).\coqdoceol \coqdocemptyline \coqdocnoindent -\coqdockw{Definition} \coqdef{Coqdoc.links.b xCExB1}{b\_α}{\coqdocdefinition{b\_α}} := \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{(}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{\#}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{;}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{)}} \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{,}} \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}0 \coqref{Coqdoc.links.::x '**' x}{\coqdocnotation{**}} 0\coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{))}}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.b xCExB1}{b\_α}{\coqdocdefinition{b\_α}} := \coqexternalref{::core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}\coqref{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{(}}0\coqref{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{\#}}0\coqref{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{;}}0\coqref{Coqdoc.links.:::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{)}} \coqexternalref{::core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{,}} \coqexternalref{::core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}0 \coqref{Coqdoc.links.:::x '**' x}{\coqdocnotation{**}} 0\coqexternalref{::core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{))}}.\coqdoceol \coqdocemptyline \coqdocnoindent \coqdockw{Notation} \coqdef{Coqdoc.links.h}{h}{\coqdocabbreviation{h}} := \coqref{Coqdoc.links.a}{\coqdocdefinition{a}}.\coqdoceol @@ -90,7 +90,7 @@ Various checks for coqdoc \coqdockw{Variables} \coqdef{Coqdoc.links.test.b'}{b'}{\coqdocvariable{b'}} \coqdef{Coqdoc.links.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Notation} \coqdef{Coqdoc.links.test.:my scope:x '+' x}{"}{"}n + m" := (\coqdocvar{n} \coqref{Coqdoc.links.::x 'xE2x96xB5' x}{\coqdocnotation{▵}} \coqdocvar{m}) : \coqdocvar{my\_scope}.\coqdoceol +\coqdockw{Notation} \coqdef{Coqdoc.links.test.::my scope:x '+' x}{"}{"}n + m" := (\coqdocvar{n} \coqref{Coqdoc.links.:::x 'xE2x96xB5' x}{\coqdocnotation{▵}} \coqdocvar{m}) : \coqdocvar{my\_scope}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} \coqdockw{Delimit} \coqdockw{Scope} \coqdocvar{my\_scope} \coqdockw{with} \coqdocvar{my}.\coqdoceol @@ -99,19 +99,19 @@ Various checks for coqdoc \coqdockw{Notation} \coqdef{Coqdoc.links.l}{l}{\coqdocabbreviation{l}} := 0.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.xCExB1}{α}{\coqdocdefinition{α}} := (0 \coqref{Coqdoc.links.test.:my scope:x '+' x}{\coqdocnotation{+}} \coqref{Coqdoc.links.l}{\coqdocabbreviation{l}})\%\coqdocvar{my}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.xCExB1}{α}{\coqdocdefinition{α}} := (0 \coqref{Coqdoc.links.test.::my scope:x '+' x}{\coqdocnotation{+}} \coqref{Coqdoc.links.l}{\coqdocabbreviation{l}})\%\coqdocvar{my}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.a'}{a'}{\coqdocdefinition{a'}} \coqdocvar{b} := \coqdocvariable{b'}\coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}}0\coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}}\coqdocvariable{b2} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.a'}{a'}{\coqdocdefinition{a'}} \coqdocvar{b} := \coqdocvariable{b'}\coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}}0\coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}}\coqdocvariable{b2} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.c}{c}{\coqdocdefinition{c}} := \coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}+\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}}}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.c}{c}{\coqdocdefinition{c}} := \coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}+\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{::type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}}}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.d}{d}{\coqdocdefinition{d}} := (1\coqexternalref{:nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}}2)\%\coqdocvar{nat}.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.d}{d}{\coqdocdefinition{d}} := (1\coqexternalref{::nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}}2)\%\coqdocvar{nat}.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} -\coqdockw{Lemma} \coqdef{Coqdoc.links.e}{e}{\coqdoclemma{e}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}} \coqexternalref{:type scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{+}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdockw{Lemma} \coqdef{Coqdoc.links.e}{e}{\coqdoclemma{e}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}} \coqexternalref{::type scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{+}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocindent{2.00em} \coqdocvar{Admitted}.\coqdoceol \coqdocemptyline @@ -131,7 +131,7 @@ Various checks for coqdoc \coqdockw{Variables} \coqdef{Coqdoc.links.test2.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol \coqdocemptyline \coqdocindent{3.00em} -\coqdockw{Definition} \coqdef{Coqdoc.links.a''}{a'{}'}{\coqdocdefinition{a'{}'}} \coqdocvar{b} := \coqdocvariable{b'} \coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}} \coqexternalref{O}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{O}} \coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}} \coqdocvariable{b2} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b} \coqexternalref{:nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.links.h}{\coqdocabbreviation{h}} 0.\coqdoceol +\coqdockw{Definition} \coqdef{Coqdoc.links.a''}{a'{}'}{\coqdocdefinition{a'{}'}} \coqdocvar{b} := \coqdocvariable{b'} \coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}} \coqexternalref{O}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{O}} \coqref{Coqdoc.links.:::x '++' x}{\coqdocnotation{++}} \coqdocvariable{b2} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.:::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b} \coqexternalref{::nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.links.h}{\coqdocabbreviation{h}} 0.\coqdoceol \coqdocemptyline \coqdocindent{2.00em} \coqdockw{End} \coqref{Coqdoc.links.test2.test}{\coqdocsection{test}}.\coqdoceol diff --git a/test-suite/failure/check.v b/test-suite/failure/check.v index a148ebe8..0ef4b417 100644 --- a/test-suite/failure/check.v +++ b/test-suite/failure/check.v @@ -1,3 +1,3 @@ -Implicit Arguments eq [A]. +Arguments eq [A]. Fail Check (bool = true). diff --git a/test-suite/ide/undo012.fake b/test-suite/ide/undo012.fake index b3d1c6d5..c95df1b1 100644 --- a/test-suite/ide/undo012.fake +++ b/test-suite/ide/undo012.fake @@ -3,6 +3,7 @@ # # Test backtracking in presence of nested proofs # +ADD { Set Nested Proofs Allowed. } ADD { Lemma aa : True -> True /\ True. } ADD { intro H. } ADD { split. } diff --git a/test-suite/ide/undo013.fake b/test-suite/ide/undo013.fake index 921a9d0f..a3ccefd2 100644 --- a/test-suite/ide/undo013.fake +++ b/test-suite/ide/undo013.fake @@ -4,6 +4,7 @@ # Test backtracking in presence of nested proofs # Second, trigger the undo of an inner proof # +ADD { Set Nested Proofs Allowed. } ADD { Lemma aa : True -> True /\ True. } ADD { intro H. } ADD { split. } diff --git a/test-suite/ide/undo014.fake b/test-suite/ide/undo014.fake index f5fe7747..13e71822 100644 --- a/test-suite/ide/undo014.fake +++ b/test-suite/ide/undo014.fake @@ -4,6 +4,7 @@ # Test backtracking in presence of nested proofs # Third, undo inside an inner proof # +ADD { Set Nested Proofs Allowed. } ADD { Lemma aa : True -> True /\ True. } ADD { intro H. } ADD { split. } diff --git a/test-suite/ide/undo015.fake b/test-suite/ide/undo015.fake index a1e5c947..9cbd6446 100644 --- a/test-suite/ide/undo015.fake +++ b/test-suite/ide/undo015.fake @@ -4,6 +4,7 @@ # Test backtracking in presence of nested proofs # Fourth, undo from an inner proof to a above proof # +ADD { Set Nested Proofs Allowed. } ADD { Lemma aa : True -> True /\ True. } ADD { intro H. } ADD { split. } diff --git a/test-suite/ide/undo016.fake b/test-suite/ide/undo016.fake index f9414c1e..15bd3cc9 100644 --- a/test-suite/ide/undo016.fake +++ b/test-suite/ide/undo016.fake @@ -4,6 +4,7 @@ # Test backtracking in presence of nested proofs # Fifth, undo from an inner proof to a previous inner proof # +ADD { Set Nested Proofs Allowed. } ADD { Lemma aa : True -> True /\ True. } ADD { intro H. } ADD { split. } diff --git a/test-suite/interactive/PrimNotation.v b/test-suite/interactive/PrimNotation.v new file mode 100644 index 00000000..07986b0d --- /dev/null +++ b/test-suite/interactive/PrimNotation.v @@ -0,0 +1,64 @@ +(* Until recently, the Notation.declare_numeral_notation wasn't synchronized + w.r.t. backtracking. This should be ok now. + This test is pretty artificial (we must declare Z_scope for this to work). +*) + +Delimit Scope Z_scope with Z. +Open Scope Z_scope. +Check let v := 0 in v : nat. +(* let v := 0 in v : nat : nat *) +Require BinInt. +Check let v := 0 in v : BinNums.Z. +(* let v := 0 in v : BinNums.Z : BinNums.Z *) +Back 2. +Check let v := 0 in v : nat. +(* Expected answer: let v := 0 in v : nat : nat *) +(* Used to fail with: +Error: Cannot interpret in Z_scope without requiring first module BinNums. +*) + +Local Set Universe Polymorphism. +Delimit Scope punit_scope with punit. +Delimit Scope pcunit_scope with pcunit. +Delimit Scope int_scope with int. +Numeral Notation Decimal.int Decimal.int_of_int Decimal.int_of_int : int_scope. +Module A. + NonCumulative Inductive punit@{u} : Type@{u} := ptt. + Cumulative Inductive pcunit@{u} : Type@{u} := pctt. + Definition to_punit : Decimal.int -> option punit + := fun v => match v with 0%int => Some ptt | _ => None end. + Definition to_pcunit : Decimal.int -> option pcunit + := fun v => match v with 0%int => Some pctt | _ => None end. + Definition of_punit : punit -> Decimal.uint := fun _ => Nat.to_uint 0. + Definition of_pcunit : pcunit -> Decimal.uint := fun _ => Nat.to_uint 0. + Numeral Notation punit to_punit of_punit : punit_scope. + Check let v := 0%punit in v : punit. + Back 2. + Numeral Notation pcunit to_pcunit of_pcunit : punit_scope. + Check let v := 0%punit in v : pcunit. +End A. +Reset A. +Local Unset Universe Polymorphism. +Module A. + Inductive punit : Set := ptt. + Definition to_punit : Decimal.int -> option punit + := fun v => match v with 0%int => Some ptt | _ => None end. + Definition of_punit : punit -> Decimal.uint := fun _ => Nat.to_uint 0. + Numeral Notation punit to_punit of_punit : punit_scope. + Check let v := 0%punit in v : punit. +End A. +Local Set Universe Polymorphism. +Inductive punit@{u} : Type@{u} := ptt. +Definition to_punit : Decimal.int -> option punit + := fun v => match v with 0%int => Some ptt | _ => None end. +Definition of_punit : punit -> Decimal.uint := fun _ => Nat.to_uint 0. +Numeral Notation punit to_punit of_punit : punit_scope. +Check let v := 0%punit in v : punit. +Back 6. (* check backtracking of registering universe polymorphic constants *) +Local Unset Universe Polymorphism. +Inductive punit : Set := ptt. +Definition to_punit : Decimal.int -> option punit + := fun v => match v with 0%int => Some ptt | _ => None end. +Definition of_punit : punit -> Decimal.uint := fun _ => Nat.to_uint 0. +Numeral Notation punit to_punit of_punit : punit_scope. +Check let v := 0%punit in v : punit. diff --git a/test-suite/misc/7595.sh b/test-suite/misc/7595.sh new file mode 100755 index 00000000..836e354e --- /dev/null +++ b/test-suite/misc/7595.sh @@ -0,0 +1,5 @@ +#!/bin/sh +set -e + +$coqc -R misc/7595 Test misc/7595/base.v +$coqc -R misc/7595 Test misc/7595/FOO.v diff --git a/test-suite/misc/7595/FOO.v b/test-suite/misc/7595/FOO.v new file mode 100644 index 00000000..30c957d3 --- /dev/null +++ b/test-suite/misc/7595/FOO.v @@ -0,0 +1,39 @@ +Require Import Test.base. + +Lemma dec_stable `{Decision P} : ¬¬P → P. +Proof. firstorder. Qed. + +(** The tactic [destruct_decide] destructs a sumbool [dec]. If one of the +components is double negated, it will try to remove the double negation. *) +Tactic Notation "destruct_decide" constr(dec) "as" ident(H) := + destruct dec as [H|H]; + try match type of H with + | ¬¬_ => apply dec_stable in H + end. +Tactic Notation "destruct_decide" constr(dec) := + let H := fresh in destruct_decide dec as H. + + +(** * Monadic operations *) +Instance option_guard: MGuard option := λ P dec A f, + match dec with left H => f H | _ => None end. + +(** * Tactics *) +Tactic Notation "case_option_guard" "as" ident(Hx) := + match goal with + | H : context C [@mguard option _ ?P ?dec] |- _ => + change (@mguard option _ P dec) with (λ A (f : P → option A), + match @decide P dec with left H' => f H' | _ => None end) in *; + destruct_decide (@decide P dec) as Hx + | |- context C [@mguard option _ ?P ?dec] => + change (@mguard option _ P dec) with (λ A (f : P → option A), + match @decide P dec with left H' => f H' | _ => None end) in *; + destruct_decide (@decide P dec) as Hx + end. +Tactic Notation "case_option_guard" := + let H := fresh in case_option_guard as H. + +(* This proof failed depending on the name of the module. *) +Lemma option_guard_True {A} P `{Decision P} (mx : option A) : + P → (guard P; mx) = mx. +Proof. intros. case_option_guard. reflexivity. contradiction. Qed. diff --git a/test-suite/misc/7595/base.v b/test-suite/misc/7595/base.v new file mode 100644 index 00000000..6a6b7b79 --- /dev/null +++ b/test-suite/misc/7595/base.v @@ -0,0 +1,28 @@ +From Coq Require Export Morphisms RelationClasses List Bool Utf8 Setoid. +Set Default Proof Using "Type". +Export ListNotations. +From Coq.Program Require Export Basics Syntax. +Global Generalizable All Variables. + +(** * Type classes *) +(** ** Decidable propositions *) +(** This type class by (Spitters/van der Weegen, 2011) collects decidable +propositions. *) +Class Decision (P : Prop) := decide : {P} + {¬P}. +Hint Mode Decision ! : typeclass_instances. +Arguments decide _ {_} : simpl never, assert. + +(** ** Proof irrelevant types *) +(** This type class collects types that are proof irrelevant. That means, all +elements of the type are equal. We use this notion only used for propositions, +but by universe polymorphism we can generalize it. *) +Class ProofIrrel (A : Type) : Prop := proof_irrel (x y : A) : x = y. +Hint Mode ProofIrrel ! : typeclass_instances. + +Class MGuard (M : Type → Type) := + mguard: ∀ P {dec : Decision P} {A}, (P → M A) → M A. +Arguments mguard _ _ _ !_ _ _ / : assert. +Notation "'guard' P ; z" := (mguard P (λ _, z)) + (at level 20, z at level 200, only parsing, right associativity) . +Notation "'guard' P 'as' H ; z" := (mguard P (λ H, z)) + (at level 20, z at level 200, only parsing, right associativity) . diff --git a/test-suite/misc/7704.sh b/test-suite/misc/7704.sh new file mode 100755 index 00000000..0ca2c97d --- /dev/null +++ b/test-suite/misc/7704.sh @@ -0,0 +1,7 @@ +#!/usr/bin/env bash + +set -e + +export PATH=$BIN:$PATH + +${coqtop#"$BIN"} -compile misc/aux7704.v diff --git a/test-suite/misc/aux7704.v b/test-suite/misc/aux7704.v new file mode 100644 index 00000000..6fdcf676 --- /dev/null +++ b/test-suite/misc/aux7704.v @@ -0,0 +1,6 @@ + +Goal True /\ True. +Proof. + split. + par:exact I. +Qed. diff --git a/test-suite/misc/deps-checksum.sh b/test-suite/misc/deps-checksum.sh index e07612b8..a15a8fbe 100755 --- a/test-suite/misc/deps-checksum.sh +++ b/test-suite/misc/deps-checksum.sh @@ -1,3 +1,4 @@ +#!/bin/sh rm -f misc/deps/A/*.vo misc/deps/B/*.vo $coqc -R misc/deps/A A misc/deps/A/A.v $coqc -R misc/deps/B A misc/deps/B/A.v diff --git a/test-suite/misc/deps-order.sh b/test-suite/misc/deps-order.sh index 299f4946..6bb2ba2d 100755 --- a/test-suite/misc/deps-order.sh +++ b/test-suite/misc/deps-order.sh @@ -1,17 +1,18 @@ +#!/bin/sh # Check that both coqdep and coqtop/coqc supports -R # Check that both coqdep and coqtop/coqc takes the later -R # See bugs 2242, 2337, 2339 rm -f misc/deps/lib/*.vo misc/deps/client/*.vo -tmpoutput=`mktemp /tmp/coqcheck.XXXXXX` -$coqdep -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/bar.v 2>&1 | head -n 1 > $tmpoutput -diff -u --strip-trailing-cr misc/deps/deps.out $tmpoutput 2>&1 +tmpoutput=$(mktemp /tmp/coqcheck.XXXXXX) +$coqdep -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/bar.v 2>&1 | head -n 1 > "$tmpoutput" +diff -u --strip-trailing-cr misc/deps/deps.out "$tmpoutput" 2>&1 R=$? times $coqc -R misc/deps/lib lib misc/deps/lib/foo.v 2>&1 $coqc -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/foo.v 2>&1 $coqtop -R misc/deps/lib lib -R misc/deps/client client -load-vernac-source misc/deps/client/bar.v 2>&1 S=$? -if [ $R = 0 -a $S = 0 ]; then +if [ $R = 0 ] && [ $S = 0 ]; then printf "coqdep and coqtop agree\n" exit 0 else diff --git a/test-suite/misc/deps-utf8.sh b/test-suite/misc/deps-utf8.sh index 13e264c0..acb45b22 100755 --- a/test-suite/misc/deps-utf8.sh +++ b/test-suite/misc/deps-utf8.sh @@ -1,15 +1,16 @@ +#!/bin/sh # Check reading directories matching non pure ascii idents # See bug #5715 (utf-8 working on macos X and linux) # Windows is still not compliant -a=`uname` -if [ "$a" = "Darwin" -o "$a" = "Linux" ]; then +a=$(uname) +if [ "$a" = "Darwin" ] || [ "$a" = "Linux" ]; then rm -f misc/deps/théorèmes/*.v -tmpoutput=`mktemp /tmp/coqcheck.XXXXXX` +tmpoutput=$(mktemp /tmp/coqcheck.XXXXXX) $coqc -R misc/deps AlphaBêta misc/deps/αβ/γδ.v R=$? $coqtop -R misc/deps AlphaBêta -load-vernac-source misc/deps/αβ/εζ.v S=$? -if [ $R = 0 -a $S = 0 ]; then +if [ $R = 0 ] && [ $S = 0 ]; then exit 0 else exit 1 diff --git a/test-suite/misc/exitstatus.sh b/test-suite/misc/exitstatus.sh index cea1de86..a327f424 100755 --- a/test-suite/misc/exitstatus.sh +++ b/test-suite/misc/exitstatus.sh @@ -1,7 +1,8 @@ +#!/bin/sh $coqtop -load-vernac-source misc/exitstatus/illtyped.v N=$? $coqc misc/exitstatus/illtyped.v P=$? -printf "On ill-typed input, coqtop returned $N.\n" -printf "On ill-typed input, coqc returned $P.\n" -if [ $N = 1 -a $P = 1 ]; then exit 0; else exit 1; fi +printf "On ill-typed input, coqtop returned %s.\n" "$N" +printf "On ill-typed input, coqc returned %s.\n" "$P" +if [ $N = 1 ] && [ $P = 1 ]; then exit 0; else exit 1; fi diff --git a/test-suite/misc/poly-capture-global-univs.sh b/test-suite/misc/poly-capture-global-univs.sh new file mode 100755 index 00000000..e066ac03 --- /dev/null +++ b/test-suite/misc/poly-capture-global-univs.sh @@ -0,0 +1,19 @@ +#!/usr/bin/env bash + +set -e + +export COQBIN=$BIN +export PATH=$COQBIN:$PATH + +cd misc/poly-capture-global-univs/ + +coq_makefile -f _CoqProject -o Makefile + +make clean + +make src/evil_plugin.cmxs + +if make; then + >&2 echo 'Should have failed!' + exit 1 +fi diff --git a/test-suite/misc/poly-capture-global-univs/_CoqProject b/test-suite/misc/poly-capture-global-univs/_CoqProject new file mode 100644 index 00000000..70ec2460 --- /dev/null +++ b/test-suite/misc/poly-capture-global-univs/_CoqProject @@ -0,0 +1,9 @@ +-Q theories Evil +-I src + +src/evil.ml4 +src/evilImpl.ml +src/evilImpl.mli +src/evil_plugin.mlpack +theories/evil.v + diff --git a/test-suite/misc/poly-capture-global-univs/src/evil.ml4 b/test-suite/misc/poly-capture-global-univs/src/evil.ml4 new file mode 100644 index 00000000..565e979a --- /dev/null +++ b/test-suite/misc/poly-capture-global-univs/src/evil.ml4 @@ -0,0 +1,9 @@ + +open Stdarg +open EvilImpl + +DECLARE PLUGIN "evil_plugin" + +VERNAC COMMAND FUNCTIONAL EXTEND VernacEvil CLASSIFIED AS SIDEFF +| [ "Evil" ident(x) ident(y) ] -> [ fun ~atts ~st -> evil x y; st ] +END diff --git a/test-suite/misc/poly-capture-global-univs/src/evilImpl.ml b/test-suite/misc/poly-capture-global-univs/src/evilImpl.ml new file mode 100644 index 00000000..6d8ce7c5 --- /dev/null +++ b/test-suite/misc/poly-capture-global-univs/src/evilImpl.ml @@ -0,0 +1,22 @@ +open Names + +let evil t f = + let open Univ in + let open Entries in + let open Decl_kinds in + let open Constr in + let k = IsDefinition Definition in + let u = Level.var 0 in + let tu = mkType (Universe.make u) in + let te = Declare.definition_entry + ~univs:(Monomorphic_const_entry (ContextSet.singleton u)) tu + in + let tc = Declare.declare_constant t (DefinitionEntry te, k) in + let tc = mkConst tc in + + let fe = Declare.definition_entry + ~univs:(Polymorphic_const_entry (UContext.make (Instance.of_array [|u|],Constraint.empty))) + ~types:(Term.mkArrow tc tu) + (mkLambda (Name.Name (Id.of_string "x"), tc, mkRel 1)) + in + ignore (Declare.declare_constant f (DefinitionEntry fe, k)) diff --git a/test-suite/misc/poly-capture-global-univs/src/evilImpl.mli b/test-suite/misc/poly-capture-global-univs/src/evilImpl.mli new file mode 100644 index 00000000..97c7e3da --- /dev/null +++ b/test-suite/misc/poly-capture-global-univs/src/evilImpl.mli @@ -0,0 +1,2 @@ + +val evil : Names.Id.t -> Names.Id.t -> unit diff --git a/test-suite/misc/poly-capture-global-univs/src/evil_plugin.mlpack b/test-suite/misc/poly-capture-global-univs/src/evil_plugin.mlpack new file mode 100644 index 00000000..0093328a --- /dev/null +++ b/test-suite/misc/poly-capture-global-univs/src/evil_plugin.mlpack @@ -0,0 +1,2 @@ +EvilImpl +Evil diff --git a/test-suite/misc/poly-capture-global-univs/theories/evil.v b/test-suite/misc/poly-capture-global-univs/theories/evil.v new file mode 100644 index 00000000..7fd98c27 --- /dev/null +++ b/test-suite/misc/poly-capture-global-univs/theories/evil.v @@ -0,0 +1,13 @@ + +Declare ML Module "evil_plugin". + +Evil T f. (* <- if this doesn't fail then the rest goes through *) + +Definition g : Type -> Set := f. + +Require Import Hurkens. + +Lemma absurd : False. +Proof. + exact (TypeNeqSmallType.paradox (g Type) eq_refl). +Qed. diff --git a/test-suite/misc/printers.sh b/test-suite/misc/printers.sh index 28e7dc36..ef3f056d 100755 --- a/test-suite/misc/printers.sh +++ b/test-suite/misc/printers.sh @@ -1,3 +1,2 @@ -printf "Drop. #use\"include\";; #quit;;\n" | $coqtopbyte 2>&1 | egrep "Error|Unbound" -if [ $? = 0 ]; then exit 1; else exit 0; fi - +#!/bin/sh +if printf "Drop. #use\"include\";; #quit;;\n" | $coqtopbyte 2>&1 | grep -E "Error|Unbound" ; then exit 1; else exit 0; fi diff --git a/test-suite/misc/universes.sh b/test-suite/misc/universes.sh index d87a8603..ef61ca62 100755 --- a/test-suite/misc/universes.sh +++ b/test-suite/misc/universes.sh @@ -1,8 +1,9 @@ +#!/bin/sh # Sort universes for the whole standard library EXPECTED_UNIVERSES=4 # Prop is not counted $coqc -R misc/universes Universes misc/universes/all_stdlib 2>&1 $coqc -R misc/universes Universes misc/universes/universes 2>&1 mv universes.txt misc/universes -N=`awk '{print $3}' misc/universes/universes.txt | sort -u | wc -l` -printf "Found %s/%s universes\n" $N $EXPECTED_UNIVERSES +N=$(awk '{print $3}' misc/universes/universes.txt | sort -u | wc -l) +printf "Found %s/%s universes\n" "$N" "$EXPECTED_UNIVERSES" if [ "$N" -eq $EXPECTED_UNIVERSES ]; then exit 0; else exit 1; fi diff --git a/test-suite/modules/PO.v b/test-suite/modules/PO.v index 8ba8525c..be331049 100644 --- a/test-suite/modules/PO.v +++ b/test-suite/modules/PO.v @@ -1,8 +1,8 @@ Set Implicit Arguments. Unset Strict Implicit. -Implicit Arguments fst. -Implicit Arguments snd. +Arguments fst : default implicits. +Arguments snd : default implicits. Module Type PO. Parameter T : Set. diff --git a/test-suite/modules/Przyklad.v b/test-suite/modules/Przyklad.v index 7214287a..ece1b47b 100644 --- a/test-suite/modules/Przyklad.v +++ b/test-suite/modules/Przyklad.v @@ -1,7 +1,7 @@ Definition ifte (T : Set) (A B : Prop) (s : {A} + {B}) (th el : T) := if s then th else el. -Implicit Arguments ifte. +Arguments ifte : default implicits. Lemma Reflexivity_provable : forall (A : Set) (a : A) (s : {a = a} + {a <> a}), diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out index e73312c6..c0b04eb5 100644 --- a/test-suite/output/Arguments_renaming.out +++ b/test-suite/output/Arguments_renaming.out @@ -1,6 +1,5 @@ The command has indeed failed with message: -To rename arguments the "rename" flag must be specified. -Argument A renamed to B. +Flag "rename" expected to rename A into B. File "stdin", line 2, characters 0-25: Warning: This command is just asserting the names of arguments of identity. If this is what you want add ': assert' to silence the warning. If you want @@ -113,5 +112,4 @@ Argument z cannot be declared implicit. The command has indeed failed with message: Extra arguments: y. The command has indeed failed with message: -To rename arguments the "rename" flag must be specified. -Argument A renamed to R. +Flag "rename" expected to rename A into R. diff --git a/test-suite/output/BadOptionValueType.out b/test-suite/output/BadOptionValueType.out new file mode 100644 index 00000000..34d8518a --- /dev/null +++ b/test-suite/output/BadOptionValueType.out @@ -0,0 +1,8 @@ +The command has indeed failed with message: +Bad type of value for this option: expected int, got string. +The command has indeed failed with message: +Bad type of value for this option: expected bool, got string. +The command has indeed failed with message: +Bad type of value for this option: expected bool, got int. +The command has indeed failed with message: +Bad type of value for this option: expected bool, got int. diff --git a/test-suite/output/BadOptionValueType.v b/test-suite/output/BadOptionValueType.v new file mode 100644 index 00000000..b61c3757 --- /dev/null +++ b/test-suite/output/BadOptionValueType.v @@ -0,0 +1,4 @@ +Fail Set Default Timeout "2". +Fail Set Debug Eauto "yes". +Fail Set Debug Eauto 1. +Fail Set Implicit Arguments 1. diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out index 419dcadb..dfab400b 100644 --- a/test-suite/output/Cases.out +++ b/test-suite/output/Cases.out @@ -169,3 +169,5 @@ fun x : K => match x with | _ => 2 end : K -> nat +The command has indeed failed with message: +Pattern "S _, _" is redundant in this clause. diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v index caf3b287..e4fa7044 100644 --- a/test-suite/output/Cases.v +++ b/test-suite/output/Cases.v @@ -163,6 +163,7 @@ match goal with |- ?y + _ = _ => pose (match y as y with 0 => 0 | S n => 0 end) match goal with |- ?y + _ = _ => pose (match y as y return y=y with 0 => eq_refl | S n => eq_refl end) end. match goal with |- ?y + _ = _ => pose (match y return y=y with 0 => eq_refl | S n => eq_refl end) end. Show. +Abort. Lemma lem5 (p:nat) : eq_refl p = eq_refl p. let y := fresh "n" in (* Checking that y is hidden *) @@ -216,3 +217,6 @@ Check fun x => match x with a3 | a4 => 3 | _ => 2 end. Check fun x => match x with a3 => 3 | a2 | a1 => 4 | _ => 2 end. Check fun x => match x with a4 => 3 | a2 | a1 => 4 | _ => 2 end. Check fun x => match x with a3 | a4 | a1 => 3 | _ => 2 end. + +(* Test redundant clause within a disjunctive pattern *) +Fail Check fun n m => match n, m with 0, 0 | _, S _ | S 0, _ | S (S _ | _), _ => false end. diff --git a/test-suite/output/Deprecation.out b/test-suite/output/Deprecation.out new file mode 100644 index 00000000..7e290847 --- /dev/null +++ b/test-suite/output/Deprecation.out @@ -0,0 +1,3 @@ +File "stdin", line 5, characters 0-3: +Warning: Tactic foo is deprecated since X.Y. Use idtac instead. +[deprecated-tactic,deprecated] diff --git a/test-suite/output/Deprecation.v b/test-suite/output/Deprecation.v new file mode 100644 index 00000000..04d5eb3d --- /dev/null +++ b/test-suite/output/Deprecation.v @@ -0,0 +1,6 @@ +#[deprecated(since = "X.Y", note = "Use idtac instead.")] + Ltac foo := idtac. + +Goal True. +foo. +Abort. diff --git a/test-suite/output/Errors.out b/test-suite/output/Errors.out index 38d055b2..24180c45 100644 --- a/test-suite/output/Errors.out +++ b/test-suite/output/Errors.out @@ -8,3 +8,11 @@ Unable to unify "nat" with "True". The command has indeed failed with message: Ltac call to "instantiate ( (ident) := (lglob) )" failed. Instance is not well-typed in the environment of ?x. +The command has indeed failed with message: +Cannot infer the domain of the type of f. +The command has indeed failed with message: +Cannot infer the domain of the implicit parameter A of id whose type is +"Type". +The command has indeed failed with message: +Cannot infer the codomain of the type of f in environment: +x : nat diff --git a/test-suite/output/Errors.v b/test-suite/output/Errors.v index 424d2480..c9b50913 100644 --- a/test-suite/output/Errors.v +++ b/test-suite/output/Errors.v @@ -25,3 +25,9 @@ eexists ?[x]. destruct H1 as [x1 H1]. Fail instantiate (x:=projT1 x1). Abort. + +(* Test some messages for non solvable evars *) + +Fail Goal forall a f, f a = 0. +Fail Goal forall f x, id f x = 0. +Fail Goal forall f P, P (f 0). diff --git a/test-suite/output/Notations.out b/test-suite/output/Notations.out index b60b1ee8..94b86fc2 100644 --- a/test-suite/output/Notations.out +++ b/test-suite/output/Notations.out @@ -125,13 +125,15 @@ s : nat fun _ : nat => 9 : nat -> nat -fun (x : nat) (p : x = x) => match p with - | ONE => ONE - end = p +fun (x : nat) (p : x = x) => +match p in (_ = n) return (n = n) with +| ONE => ONE +end = p : forall x : nat, x = x -> Prop -fun (x : nat) (p : x = x) => match p with - | 1 => 1 - end = p +fun (x : nat) (p : x = x) => +match p in (_ = n) return (n = n) with +| 1 => 1 +end = p : forall x : nat, x = x -> Prop bar 0 : nat diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out index 5ab61616..d32cf67e 100644 --- a/test-suite/output/Notations3.out +++ b/test-suite/output/Notations3.out @@ -246,3 +246,9 @@ Notation ============================ ##@% ^^^ +myfoo01 tt + : nat +myfoo01 tt + : nat +myfoo01 tt + : nat diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v index 876aaa39..180e8d33 100644 --- a/test-suite/output/Notations3.v +++ b/test-suite/output/Notations3.v @@ -399,3 +399,14 @@ Show. Abort. End Issue7731. + +Module Issue8126. + +Definition myfoo (x : nat) (y : nat) (z : unit) := y. +Notation myfoo0 := (@myfoo 0). +Notation myfoo01 := (@myfoo0 1). +Check myfoo 0 1 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo0 1 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) +Check myfoo01 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) + +End Issue8126. diff --git a/test-suite/output/Notations4.out b/test-suite/output/Notations4.out new file mode 100644 index 00000000..46784d18 --- /dev/null +++ b/test-suite/output/Notations4.out @@ -0,0 +1,19 @@ +[< 0 > + < 1 > * < 2 >] + : nat +[< b > + < b > * < 2 >] + : nat +[<< # 0 >>] + : option nat +[1 {f 1}] + : Expr +fun (x : nat) (y z : Expr) => [1 + y z + {f x}] + : nat -> Expr -> Expr -> Expr +fun e : Expr => +match e with +| [x y + z] => [x + y z] +| [1 + 1] => [1] +| _ => [e + e] +end + : Expr -> Expr +[(1 + 1)] + : Expr diff --git a/test-suite/output/Notations4.v b/test-suite/output/Notations4.v new file mode 100644 index 00000000..6bdbf1be --- /dev/null +++ b/test-suite/output/Notations4.v @@ -0,0 +1,72 @@ +(* An example with constr subentries *) + +Module A. + +Declare Custom Entry myconstr. + +Notation "[ x ]" := x (x custom myconstr at level 6). +Notation "x + y" := (Nat.add x y) (in custom myconstr at level 5). +Notation "x * y" := (Nat.mul x y) (in custom myconstr at level 4). +Notation "< x >" := x (in custom myconstr at level 3, x constr at level 10). +Check [ < 0 > + < 1 > * < 2 >]. + +Axiom a : nat. +Notation b := a. +Check [ < b > + < a > * < 2 >]. + +Declare Custom Entry anotherconstr. + +Notation "[ x ]" := x (x custom myconstr at level 6). +Notation "<< x >>" := x (in custom myconstr at level 3, x custom anotherconstr at level 10). +Notation "# x" := (Some x) (in custom anotherconstr at level 8, x constr at level 9). +Check [ << # 0 >> ]. + +End A. + +Module B. + +Inductive Expr := + | Mul : Expr -> Expr -> Expr + | Add : Expr -> Expr -> Expr + | One : Expr. + +Declare Custom Entry expr. +Notation "[ expr ]" := expr (expr custom expr at level 2). +Notation "1" := One (in custom expr at level 0). +Notation "x y" := (Mul x y) (in custom expr at level 1, left associativity). +Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). +Notation "( x )" := x (in custom expr at level 0, x at level 2). +Notation "{ x }" := x (in custom expr at level 0, x constr). +Notation "x" := x (in custom expr at level 0, x ident). + +Axiom f : nat -> Expr. +Check [1 {f 1}]. +Check fun x y z => [1 + y z + {f x}]. +Check fun e => match e with +| [x y + z] => [x + y z] +| [1 + 1] => [1] +| y => [y + e] +end. + +End B. + +Module C. + +Inductive Expr := + | Add : Expr -> Expr -> Expr + | One : Expr. + +Declare Custom Entry expr. +Notation "[ expr ]" := expr (expr custom expr at level 1). +Notation "1" := One (in custom expr at level 0). +Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). +Notation "( x )" := x (in custom expr at level 0, x at level 2). + +(* Check the use of a two-steps coercion from constr to expr 1 then + from expr 0 to expr 2 (note that camlp5 parsing is more tolerant + and does not require parentheses to parse from level 2 while at + level 1) *) + +Check [1 + 1]. + +End C. diff --git a/test-suite/output/PrintInfos.out b/test-suite/output/PrintInfos.out index 1307a8f2..975b2ef7 100644 --- a/test-suite/output/PrintInfos.out +++ b/test-suite/output/PrintInfos.out @@ -85,8 +85,8 @@ bar : forall x : nat, x = 0 Argument x is implicit and maximally inserted Module Coq.Init.Peano -Notation existS2 := existT2 -Expands to: Notation Coq.Init.Specif.existS2 +Notation sym_eq := eq_sym +Expands to: Notation Coq.Init.Logic.sym_eq Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x For eq: Argument A is implicit and maximally inserted diff --git a/test-suite/output/PrintInfos.v b/test-suite/output/PrintInfos.v index a498db3e..62aa80f8 100644 --- a/test-suite/output/PrintInfos.v +++ b/test-suite/output/PrintInfos.v @@ -26,8 +26,7 @@ About bar. Print bar. About Peano. (* Module *) -Set Warnings "-deprecated". -About existS2. (* Notation *) +About sym_eq. (* Notation *) Arguments eq_refl {A} {x}, {A} x. Print eq_refl. @@ -46,4 +45,3 @@ Goal forall n:nat, let g := newdef in n <> newdef n -> newdef n <> n -> False. About g. (* search hypothesis *) About h. (* search hypothesis *) Abort. - diff --git a/test-suite/output/RecordMissingField.out b/test-suite/output/RecordMissingField.out new file mode 100644 index 00000000..7c80a606 --- /dev/null +++ b/test-suite/output/RecordMissingField.out @@ -0,0 +1,4 @@ +File "stdin", line 8, characters 5-22: +Error: Cannot infer field y2p of record point2d in environment: +p : point2d + diff --git a/test-suite/output/RecordMissingField.v b/test-suite/output/RecordMissingField.v new file mode 100644 index 00000000..84f1748f --- /dev/null +++ b/test-suite/output/RecordMissingField.v @@ -0,0 +1,8 @@ +(** Check for error message when missing a record field. Error message +should contain missing field, and the inferred type of the record **) + +Record point2d := mkPoint { x2p: nat; y2p: nat }. + + +Definition increment_x (p: point2d) : point2d := + {| x2p := x2p p + 1; |}. diff --git a/test-suite/output/UnclosedBlocks.out b/test-suite/output/UnclosedBlocks.out index b83e94ad..31481e84 100644 --- a/test-suite/output/UnclosedBlocks.out +++ b/test-suite/output/UnclosedBlocks.out @@ -1,3 +1,2 @@ - Error: The section Baz, module type Bar and module Foo need to be closed. diff --git a/test-suite/output/Unicode.out b/test-suite/output/Unicode.out new file mode 100644 index 00000000..a57b3bba --- /dev/null +++ b/test-suite/output/Unicode.out @@ -0,0 +1,41 @@ +1 subgoal + + very_very_long_type_name1 : Type + very_very_long_type_name2 : Type + f : very_very_long_type_name1 → very_very_long_type_name2 → Prop + ============================ + True + → True + → ∀ (x : very_very_long_type_name1) (y : very_very_long_type_name2), + f x y ∧ f x y ∧ f x y ∧ f x y ∧ f x y ∧ f x y +1 subgoal + + very_very_long_type_name1 : Type + very_very_long_type_name2 : Type + f : very_very_long_type_name1 → very_very_long_type_name2 → Prop + ============================ + True + → True + → ∀ (x : very_very_long_type_name2) (y : very_very_long_type_name1) + (z : very_very_long_type_name2), f y x ∧ f y z +1 subgoal + + very_very_long_type_name1 : Type + very_very_long_type_name2 : Type + f : very_very_long_type_name1 → very_very_long_type_name2 → Prop + ============================ + True + → True + → ∀ (x : very_very_long_type_name2) (y : very_very_long_type_name1) + (z : very_very_long_type_name2), + f y x ∧ f y z ∧ f y x ∧ f y z ∧ f y x ∧ f y z +1 subgoal + + very_very_long_type_name1 : Type + very_very_long_type_name2 : Type + f : very_very_long_type_name1 → very_very_long_type_name2 → Prop + ============================ + True + → True + → ∃ (x : very_very_long_type_name1) (y : very_very_long_type_name2), + f x y ∧ f x y ∧ f x y ∧ f x y ∧ f x y ∧ f x y diff --git a/test-suite/output/Unicode.v b/test-suite/output/Unicode.v new file mode 100644 index 00000000..42b07e5a --- /dev/null +++ b/test-suite/output/Unicode.v @@ -0,0 +1,28 @@ +Require Import Coq.Unicode.Utf8. + +Section test. +Context (very_very_long_type_name1 : Type) (very_very_long_type_name2 : Type). +Context (f : very_very_long_type_name1 -> very_very_long_type_name2 -> Prop). + +Lemma test : True -> True -> + forall (x : very_very_long_type_name1) (y : very_very_long_type_name2), + f x y /\ f x y /\ f x y /\ f x y /\ f x y /\ f x y. +Proof. Show. Abort. + +Lemma test : True -> True -> + forall (x : very_very_long_type_name2) (y : very_very_long_type_name1) + (z : very_very_long_type_name2), + f y x /\ f y z. +Proof. Show. Abort. + +Lemma test : True -> True -> + forall (x : very_very_long_type_name2) (y : very_very_long_type_name1) + (z : very_very_long_type_name2), + f y x /\ f y z /\ f y x /\ f y z /\ f y x /\ f y z. +Proof. Show. Abort. + +Lemma test : True -> True -> + exists (x : very_very_long_type_name1) (y : very_very_long_type_name2), + f x y /\ f x y /\ f x y /\ f x y /\ f x y /\ f x y. +Proof. Show. Abort. +End test. diff --git a/test-suite/output/bug5778.out b/test-suite/output/bug5778.out index 91ceb1b5..d6056c50 100644 --- a/test-suite/output/bug5778.out +++ b/test-suite/output/bug5778.out @@ -1,4 +1,4 @@ The command has indeed failed with message: -In nested Ltac calls to "c", "abs" and "abstract b ltac:(())", last call -failed. +In nested Ltac calls to "c", "abs", "abstract b ltac:(())", +"b", "a", "pose (I : I)" and "(I : I)", last term evaluation failed. The term "I" has type "True" which should be Set, Prop or Type. diff --git a/test-suite/output/bug6404.out b/test-suite/output/bug6404.out new file mode 100644 index 00000000..05464755 --- /dev/null +++ b/test-suite/output/bug6404.out @@ -0,0 +1,4 @@ +The command has indeed failed with message: +In nested Ltac calls to "c", "abs", "transparent_abstract (tactic3)", +"b", "a", "pose (I : I)" and "(I : I)", last term evaluation failed. +The term "I" has type "True" which should be Set, Prop or Type. diff --git a/test-suite/output/bug6404.v b/test-suite/output/bug6404.v new file mode 100644 index 00000000..bbe6b1a0 --- /dev/null +++ b/test-suite/output/bug6404.v @@ -0,0 +1,7 @@ +Ltac a _ := pose (I : I). +Ltac b _ := a (). +Ltac abs _ := transparent_abstract b (). +Ltac c _ := abs (). +Goal True. + Fail c (). +Abort. diff --git a/test-suite/output/ltac.v b/test-suite/output/ltac.v index 6adbe95d..901b1e3a 100644 --- a/test-suite/output/ltac.v +++ b/test-suite/output/ltac.v @@ -37,17 +37,20 @@ Fail g1 I. Fail f1 I. Fail g2 I. Fail f2 I. +Abort. Ltac h x := injection x. Goal True -> False. Fail h I. intro H. Fail h H. +Abort. (* Check printing of the "var" argument "Hx" *) Ltac m H := idtac H; exact H. Goal True. let a:=constr:(let Hx := 0 in ltac:(m Hx)) in idtac. +Abort. (* Check consistency of interpretation scopes (#4398) *) diff --git a/test-suite/output/ltac_missing_args.out b/test-suite/output/ltac_missing_args.out index 7326f137..8a00cd3f 100644 --- a/test-suite/output/ltac_missing_args.out +++ b/test-suite/output/ltac_missing_args.out @@ -1,25 +1,25 @@ The command has indeed failed with message: -The user-defined tactic "Top.foo" was not fully applied: +The user-defined tactic "foo" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. The command has indeed failed with message: -The user-defined tactic "Top.bar" was not fully applied: +The user-defined tactic "bar" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. The command has indeed failed with message: -The user-defined tactic "Top.bar" was not fully applied: +The user-defined tactic "bar" was not fully applied: There are missing arguments for variables y and _, an argument was provided for variable x. The command has indeed failed with message: -The user-defined tactic "Top.baz" was not fully applied: +The user-defined tactic "baz" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. The command has indeed failed with message: -The user-defined tactic "Top.qux" was not fully applied: +The user-defined tactic "qux" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. The command has indeed failed with message: -The user-defined tactic "Top.mydo" was not fully applied: +The user-defined tactic "mydo" was not fully applied: There is a missing argument for variable _, no arguments at all were provided. The command has indeed failed with message: @@ -31,7 +31,7 @@ An unnamed user-defined tactic was not fully applied: There is a missing argument for variable _, no arguments at all were provided. The command has indeed failed with message: -The user-defined tactic "Top.rec" was not fully applied: +The user-defined tactic "rec" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. The command has indeed failed with message: diff --git a/test-suite/output/ssr_explain_match.out b/test-suite/output/ssr_explain_match.out new file mode 100644 index 00000000..32cfb354 --- /dev/null +++ b/test-suite/output/ssr_explain_match.out @@ -0,0 +1,55 @@ +File "stdin", line 12, characters 0-61: +Warning: Notation "_ - _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ <= _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ < _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ >= _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ > _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ <= _ <= _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ < _ <= _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ <= _ < _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ < _ < _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ + _" was already used in scope nat_scope. +[notation-overridden,parsing] +File "stdin", line 12, characters 0-61: +Warning: Notation "_ * _" was already used in scope nat_scope. +[notation-overridden,parsing] +BEGIN INSTANCES +instance: (x + y + z) matches: (x + y + z) +instance: (x + y) matches: (x + y) +instance: (x + y) matches: (x + y) +END INSTANCES +BEGIN INSTANCES +instance: (addnC (x + y) z) matches: (x + y + z) +instance: (addnC x y) matches: (x + y) +instance: (addnC x y) matches: (x + y) +END INSTANCES +BEGIN INSTANCES +instance: (addnA x y z) matches: (x + y + z) +END INSTANCES +BEGIN INSTANCES +instance: (addnA x y z) matches: (x + y + z) +instance: (addnC z (x + y)) matches: (x + y + z) +instance: (addnC y x) matches: (x + y) +instance: (addnC y x) matches: (x + y) +END INSTANCES +The command has indeed failed with message: +Ltac call to "ssrinstancesoftpat (cpattern)" failed. +Not supported diff --git a/test-suite/output/ssr_explain_match.v b/test-suite/output/ssr_explain_match.v new file mode 100644 index 00000000..56ca24b6 --- /dev/null +++ b/test-suite/output/ssr_explain_match.v @@ -0,0 +1,23 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +Require Import ssrmatching. +Require Import ssreflect ssrbool TestSuite.ssr_mini_mathcomp. + +Definition addnAC := (addnA, addnC). + +Lemma test x y z : x + y + z = x + y. + +ssrinstancesoftpat (_ + _). +ssrinstancesofruleL2R addnC. +ssrinstancesofruleR2L addnA. +ssrinstancesofruleR2L addnAC. +Fail ssrinstancesoftpat (_ + _ in RHS). (* Not implemented *) +Admitted. diff --git a/test-suite/prerequisite/make_local.v b/test-suite/prerequisite/make_local.v index 8700a6c4..6d9117c0 100644 --- a/test-suite/prerequisite/make_local.v +++ b/test-suite/prerequisite/make_local.v @@ -2,8 +2,7 @@ Definition f (A:Type) (a:A) := a. -Local Arguments Scope f [type_scope type_scope]. -Local Implicit Arguments f [A]. +Local Arguments f [A]%type_scope _%type_scope. (* Used in ImportedCoercion.v to test the locality flag *) diff --git a/test-suite/prerequisite/ssr_mini_mathcomp.v b/test-suite/prerequisite/ssr_mini_mathcomp.v new file mode 100644 index 00000000..cb2c5673 --- /dev/null +++ b/test-suite/prerequisite/ssr_mini_mathcomp.v @@ -0,0 +1,1472 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* Some code from mathcomp needed in order to run ssr_* tests *) + +Require Import ssreflect ssrfun ssrbool. + +Global Set SsrOldRewriteGoalsOrder. +Global Set Asymmetric Patterns. +Global Set Bullet Behavior "None". + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +(* eqtype ---------------------------------------------------------- *) + +Module Equality. + +Definition axiom T (e : rel T) := forall x y, reflect (x = y) (e x y). + +Structure mixin_of T := Mixin {op : rel T; _ : axiom op}. +Notation class_of := mixin_of (only parsing). + +Section ClassDef. + +Structure type := Pack {sort; _ : class_of sort; _ : Type}. +Local Coercion sort : type >-> Sortclass. +Variables (T : Type) (cT : type). + +Definition class := let: Pack _ c _ := cT return class_of cT in c. + +Definition pack c := @Pack T c T. +Definition clone := fun c & cT -> T & phant_id (pack c) cT => pack c. + +End ClassDef. + +Module Exports. +Coercion sort : type >-> Sortclass. +Notation eqType := type. +Notation EqMixin := Mixin. +Notation EqType T m := (@pack T m). +Notation "[ 'eqMixin' 'of' T ]" := (class _ : mixin_of T) + (at level 0, format "[ 'eqMixin' 'of' T ]") : form_scope. +Notation "[ 'eqType' 'of' T 'for' C ]" := (@clone T C _ idfun id) + (at level 0, format "[ 'eqType' 'of' T 'for' C ]") : form_scope. +Notation "[ 'eqType' 'of' T ]" := (@clone T _ _ id id) + (at level 0, format "[ 'eqType' 'of' T ]") : form_scope. +End Exports. + +End Equality. +Export Equality.Exports. + +Definition eq_op T := Equality.op (Equality.class T). + +Lemma eqE T x : eq_op x = Equality.op (Equality.class T) x. +Proof. by []. Qed. + +Lemma eqP T : Equality.axiom (@eq_op T). +Proof. by case: T => ? []. Qed. +Arguments eqP [T x y]. + +Delimit Scope eq_scope with EQ. +Open Scope eq_scope. + +Notation "x == y" := (eq_op x y) + (at level 70, no associativity) : bool_scope. +Notation "x == y :> T" := ((x : T) == (y : T)) + (at level 70, y at next level) : bool_scope. +Notation "x != y" := (~~ (x == y)) + (at level 70, no associativity) : bool_scope. +Notation "x != y :> T" := (~~ (x == y :> T)) + (at level 70, y at next level) : bool_scope. +Notation "x =P y" := (eqP : reflect (x = y) (x == y)) + (at level 70, no associativity) : eq_scope. +Notation "x =P y :> T" := (eqP : reflect (x = y :> T) (x == y :> T)) + (at level 70, y at next level, no associativity) : eq_scope. + +Prenex Implicits eq_op eqP. + +Lemma eq_refl (T : eqType) (x : T) : x == x. Proof. exact/eqP. Qed. +Notation eqxx := eq_refl. + +Lemma eq_sym (T : eqType) (x y : T) : (x == y) = (y == x). +Proof. exact/eqP/eqP. Qed. + +Hint Resolve eq_refl eq_sym. + + +Definition eqb b := addb (~~ b). + +Lemma eqbP : Equality.axiom eqb. +Proof. by do 2!case; constructor. Qed. + +Canonical bool_eqMixin := EqMixin eqbP. +Canonical bool_eqType := Eval hnf in EqType bool bool_eqMixin. + +Section ProdEqType. + +Variable T1 T2 : eqType. + +Definition pair_eq := [rel u v : T1 * T2 | (u.1 == v.1) && (u.2 == v.2)]. + +Lemma pair_eqP : Equality.axiom pair_eq. +Proof. +move=> [x1 x2] [y1 y2] /=; apply: (iffP andP) => [[]|[<- <-]] //=. +by do 2!move/eqP->. +Qed. + +Definition prod_eqMixin := EqMixin pair_eqP. +Canonical prod_eqType := Eval hnf in EqType (T1 * T2) prod_eqMixin. + +End ProdEqType. + +Section OptionEqType. + +Variable T : eqType. + +Definition opt_eq (u v : option T) : bool := + oapp (fun x => oapp (eq_op x) false v) (~~ v) u. + +Lemma opt_eqP : Equality.axiom opt_eq. +Proof. +case=> [x|] [y|] /=; by [constructor | apply: (iffP eqP) => [|[]] ->]. +Qed. + +Canonical option_eqMixin := EqMixin opt_eqP. +Canonical option_eqType := Eval hnf in EqType (option T) option_eqMixin. + +End OptionEqType. + +Notation xpred1 := (fun a1 x => x == a1). +Notation xpredU1 := (fun a1 (p : pred _) x => (x == a1) || p x). + +Section EqPred. + +Variable T : eqType. + +Definition pred1 (a1 : T) := SimplPred (xpred1 a1). +Definition predU1 (a1 : T) p := SimplPred (xpredU1 a1 p). + +End EqPred. + +Section TransferEqType. + +Variables (T : Type) (eT : eqType) (f : T -> eT). + +Lemma inj_eqAxiom : injective f -> Equality.axiom (fun x y => f x == f y). +Proof. by move=> f_inj x y; apply: (iffP eqP) => [|-> //]; apply: f_inj. Qed. + +Definition InjEqMixin f_inj := EqMixin (inj_eqAxiom f_inj). + +Definition PcanEqMixin g (fK : pcancel f g) := InjEqMixin (pcan_inj fK). + +Definition CanEqMixin g (fK : cancel f g) := InjEqMixin (can_inj fK). + +End TransferEqType. + +(* We use the module system to circumvent a silly limitation that *) +(* forbids using the same constant to coerce to different targets. *) +Module Type EqTypePredSig. +Parameter sort : eqType -> predArgType. +End EqTypePredSig. +Module MakeEqTypePred (eqmod : EqTypePredSig). +Coercion eqmod.sort : eqType >-> predArgType. +End MakeEqTypePred. +Module Export EqTypePred := MakeEqTypePred Equality. + + +Section SubType. + +Variables (T : Type) (P : pred T). + +Structure subType : Type := SubType { + sub_sort :> Type; + val : sub_sort -> T; + Sub : forall x, P x -> sub_sort; + _ : forall K (_ : forall x Px, K (@Sub x Px)) u, K u; + _ : forall x Px, val (@Sub x Px) = x +}. + +Arguments Sub [s]. +Lemma vrefl : forall x, P x -> x = x. Proof. by []. Qed. +Definition vrefl_rect := vrefl. + +Definition clone_subType U v := + fun sT & sub_sort sT -> U => + fun c Urec cK (sT' := @SubType U v c Urec cK) & phant_id sT' sT => sT'. + +Variable sT : subType. + +CoInductive Sub_spec : sT -> Type := SubSpec x Px : Sub_spec (Sub x Px). + +Lemma SubP u : Sub_spec u. +Proof. by case: sT Sub_spec SubSpec u => T' _ C rec /= _. Qed. + +Lemma SubK x Px : @val sT (Sub x Px) = x. +Proof. by case: sT. Qed. + +Definition insub x := + if @idP (P x) is ReflectT Px then @Some sT (Sub x Px) else None. + +Definition insubd u0 x := odflt u0 (insub x). + +CoInductive insub_spec x : option sT -> Type := + | InsubSome u of P x & val u = x : insub_spec x (Some u) + | InsubNone of ~~ P x : insub_spec x None. + +Lemma insubP x : insub_spec x (insub x). +Proof. +by rewrite /insub; case: {-}_ / idP; [left; rewrite ?SubK | right; apply/negP]. +Qed. + +Lemma insubT x Px : insub x = Some (Sub x Px). +Admitted. + +Lemma insubF x : P x = false -> insub x = None. +Proof. by move/idP; case: insubP. Qed. + +Lemma insubN x : ~~ P x -> insub x = None. +Proof. by move/negPf/insubF. Qed. + +Lemma isSome_insub : ([eta insub] : pred T) =1 P. +Proof. by apply: fsym => x; case: insubP => // /negPf. Qed. + +Lemma insubK : ocancel insub (@val _). +Proof. by move=> x; case: insubP. Qed. + +Lemma valP (u : sT) : P (val u). +Proof. by case/SubP: u => x Px; rewrite SubK. Qed. + +Lemma valK : pcancel (@val _) insub. +Proof. by case/SubP=> x Px; rewrite SubK; apply: insubT. Qed. + +Lemma val_inj : injective (@val sT). +Proof. exact: pcan_inj valK. Qed. + +Lemma valKd u0 : cancel (@val _) (insubd u0). +Proof. by move=> u; rewrite /insubd valK. Qed. + +Lemma val_insubd u0 x : val (insubd u0 x) = if P x then x else val u0. +Proof. by rewrite /insubd; case: insubP => [u -> | /negPf->]. Qed. + +Lemma insubdK u0 : {in P, cancel (insubd u0) (@val _)}. +Proof. by move=> x Px; rewrite /= val_insubd [P x]Px. Qed. + +Definition insub_eq x := + let Some_sub Px := Some (Sub x Px : sT) in + let None_sub _ := None in + (if P x as Px return P x = Px -> _ then Some_sub else None_sub) (erefl _). + +Lemma insub_eqE : insub_eq =1 insub. +Proof. +rewrite /insub_eq /insub => x; case: {2 3}_ / idP (erefl _) => // Px Px'. +by congr (Some _); apply: val_inj; rewrite !SubK. +Qed. + +End SubType. + +Arguments SubType [T P]. +Arguments Sub [T P s]. +Arguments vrefl [T P]. +Arguments vrefl_rect [T P]. +Arguments clone_subType [T P] U v [sT] _ [c Urec cK]. +Arguments insub [T P sT]. +Arguments insubT [T] P [sT x]. +Arguments val_inj [T P sT]. +Prenex Implicits val Sub vrefl vrefl_rect insub insubd val_inj. + +Local Notation inlined_sub_rect := + (fun K K_S u => let (x, Px) as u return K u := u in K_S x Px). + +Local Notation inlined_new_rect := + (fun K K_S u => let (x) as u return K u := u in K_S x). + +Notation "[ 'subType' 'for' v ]" := (SubType _ v _ inlined_sub_rect vrefl_rect) + (at level 0, only parsing) : form_scope. + +Notation "[ 'sub' 'Type' 'for' v ]" := (SubType _ v _ _ vrefl_rect) + (at level 0, format "[ 'sub' 'Type' 'for' v ]") : form_scope. + +Notation "[ 'subType' 'for' v 'by' rec ]" := (SubType _ v _ rec vrefl) + (at level 0, format "[ 'subType' 'for' v 'by' rec ]") : form_scope. + +Notation "[ 'subType' 'of' U 'for' v ]" := (clone_subType U v id idfun) + (at level 0, format "[ 'subType' 'of' U 'for' v ]") : form_scope. + +(* +Notation "[ 'subType' 'for' v ]" := (clone_subType _ v id idfun) + (at level 0, format "[ 'subType' 'for' v ]") : form_scope. +*) +Notation "[ 'subType' 'of' U ]" := (clone_subType U _ id id) + (at level 0, format "[ 'subType' 'of' U ]") : form_scope. + +Definition NewType T U v c Urec := + let Urec' P IH := Urec P (fun x : T => IH x isT : P _) in + SubType U v (fun x _ => c x) Urec'. +Arguments NewType [T U]. + +Notation "[ 'newType' 'for' v ]" := (NewType v _ inlined_new_rect vrefl_rect) + (at level 0, only parsing) : form_scope. + +Notation "[ 'new' 'Type' 'for' v ]" := (NewType v _ _ vrefl_rect) + (at level 0, format "[ 'new' 'Type' 'for' v ]") : form_scope. + +Notation "[ 'newType' 'for' v 'by' rec ]" := (NewType v _ rec vrefl) + (at level 0, format "[ 'newType' 'for' v 'by' rec ]") : form_scope. + +Definition innew T nT x := @Sub T predT nT x (erefl true). +Arguments innew [T nT]. +Prenex Implicits innew. + +Lemma innew_val T nT : cancel val (@innew T nT). +Proof. by move=> u; apply: val_inj; apply: SubK. Qed. + +(* Prenex Implicits and renaming. *) +Notation sval := (@proj1_sig _ _). +Notation "@ 'sval'" := (@proj1_sig) (at level 10, format "@ 'sval'"). + +Section SubEqType. + +Variables (T : eqType) (P : pred T) (sT : subType P). + +Local Notation ev_ax := (fun T v => @Equality.axiom T (fun x y => v x == v y)). +Lemma val_eqP : ev_ax sT val. Proof. exact: inj_eqAxiom val_inj. Qed. + +Definition sub_eqMixin := EqMixin val_eqP. +Canonical sub_eqType := Eval hnf in EqType sT sub_eqMixin. + +Definition SubEqMixin := + (let: SubType _ v _ _ _ as sT' := sT + return ev_ax sT' val -> Equality.class_of sT' in + fun vP : ev_ax _ v => EqMixin vP + ) val_eqP. + +Lemma val_eqE (u v : sT) : (val u == val v) = (u == v). +Proof. by []. Qed. + +End SubEqType. + +Arguments val_eqP [T P sT x y]. +Prenex Implicits val_eqP. + +Notation "[ 'eqMixin' 'of' T 'by' <: ]" := (SubEqMixin _ : Equality.class_of T) + (at level 0, format "[ 'eqMixin' 'of' T 'by' <: ]") : form_scope. + +(* ssrnat ---------------------------------------------------------- *) + +Notation succn := Datatypes.S. +Notation predn := Peano.pred. + +Notation "n .+1" := (succn n) (at level 2, left associativity, + format "n .+1") : nat_scope. +Notation "n .+2" := n.+1.+1 (at level 2, left associativity, + format "n .+2") : nat_scope. +Notation "n .+3" := n.+2.+1 (at level 2, left associativity, + format "n .+3") : nat_scope. +Notation "n .+4" := n.+2.+2 (at level 2, left associativity, + format "n .+4") : nat_scope. + +Notation "n .-1" := (predn n) (at level 2, left associativity, + format "n .-1") : nat_scope. +Notation "n .-2" := n.-1.-1 (at level 2, left associativity, + format "n .-2") : nat_scope. + +Fixpoint eqn m n {struct m} := + match m, n with + | 0, 0 => true + | m'.+1, n'.+1 => eqn m' n' + | _, _ => false + end. + +Lemma eqnP : Equality.axiom eqn. +Proof. +move=> n m; apply: (iffP idP) => [|<-]; last by elim n. +by elim: n m => [|n IHn] [|m] //= /IHn->. +Qed. + +Canonical nat_eqMixin := EqMixin eqnP. +Canonical nat_eqType := Eval hnf in EqType nat nat_eqMixin. + +Arguments eqnP [x y]. +Prenex Implicits eqnP. + +Coercion nat_of_bool (b : bool) := if b then 1 else 0. + +Fixpoint odd n := if n is n'.+1 then ~~ odd n' else false. + +Lemma oddb (b : bool) : odd b = b. Proof. by case: b. Qed. + +Definition subn_rec := minus. +Notation "m - n" := (subn_rec m n) : nat_rec_scope. + +Definition subn := nosimpl subn_rec. +Notation "m - n" := (subn m n) : nat_scope. + +Definition leq m n := m - n == 0. + +Notation "m <= n" := (leq m n) : nat_scope. +Notation "m < n" := (m.+1 <= n) : nat_scope. +Notation "m >= n" := (n <= m) (only parsing) : nat_scope. +Notation "m > n" := (n < m) (only parsing) : nat_scope. + + +Notation "m <= n <= p" := ((m <= n) && (n <= p)) : nat_scope. +Notation "m < n <= p" := ((m < n) && (n <= p)) : nat_scope. +Notation "m <= n < p" := ((m <= n) && (n < p)) : nat_scope. +Notation "m < n < p" := ((m < n) && (n < p)) : nat_scope. + +Open Scope nat_scope. + + +Lemma ltnS m n : (m < n.+1) = (m <= n). Proof. by []. Qed. +Lemma leq0n n : 0 <= n. Proof. by []. Qed. +Lemma ltn0Sn n : 0 < n.+1. Proof. by []. Qed. +Lemma ltn0 n : n < 0 = false. Proof. by []. Qed. +Lemma leqnn n : n <= n. Proof. by elim: n. Qed. +Hint Resolve leqnn. +Lemma leqnSn n : n <= n.+1. Proof. by elim: n. Qed. + +Lemma leq_trans n m p : m <= n -> n <= p -> m <= p. +Admitted. +Lemma leqW m n : m <= n -> m <= n.+1. +Admitted. +Hint Resolve leqnSn. +Lemma ltnW m n : m < n -> m <= n. +Proof. exact: leq_trans. Qed. +Hint Resolve ltnW. + +Definition addn_rec := plus. +Notation "m + n" := (addn_rec m n) : nat_rec_scope. + +Definition addn := nosimpl addn_rec. +Notation "m + n" := (addn m n) : nat_scope. + +Lemma addn0 : right_id 0 addn. Proof. by move=> n; apply/eqP; elim: n. Qed. +Lemma add0n : left_id 0 addn. Proof. by []. Qed. +Lemma addSn m n : m.+1 + n = (m + n).+1. Proof. by []. Qed. +Lemma addnS m n : m + n.+1 = (m + n).+1. Proof. by elim: m. Qed. + +Lemma addnCA : left_commutative addn. +Proof. by move=> m n p; elim: m => //= m; rewrite addnS => <-. Qed. + +Lemma addnC : commutative addn. +Proof. by move=> m n; rewrite -{1}[n]addn0 addnCA addn0. Qed. + +Lemma addnA : associative addn. +Proof. by move=> m n p; rewrite (addnC n) addnCA addnC. Qed. + +Lemma subnK m n : m <= n -> (n - m) + m = n. +Admitted. + + +Definition muln_rec := mult. +Notation "m * n" := (muln_rec m n) : nat_rec_scope. + +Definition muln := nosimpl muln_rec. +Notation "m * n" := (muln m n) : nat_scope. + +Lemma mul0n : left_zero 0 muln. Proof. by []. Qed. +Lemma muln0 : right_zero 0 muln. Proof. by elim. Qed. +Lemma mul1n : left_id 1 muln. Proof. exact: addn0. Qed. + +Lemma mulSn m n : m.+1 * n = n + m * n. Proof. by []. Qed. +Lemma mulSnr m n : m.+1 * n = m * n + n. Proof. exact: addnC. Qed. + +Lemma mulnS m n : m * n.+1 = m + m * n. +Proof. by elim: m => // m; rewrite !mulSn !addSn addnCA => ->. Qed. + +Lemma mulnSr m n : m * n.+1 = m * n + m. +Proof. by rewrite addnC mulnS. Qed. + +Lemma muln1 : right_id 1 muln. +Proof. by move=> n; rewrite mulnSr muln0. Qed. + +Lemma mulnC : commutative muln. +Proof. +by move=> m n; elim: m => [|m]; rewrite (muln0, mulnS) // mulSn => ->. +Qed. + +Lemma mulnDl : left_distributive muln addn. +Proof. by move=> m1 m2 n; elim: m1 => //= m1 IHm; rewrite -addnA -IHm. Qed. + +Lemma mulnDr : right_distributive muln addn. +Proof. by move=> m n1 n2; rewrite !(mulnC m) mulnDl. Qed. + +Lemma mulnA : associative muln. +Proof. by move=> m n p; elim: m => //= m; rewrite mulSn mulnDl => ->. Qed. + +Lemma mulnCA : left_commutative muln. +Proof. by move=> m n1 n2; rewrite !mulnA (mulnC m). Qed. + +Lemma mulnAC : right_commutative muln. +Proof. by move=> m n p; rewrite -!mulnA (mulnC n). Qed. + +Lemma mulnACA : interchange muln muln. +Proof. by move=> m n p q; rewrite -!mulnA (mulnCA n). Qed. + +(* seq ------------------------------------------------------------- *) + +Delimit Scope seq_scope with SEQ. +Open Scope seq_scope. + +(* Inductive seq (T : Type) : Type := Nil | Cons of T & seq T. *) +Notation seq := list. +Prenex Implicits cons. +Notation Cons T := (@cons T) (only parsing). +Notation Nil T := (@nil T) (only parsing). + +Bind Scope seq_scope with list. +Arguments cons _%type _ _%SEQ. + +(* As :: and ++ are (improperly) declared in Init.datatypes, we only rebind *) +(* them here. *) +Infix "::" := cons : seq_scope. + +(* GG - this triggers a camlp4 warning, as if this Notation had been Reserved *) +Notation "[ :: ]" := nil (at level 0, format "[ :: ]") : seq_scope. + +Notation "[ :: x1 ]" := (x1 :: [::]) + (at level 0, format "[ :: x1 ]") : seq_scope. + +Notation "[ :: x & s ]" := (x :: s) (at level 0, only parsing) : seq_scope. + +Notation "[ :: x1 , x2 , .. , xn & s ]" := (x1 :: x2 :: .. (xn :: s) ..) + (at level 0, format + "'[hv' [ :: '[' x1 , '/' x2 , '/' .. , '/' xn ']' '/ ' & s ] ']'" + ) : seq_scope. + +Notation "[ :: x1 ; x2 ; .. ; xn ]" := (x1 :: x2 :: .. [:: xn] ..) + (at level 0, format "[ :: '[' x1 ; '/' x2 ; '/' .. ; '/' xn ']' ]" + ) : seq_scope. + +Section Sequences. + +Variable n0 : nat. (* numerical parameter for take, drop et al *) +Variable T : Type. (* must come before the implicit Type *) +Variable x0 : T. (* default for head/nth *) + +Implicit Types x y z : T. +Implicit Types m n : nat. +Implicit Type s : seq T. + +Fixpoint size s := if s is _ :: s' then (size s').+1 else 0. + +Fixpoint cat s1 s2 := if s1 is x :: s1' then x :: s1' ++ s2 else s2 +where "s1 ++ s2" := (cat s1 s2) : seq_scope. + +Lemma cat0s s : [::] ++ s = s. Proof. by []. Qed. + +Lemma cats0 s : s ++ [::] = s. +Proof. by elim: s => //= x s ->. Qed. + +Lemma catA s1 s2 s3 : s1 ++ s2 ++ s3 = (s1 ++ s2) ++ s3. +Proof. by elim: s1 => //= x s1 ->. Qed. + +Fixpoint nth s n {struct n} := + if s is x :: s' then if n is n'.+1 then @nth s' n' else x else x0. + +Fixpoint rcons s z := if s is x :: s' then x :: rcons s' z else [:: z]. + +CoInductive last_spec : seq T -> Type := + | LastNil : last_spec [::] + | LastRcons s x : last_spec (rcons s x). + +Lemma lastP s : last_spec s. +Proof using. Admitted. + +Lemma last_ind P : + P [::] -> (forall s x, P s -> P (rcons s x)) -> forall s, P s. +Proof using. Admitted. + + +Section Map. + +Variables (T2 : Type) (f : T -> T2). + +Fixpoint map s := if s is x :: s' then f x :: map s' else [::]. + +End Map. + +Section SeqFind. + +Variable a : pred T. + +Fixpoint count s := if s is x :: s' then a x + count s' else 0. + +Fixpoint filter s := + if s is x :: s' then if a x then x :: filter s' else filter s' else [::]. + +End SeqFind. + +End Sequences. + +Infix "++" := cat : seq_scope. + +Notation count_mem x := (count (pred_of_simpl (pred1 x))). + +Section EqSeq. + +Variables (n0 : nat) (T : eqType) (x0 : T). +Local Notation nth := (nth x0). +Implicit Type s : seq T. +Implicit Types x y z : T. + +Fixpoint eqseq s1 s2 {struct s2} := + match s1, s2 with + | [::], [::] => true + | x1 :: s1', x2 :: s2' => (x1 == x2) && eqseq s1' s2' + | _, _ => false + end. + +Lemma eqseqP : Equality.axiom eqseq. +Proof. +move; elim=> [|x1 s1 IHs] [|x2 s2]; do [by constructor | simpl]. +case: (x1 =P x2) => [<-|neqx]; last by right; case. +by apply: (iffP (IHs s2)) => [<-|[]]. +Qed. + +Canonical seq_eqMixin := EqMixin eqseqP. +Canonical seq_eqType := Eval hnf in EqType (seq T) seq_eqMixin. + +Fixpoint mem_seq (s : seq T) := + if s is y :: s' then xpredU1 y (mem_seq s') else xpred0. + +Definition eqseq_class := seq T. +Identity Coercion seq_of_eqseq : eqseq_class >-> seq. +Coercion pred_of_eq_seq (s : eqseq_class) : pred_class := [eta mem_seq s]. + +Canonical seq_predType := @mkPredType T (seq T) pred_of_eq_seq. + +Fixpoint uniq s := if s is x :: s' then (x \notin s') && uniq s' else true. + +End EqSeq. + +Definition bitseq := seq bool. +Canonical bitseq_eqType := Eval hnf in [eqType of bitseq]. +Canonical bitseq_predType := Eval hnf in [predType of bitseq]. + +Section Pmap. + +Variables (aT rT : Type) (f : aT -> option rT) (g : rT -> aT). + +Fixpoint pmap s := + if s is x :: s' then let r := pmap s' in oapp (cons^~ r) r (f x) else [::]. + +End Pmap. + +Fixpoint iota m n := if n is n'.+1 then m :: iota m.+1 n' else [::]. + +Section FoldRight. + +Variables (T : Type) (R : Type) (f : T -> R -> R) (z0 : R). + +Fixpoint foldr s := if s is x :: s' then f x (foldr s') else z0. + +End FoldRight. + +Lemma mem_iota m n i : (i \in iota m n) = (m <= i) && (i < m + n). +Admitted. + + +(* choice ------------------------------------------------------------- *) + +Module Choice. + +Section ClassDef. + +Record mixin_of T := Mixin { + find : pred T -> nat -> option T; + _ : forall P n x, find P n = Some x -> P x; + _ : forall P : pred T, (exists x, P x) -> exists n, find P n; + _ : forall P Q : pred T, P =1 Q -> find P =1 find Q +}. + +Record class_of T := Class {base : Equality.class_of T; mixin : mixin_of T}. +Local Coercion base : class_of >-> Equality.class_of. + +Structure type := Pack {sort; _ : class_of sort; _ : Type}. +Local Coercion sort : type >-> Sortclass. +Variables (T : Type) (cT : type). +Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c. +Definition clone c of phant_id class c := @Pack T c T. +Let xT := let: Pack T _ _ := cT in T. +Notation xclass := (class : class_of xT). + +Definition pack m := + fun b bT & phant_id (Equality.class bT) b => Pack (@Class T b m) T. + +(* Inheritance *) +Definition eqType := @Equality.Pack cT xclass xT. + +End ClassDef. + +Module Import Exports. +Coercion base : class_of >-> Equality.class_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. +Canonical eqType. +Notation choiceType := type. +Notation choiceMixin := mixin_of. +Notation ChoiceType T m := (@pack T m _ _ id). +Notation "[ 'choiceType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) + (at level 0, format "[ 'choiceType' 'of' T 'for' cT ]") : form_scope. +Notation "[ 'choiceType' 'of' T ]" := (@clone T _ _ id) + (at level 0, format "[ 'choiceType' 'of' T ]") : form_scope. + +End Exports. + +End Choice. +Export Choice.Exports. + +Section ChoiceTheory. + +Variable T : choiceType. + +Section CanChoice. + +Variables (sT : Type) (f : sT -> T). + +Lemma PcanChoiceMixin f' : pcancel f f' -> choiceMixin sT. +Admitted. + +Definition CanChoiceMixin f' (fK : cancel f f') := + PcanChoiceMixin (can_pcan fK). + +End CanChoice. + +Section SubChoice. + +Variables (P : pred T) (sT : subType P). + +Definition sub_choiceMixin := PcanChoiceMixin (@valK T P sT). +Definition sub_choiceClass := @Choice.Class sT (sub_eqMixin sT) sub_choiceMixin. +Canonical sub_choiceType := Choice.Pack sub_choiceClass sT. + +End SubChoice. + + +Fact seq_choiceMixin : choiceMixin (seq T). +Admitted. +Canonical seq_choiceType := Eval hnf in ChoiceType (seq T) seq_choiceMixin. +End ChoiceTheory. + +Fact nat_choiceMixin : choiceMixin nat. +Proof. +pose f := [fun (P : pred nat) n => if P n then Some n else None]. +exists f => [P n m | P [n Pn] | P Q eqPQ n] /=; last by rewrite eqPQ. + by case: ifP => // Pn [<-]. +by exists n; rewrite Pn. +Qed. +Canonical nat_choiceType := Eval hnf in ChoiceType nat nat_choiceMixin. + +Definition bool_choiceMixin := CanChoiceMixin oddb. +Canonical bool_choiceType := Eval hnf in ChoiceType bool bool_choiceMixin. +Canonical bitseq_choiceType := Eval hnf in [choiceType of bitseq]. + + +Notation "[ 'choiceMixin' 'of' T 'by' <: ]" := + (sub_choiceMixin _ : choiceMixin T) + (at level 0, format "[ 'choiceMixin' 'of' T 'by' <: ]") : form_scope. + + + + +Module Countable. + +Record mixin_of (T : Type) : Type := Mixin { + pickle : T -> nat; + unpickle : nat -> option T; + pickleK : pcancel pickle unpickle +}. + +Definition EqMixin T m := PcanEqMixin (@pickleK T m). +Definition ChoiceMixin T m := PcanChoiceMixin (@pickleK T m). + +Section ClassDef. + +Record class_of T := Class { base : Choice.class_of T; mixin : mixin_of T }. +Local Coercion base : class_of >-> Choice.class_of. + +Structure type : Type := Pack {sort : Type; _ : class_of sort; _ : Type}. +Local Coercion sort : type >-> Sortclass. +Variables (T : Type) (cT : type). +Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c. +Definition clone c of phant_id class c := @Pack T c T. +Let xT := let: Pack T _ _ := cT in T. +Notation xclass := (class : class_of xT). + +Definition pack m := + fun bT b & phant_id (Choice.class bT) b => Pack (@Class T b m) T. + +Definition eqType := @Equality.Pack cT xclass xT. +Definition choiceType := @Choice.Pack cT xclass xT. + +End ClassDef. + +Module Exports. +Coercion base : class_of >-> Choice.class_of. +Coercion mixin : class_of >-> mixin_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. +Canonical eqType. +Coercion choiceType : type >-> Choice.type. +Canonical choiceType. +Notation countType := type. +Notation CountType T m := (@pack T m _ _ id). +Notation CountMixin := Mixin. +Notation CountChoiceMixin := ChoiceMixin. +Notation "[ 'countType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) + (at level 0, format "[ 'countType' 'of' T 'for' cT ]") : form_scope. +Notation "[ 'countType' 'of' T ]" := (@clone T _ _ id) + (at level 0, format "[ 'countType' 'of' T ]") : form_scope. + +End Exports. + +End Countable. +Export Countable.Exports. + +Definition unpickle T := Countable.unpickle (Countable.class T). +Definition pickle T := Countable.pickle (Countable.class T). +Arguments unpickle [T]. +Prenex Implicits pickle unpickle. + +Section CountableTheory. + +Variable T : countType. + +Lemma pickleK : @pcancel nat T pickle unpickle. +Proof. exact: Countable.pickleK. Qed. + +Definition pickle_inv n := + obind (fun x : T => if pickle x == n then Some x else None) (unpickle n). + +Lemma pickle_invK : ocancel pickle_inv pickle. +Proof. +by rewrite /pickle_inv => n; case def_x: (unpickle n) => //= [x]; case: eqP. +Qed. + +Lemma pickleK_inv : pcancel pickle pickle_inv. +Proof. by rewrite /pickle_inv => x; rewrite pickleK /= eqxx. Qed. + +Lemma pcan_pickleK sT f f' : + @pcancel T sT f f' -> pcancel (pickle \o f) (pcomp f' unpickle). +Proof. by move=> fK x; rewrite /pcomp pickleK /= fK. Qed. + +Definition PcanCountMixin sT f f' (fK : pcancel f f') := + @CountMixin sT _ _ (pcan_pickleK fK). + +Definition CanCountMixin sT f f' (fK : cancel f f') := + @PcanCountMixin sT _ _ (can_pcan fK). + +Definition sub_countMixin P sT := PcanCountMixin (@valK T P sT). + +End CountableTheory. +Notation "[ 'countMixin' 'of' T 'by' <: ]" := + (sub_countMixin _ : Countable.mixin_of T) + (at level 0, format "[ 'countMixin' 'of' T 'by' <: ]") : form_scope. + +Section SubCountType. + +Variables (T : choiceType) (P : pred T). +Import Countable. + +Structure subCountType : Type := + SubCountType {subCount_sort :> subType P; _ : mixin_of subCount_sort}. + +Coercion sub_countType (sT : subCountType) := + Eval hnf in pack (let: SubCountType _ m := sT return mixin_of sT in m) id. +Canonical sub_countType. + +Definition pack_subCountType U := + fun sT cT & sub_sort sT * sort cT -> U * U => + fun b m & phant_id (Class b m) (class cT) => @SubCountType sT m. + +End SubCountType. + +(* This assumes that T has both countType and subType structures. *) +Notation "[ 'subCountType' 'of' T ]" := + (@pack_subCountType _ _ T _ _ id _ _ id) + (at level 0, format "[ 'subCountType' 'of' T ]") : form_scope. + +Lemma nat_pickleK : pcancel id (@Some nat). Proof. by []. Qed. +Definition nat_countMixin := CountMixin nat_pickleK. +Canonical nat_countType := Eval hnf in CountType nat nat_countMixin. + +(* fintype --------------------------------------------------------- *) + +Module Finite. + +Section RawMixin. + +Variable T : eqType. + +Definition axiom e := forall x : T, count_mem x e = 1. + +Lemma uniq_enumP e : uniq e -> e =i T -> axiom e. +Admitted. + +Record mixin_of := Mixin { + mixin_base : Countable.mixin_of T; + mixin_enum : seq T; + _ : axiom mixin_enum +}. + +End RawMixin. + +Section Mixins. + +Variable T : countType. + +Definition EnumMixin := + let: Countable.Pack _ (Countable.Class _ m) _ as cT := T + return forall e : seq cT, axiom e -> mixin_of cT in + @Mixin (EqType _ _) m. + +Definition UniqMixin e Ue eT := @EnumMixin e (uniq_enumP Ue eT). + +Variable n : nat. + +End Mixins. + +Section ClassDef. + +Record class_of T := Class { + base : Choice.class_of T; + mixin : mixin_of (Equality.Pack base T) +}. +Definition base2 T c := Countable.Class (@base T c) (mixin_base (mixin c)). +Local Coercion base : class_of >-> Choice.class_of. + +Structure type : Type := Pack {sort; _ : class_of sort; _ : Type}. +Local Coercion sort : type >-> Sortclass. +Variables (T : Type) (cT : type). +Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c. +Definition clone c of phant_id class c := @Pack T c T. +Let xT := let: Pack T _ _ := cT in T. +Notation xclass := (class : class_of xT). + +Definition pack b0 (m0 : mixin_of (EqType T b0)) := + fun bT b & phant_id (Choice.class bT) b => + fun m & phant_id m0 m => Pack (@Class T b m) T. + +Definition eqType := @Equality.Pack cT xclass xT. +Definition choiceType := @Choice.Pack cT xclass xT. +Definition countType := @Countable.Pack cT (base2 xclass) xT. + +End ClassDef. + +Module Import Exports. +Coercion mixin_base : mixin_of >-> Countable.mixin_of. +Coercion base : class_of >-> Choice.class_of. +Coercion mixin : class_of >-> mixin_of. +Coercion base2 : class_of >-> Countable.class_of. +Coercion sort : type >-> Sortclass. +Coercion eqType : type >-> Equality.type. +Canonical eqType. +Coercion choiceType : type >-> Choice.type. +Canonical choiceType. +Coercion countType : type >-> Countable.type. +Canonical countType. +Notation finType := type. +Notation FinType T m := (@pack T _ m _ _ id _ id). +Notation FinMixin := EnumMixin. +Notation UniqFinMixin := UniqMixin. +Notation "[ 'finType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) + (at level 0, format "[ 'finType' 'of' T 'for' cT ]") : form_scope. +Notation "[ 'finType' 'of' T ]" := (@clone T _ _ id) + (at level 0, format "[ 'finType' 'of' T ]") : form_scope. +End Exports. + +Module Type EnumSig. +Parameter enum : forall cT : type, seq cT. +Axiom enumDef : enum = fun cT => mixin_enum (class cT). +End EnumSig. + +Module EnumDef : EnumSig. +Definition enum cT := mixin_enum (class cT). +Definition enumDef := erefl enum. +End EnumDef. + +Notation enum := EnumDef.enum. + +End Finite. +Export Finite.Exports. + +Section SubFinType. + +Variables (T : choiceType) (P : pred T). +Import Finite. + +Structure subFinType := SubFinType { + subFin_sort :> subType P; + _ : mixin_of (sub_eqType subFin_sort) +}. + +Definition pack_subFinType U := + fun cT b m & phant_id (class cT) (@Class U b m) => + fun sT m' & phant_id m' m => @SubFinType sT m'. + +Implicit Type sT : subFinType. + +Definition subFin_mixin sT := + let: SubFinType _ m := sT return mixin_of (sub_eqType sT) in m. + +Coercion subFinType_subCountType sT := @SubCountType _ _ sT (subFin_mixin sT). +Canonical subFinType_subCountType. + +Coercion subFinType_finType sT := + Pack (@Class sT (sub_choiceClass sT) (subFin_mixin sT)) sT. +Canonical subFinType_finType. + +Definition enum_mem T (mA : mem_pred _) := filter mA (Finite.enum T). +Definition image_mem T T' f mA : seq T' := map f (@enum_mem T mA). +Definition codom T T' f := @image_mem T T' f (mem T). + +Lemma codom_val sT x : (x \in codom (val : sT -> T)) = P x. +Admitted. + +End SubFinType. + + +(* This assumes that T has both finType and subCountType structures. *) +Notation "[ 'subFinType' 'of' T ]" := (@pack_subFinType _ _ T _ _ _ id _ _ id) + (at level 0, format "[ 'subFinType' 'of' T ]") : form_scope. + + + +Section OrdinalSub. + +Variable n : nat. + +Inductive ordinal : predArgType := Ordinal m of m < n. + +Coercion nat_of_ord i := let: Ordinal m _ := i in m. + +Canonical ordinal_subType := [subType for nat_of_ord]. +Definition ordinal_eqMixin := Eval hnf in [eqMixin of ordinal by <:]. +Canonical ordinal_eqType := Eval hnf in EqType ordinal ordinal_eqMixin. +Definition ordinal_choiceMixin := [choiceMixin of ordinal by <:]. +Canonical ordinal_choiceType := + Eval hnf in ChoiceType ordinal ordinal_choiceMixin. +Definition ordinal_countMixin := [countMixin of ordinal by <:]. +Canonical ordinal_countType := Eval hnf in CountType ordinal ordinal_countMixin. +Canonical ordinal_subCountType := [subCountType of ordinal]. + +Lemma ltn_ord (i : ordinal) : i < n. Proof. exact: valP i. Qed. + +Lemma ord_inj : injective nat_of_ord. Proof. exact: val_inj. Qed. + +Definition ord_enum : seq ordinal := pmap insub (iota 0 n). + +Lemma val_ord_enum : map val ord_enum = iota 0 n. +Admitted. + +Lemma ord_enum_uniq : uniq ord_enum. +Admitted. + +Lemma mem_ord_enum i : i \in ord_enum. +Admitted. + +Definition ordinal_finMixin := + Eval hnf in UniqFinMixin ord_enum_uniq mem_ord_enum. +Canonical ordinal_finType := Eval hnf in FinType ordinal ordinal_finMixin. +Canonical ordinal_subFinType := Eval hnf in [subFinType of ordinal]. + +End OrdinalSub. + +Notation "''I_' n" := (ordinal n) + (at level 8, n at level 2, format "''I_' n"). + +(* bigop ----------------------------------------------------------------- *) + +Reserved Notation "\big [ op / idx ]_ i F" + (at level 36, F at level 36, op, idx at level 10, i at level 0, + right associativity, + format "'[' \big [ op / idx ]_ i '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i <- r | P ) F" + (at level 36, F at level 36, op, idx at level 10, i, r at level 50, + format "'[' \big [ op / idx ]_ ( i <- r | P ) '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i <- r ) F" + (at level 36, F at level 36, op, idx at level 10, i, r at level 50, + format "'[' \big [ op / idx ]_ ( i <- r ) '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( m <= i < n | P ) F" + (at level 36, F at level 36, op, idx at level 10, m, i, n at level 50, + format "'[' \big [ op / idx ]_ ( m <= i < n | P ) F ']'"). +Reserved Notation "\big [ op / idx ]_ ( m <= i < n ) F" + (at level 36, F at level 36, op, idx at level 10, i, m, n at level 50, + format "'[' \big [ op / idx ]_ ( m <= i < n ) '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i | P ) F" + (at level 36, F at level 36, op, idx at level 10, i at level 50, + format "'[' \big [ op / idx ]_ ( i | P ) '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i : t | P ) F" + (at level 36, F at level 36, op, idx at level 10, i at level 50, + format "'[' \big [ op / idx ]_ ( i : t | P ) '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i : t ) F" + (at level 36, F at level 36, op, idx at level 10, i at level 50, + format "'[' \big [ op / idx ]_ ( i : t ) '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i < n | P ) F" + (at level 36, F at level 36, op, idx at level 10, i, n at level 50, + format "'[' \big [ op / idx ]_ ( i < n | P ) '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i < n ) F" + (at level 36, F at level 36, op, idx at level 10, i, n at level 50, + format "'[' \big [ op / idx ]_ ( i < n ) F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i 'in' A | P ) F" + (at level 36, F at level 36, op, idx at level 10, i, A at level 50, + format "'[' \big [ op / idx ]_ ( i 'in' A | P ) '/ ' F ']'"). +Reserved Notation "\big [ op / idx ]_ ( i 'in' A ) F" + (at level 36, F at level 36, op, idx at level 10, i, A at level 50, + format "'[' \big [ op / idx ]_ ( i 'in' A ) '/ ' F ']'"). + +Module Monoid. + +Section Definitions. +Variables (T : Type) (idm : T). + +Structure law := Law { + operator : T -> T -> T; + _ : associative operator; + _ : left_id idm operator; + _ : right_id idm operator +}. +Local Coercion operator : law >-> Funclass. + +Structure com_law := ComLaw { + com_operator : law; + _ : commutative com_operator +}. +Local Coercion com_operator : com_law >-> law. + +Structure mul_law := MulLaw { + mul_operator : T -> T -> T; + _ : left_zero idm mul_operator; + _ : right_zero idm mul_operator +}. +Local Coercion mul_operator : mul_law >-> Funclass. + +Structure add_law (mul : T -> T -> T) := AddLaw { + add_operator : com_law; + _ : left_distributive mul add_operator; + _ : right_distributive mul add_operator +}. +Local Coercion add_operator : add_law >-> com_law. + +Let op_id (op1 op2 : T -> T -> T) := phant_id op1 op2. + +Definition clone_law op := + fun (opL : law) & op_id opL op => + fun opmA op1m opm1 (opL' := @Law op opmA op1m opm1) + & phant_id opL' opL => opL'. + +Definition clone_com_law op := + fun (opL : law) (opC : com_law) & op_id opL op & op_id opC op => + fun opmC (opC' := @ComLaw opL opmC) & phant_id opC' opC => opC'. + +Definition clone_mul_law op := + fun (opM : mul_law) & op_id opM op => + fun op0m opm0 (opM' := @MulLaw op op0m opm0) & phant_id opM' opM => opM'. + +Definition clone_add_law mop aop := + fun (opC : com_law) (opA : add_law mop) & op_id opC aop & op_id opA aop => + fun mopDm mopmD (opA' := @AddLaw mop opC mopDm mopmD) + & phant_id opA' opA => opA'. + +End Definitions. + +Module Import Exports. +Coercion operator : law >-> Funclass. +Coercion com_operator : com_law >-> law. +Coercion mul_operator : mul_law >-> Funclass. +Coercion add_operator : add_law >-> com_law. +Notation "[ 'law' 'of' f ]" := (@clone_law _ _ f _ id _ _ _ id) + (at level 0, format"[ 'law' 'of' f ]") : form_scope. +Notation "[ 'com_law' 'of' f ]" := (@clone_com_law _ _ f _ _ id id _ id) + (at level 0, format "[ 'com_law' 'of' f ]") : form_scope. +Notation "[ 'mul_law' 'of' f ]" := (@clone_mul_law _ _ f _ id _ _ id) + (at level 0, format"[ 'mul_law' 'of' f ]") : form_scope. +Notation "[ 'add_law' m 'of' a ]" := (@clone_add_law _ _ m a _ _ id id _ _ id) + (at level 0, format "[ 'add_law' m 'of' a ]") : form_scope. +End Exports. + +Section CommutativeAxioms. + +Variable (T : Type) (zero one : T) (mul add : T -> T -> T) (inv : T -> T). +Hypothesis mulC : commutative mul. + +Lemma mulC_id : left_id one mul -> right_id one mul. +Proof. by move=> mul1x x; rewrite mulC. Qed. + +Lemma mulC_zero : left_zero zero mul -> right_zero zero mul. +Proof. by move=> mul0x x; rewrite mulC. Qed. + +Lemma mulC_dist : left_distributive mul add -> right_distributive mul add. +Proof. by move=> mul_addl x y z; rewrite !(mulC x). Qed. + +End CommutativeAxioms. +Module Theory. + +Section Theory. +Variables (T : Type) (idm : T). + +Section Plain. +Variable mul : law idm. +Lemma mul1m : left_id idm mul. Proof. by case mul. Qed. +Lemma mulm1 : right_id idm mul. Proof. by case mul. Qed. +Lemma mulmA : associative mul. Proof. by case mul. Qed. +(*Lemma iteropE n x : iterop n mul x idm = iter n (mul x) idm.*) + +End Plain. + +Section Commutative. +Variable mul : com_law idm. +Lemma mulmC : commutative mul. Proof. by case mul. Qed. +Lemma mulmCA : left_commutative mul. +Proof. by move=> x y z; rewrite !mulmA (mulmC x). Qed. +Lemma mulmAC : right_commutative mul. +Proof. by move=> x y z; rewrite -!mulmA (mulmC y). Qed. +Lemma mulmACA : interchange mul mul. +Proof. by move=> x y z t; rewrite -!mulmA (mulmCA y). Qed. +End Commutative. + +Section Mul. +Variable mul : mul_law idm. +Lemma mul0m : left_zero idm mul. Proof. by case mul. Qed. +Lemma mulm0 : right_zero idm mul. Proof. by case mul. Qed. +End Mul. + +Section Add. +Variables (mul : T -> T -> T) (add : add_law idm mul). +Lemma addmA : associative add. Proof. exact: mulmA. Qed. +Lemma addmC : commutative add. Proof. exact: mulmC. Qed. +Lemma addmCA : left_commutative add. Proof. exact: mulmCA. Qed. +Lemma addmAC : right_commutative add. Proof. exact: mulmAC. Qed. +Lemma add0m : left_id idm add. Proof. exact: mul1m. Qed. +Lemma addm0 : right_id idm add. Proof. exact: mulm1. Qed. +Lemma mulm_addl : left_distributive mul add. Proof. by case add. Qed. +Lemma mulm_addr : right_distributive mul add. Proof. by case add. Qed. +End Add. + +Definition simpm := (mulm1, mulm0, mul1m, mul0m, mulmA). + +End Theory. + +End Theory. +Include Theory. + +End Monoid. +Export Monoid.Exports. + +Section PervasiveMonoids. + +Import Monoid. + +Canonical andb_monoid := Law andbA andTb andbT. +Canonical andb_comoid := ComLaw andbC. + +Canonical andb_muloid := MulLaw andFb andbF. +Canonical orb_monoid := Law orbA orFb orbF. +Canonical orb_comoid := ComLaw orbC. +Canonical orb_muloid := MulLaw orTb orbT. +Canonical addb_monoid := Law addbA addFb addbF. +Canonical addb_comoid := ComLaw addbC. +Canonical orb_addoid := AddLaw andb_orl andb_orr. +Canonical andb_addoid := AddLaw orb_andl orb_andr. +Canonical addb_addoid := AddLaw andb_addl andb_addr. + +Canonical addn_monoid := Law addnA add0n addn0. +Canonical addn_comoid := ComLaw addnC. +Canonical muln_monoid := Law mulnA mul1n muln1. +Canonical muln_comoid := ComLaw mulnC. +Canonical muln_muloid := MulLaw mul0n muln0. +Canonical addn_addoid := AddLaw mulnDl mulnDr. + +Canonical cat_monoid T := Law (@catA T) (@cat0s T) (@cats0 T). + +End PervasiveMonoids. +Delimit Scope big_scope with BIG. +Open Scope big_scope. + +(* The bigbody wrapper is a workaround for a quirk of the Coq pretty-printer, *) +(* which would fail to redisplay the \big notation when the <general_term> or *) +(* <condition> do not depend on the bound index. The BigBody constructor *) +(* packages both in in a term in which i occurs; it also depends on the *) +(* iterated <op>, as this can give more information on the expected type of *) +(* the <general_term>, thus allowing for the insertion of coercions. *) +CoInductive bigbody R I := BigBody of I & (R -> R -> R) & bool & R. + +Definition applybig {R I} (body : bigbody R I) x := + let: BigBody _ op b v := body in if b then op v x else x. + +Definition reducebig R I idx r (body : I -> bigbody R I) := + foldr (applybig \o body) idx r. + +Module Type BigOpSig. +Parameter bigop : forall R I, R -> seq I -> (I -> bigbody R I) -> R. +Axiom bigopE : bigop = reducebig. +End BigOpSig. + +Module BigOp : BigOpSig. +Definition bigop := reducebig. +Lemma bigopE : bigop = reducebig. Proof. by []. Qed. +End BigOp. + +Notation bigop := BigOp.bigop (only parsing). +Canonical bigop_unlock := Unlockable BigOp.bigopE. + +Definition index_iota m n := iota m (n - m). + +Definition index_enum (T : finType) := Finite.enum T. + +Lemma mem_index_iota m n i : i \in index_iota m n = (m <= i < n). +Admitted. + +Lemma mem_index_enum T i : i \in index_enum T. +Admitted. + +Hint Resolve mem_index_enum. + +(* +Lemma filter_index_enum T P : filter P (index_enum T) = enum P. +Proof. by []. Qed. +*) + +Notation "\big [ op / idx ]_ ( i <- r | P ) F" := + (bigop idx r (fun i => BigBody i op P%B F)) : big_scope. +Notation "\big [ op / idx ]_ ( i <- r ) F" := + (bigop idx r (fun i => BigBody i op true F)) : big_scope. +Notation "\big [ op / idx ]_ ( m <= i < n | P ) F" := + (bigop idx (index_iota m n) (fun i : nat => BigBody i op P%B F)) + : big_scope. +Notation "\big [ op / idx ]_ ( m <= i < n ) F" := + (bigop idx (index_iota m n) (fun i : nat => BigBody i op true F)) + : big_scope. +Notation "\big [ op / idx ]_ ( i | P ) F" := + (bigop idx (index_enum _) (fun i => BigBody i op P%B F)) : big_scope. +Notation "\big [ op / idx ]_ i F" := + (bigop idx (index_enum _) (fun i => BigBody i op true F)) : big_scope. +Notation "\big [ op / idx ]_ ( i : t | P ) F" := + (bigop idx (index_enum _) (fun i : t => BigBody i op P%B F)) + (only parsing) : big_scope. +Notation "\big [ op / idx ]_ ( i : t ) F" := + (bigop idx (index_enum _) (fun i : t => BigBody i op true F)) + (only parsing) : big_scope. +Notation "\big [ op / idx ]_ ( i < n | P ) F" := + (\big[op/idx]_(i : ordinal n | P%B) F) : big_scope. +Notation "\big [ op / idx ]_ ( i < n ) F" := + (\big[op/idx]_(i : ordinal n) F) : big_scope. +Notation "\big [ op / idx ]_ ( i 'in' A | P ) F" := + (\big[op/idx]_(i | (i \in A) && P) F) : big_scope. +Notation "\big [ op / idx ]_ ( i 'in' A ) F" := + (\big[op/idx]_(i | i \in A) F) : big_scope. + +Notation BIG_F := (F in \big[_/_]_(i <- _ | _) F i)%pattern. +Notation BIG_P := (P in \big[_/_]_(i <- _ | P i) _)%pattern. + +(* Induction loading *) +Lemma big_load R (K K' : R -> Type) idx op I r (P : pred I) F : + K (\big[op/idx]_(i <- r | P i) F i) * K' (\big[op/idx]_(i <- r | P i) F i) + -> K' (\big[op/idx]_(i <- r | P i) F i). +Proof. by case. Qed. + +Arguments big_load [R] K [K'] idx op [I]. + +Section Elim3. + +Variables (R1 R2 R3 : Type) (K : R1 -> R2 -> R3 -> Type). +Variables (id1 : R1) (op1 : R1 -> R1 -> R1). +Variables (id2 : R2) (op2 : R2 -> R2 -> R2). +Variables (id3 : R3) (op3 : R3 -> R3 -> R3). + +Hypothesis Kid : K id1 id2 id3. + +Lemma big_rec3 I r (P : pred I) F1 F2 F3 + (K_F : forall i y1 y2 y3, P i -> K y1 y2 y3 -> + K (op1 (F1 i) y1) (op2 (F2 i) y2) (op3 (F3 i) y3)) : + K (\big[op1/id1]_(i <- r | P i) F1 i) + (\big[op2/id2]_(i <- r | P i) F2 i) + (\big[op3/id3]_(i <- r | P i) F3 i). +Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: K_F. Qed. + +Hypothesis Kop : forall x1 x2 x3 y1 y2 y3, + K x1 x2 x3 -> K y1 y2 y3-> K (op1 x1 y1) (op2 x2 y2) (op3 x3 y3). +Lemma big_ind3 I r (P : pred I) F1 F2 F3 + (K_F : forall i, P i -> K (F1 i) (F2 i) (F3 i)) : + K (\big[op1/id1]_(i <- r | P i) F1 i) + (\big[op2/id2]_(i <- r | P i) F2 i) + (\big[op3/id3]_(i <- r | P i) F3 i). +Proof. by apply: big_rec3 => i x1 x2 x3 /K_F; apply: Kop. Qed. + +End Elim3. + +Arguments big_rec3 [R1 R2 R3] K [id1 op1 id2 op2 id3 op3] _ [I r P F1 F2 F3]. +Arguments big_ind3 [R1 R2 R3] K [id1 op1 id2 op2 id3 op3] _ _ [I r P F1 F2 F3]. + +Section Elim2. + +Variables (R1 R2 : Type) (K : R1 -> R2 -> Type) (f : R2 -> R1). +Variables (id1 : R1) (op1 : R1 -> R1 -> R1). +Variables (id2 : R2) (op2 : R2 -> R2 -> R2). + +Hypothesis Kid : K id1 id2. + +Lemma big_rec2 I r (P : pred I) F1 F2 + (K_F : forall i y1 y2, P i -> K y1 y2 -> + K (op1 (F1 i) y1) (op2 (F2 i) y2)) : + K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i). +Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: K_F. Qed. + +Hypothesis Kop : forall x1 x2 y1 y2, + K x1 x2 -> K y1 y2 -> K (op1 x1 y1) (op2 x2 y2). +Lemma big_ind2 I r (P : pred I) F1 F2 (K_F : forall i, P i -> K (F1 i) (F2 i)) : + K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i). +Proof. by apply: big_rec2 => i x1 x2 /K_F; apply: Kop. Qed. + +Hypotheses (f_op : {morph f : x y / op2 x y >-> op1 x y}) (f_id : f id2 = id1). +Lemma big_morph I r (P : pred I) F : + f (\big[op2/id2]_(i <- r | P i) F i) = \big[op1/id1]_(i <- r | P i) f (F i). +Proof. by rewrite unlock; elim: r => //= i r <-; rewrite -f_op -fun_if. Qed. + +End Elim2. + +Arguments big_rec2 [R1 R2] K [id1 op1 id2 op2] _ [I r P F1 F2]. +Arguments big_ind2 [R1 R2] K [id1 op1 id2 op2] _ _ [I r P F1 F2]. +Arguments big_morph [R1 R2] f [id1 op1 id2 op2] _ _ [I]. + +Section Elim1. + +Variables (R : Type) (K : R -> Type) (f : R -> R). +Variables (idx : R) (op op' : R -> R -> R). + +Hypothesis Kid : K idx. + +Lemma big_rec I r (P : pred I) F + (Kop : forall i x, P i -> K x -> K (op (F i) x)) : + K (\big[op/idx]_(i <- r | P i) F i). +Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: Kop. Qed. + +Hypothesis Kop : forall x y, K x -> K y -> K (op x y). +Lemma big_ind I r (P : pred I) F (K_F : forall i, P i -> K (F i)) : + K (\big[op/idx]_(i <- r | P i) F i). +Proof. by apply: big_rec => // i x /K_F /Kop; apply. Qed. + +Hypothesis Kop' : forall x y, K x -> K y -> op x y = op' x y. +Lemma eq_big_op I r (P : pred I) F (K_F : forall i, P i -> K (F i)) : + \big[op/idx]_(i <- r | P i) F i = \big[op'/idx]_(i <- r | P i) F i. +Proof. +by elim/(big_load K): _; elim/big_rec2: _ => // i _ y Pi [Ky <-]; auto. +Qed. + +Hypotheses (fM : {morph f : x y / op x y}) (f_id : f idx = idx). +Lemma big_endo I r (P : pred I) F : + f (\big[op/idx]_(i <- r | P i) F i) = \big[op/idx]_(i <- r | P i) f (F i). +Proof. exact: big_morph. Qed. + +End Elim1. + +Arguments big_rec [R] K [idx op] _ [I r P F]. +Arguments big_ind [R] K [idx op] _ _ [I r P F]. +Arguments eq_big_op [R] K [idx op] op' _ _ _ [I]. +Arguments big_endo [R] f [idx op] _ _ [I]. + +(* zmodp -------------------------------------------------------------------- *) + +Lemma ord1 : all_equal_to (@Ordinal 1 0 is_true_true : 'I_1). +Admitted. diff --git a/test-suite/prerequisite/ssr_ssrsyntax1.v b/test-suite/prerequisite/ssr_ssrsyntax1.v new file mode 100644 index 00000000..2b404e2d --- /dev/null +++ b/test-suite/prerequisite/ssr_ssrsyntax1.v @@ -0,0 +1,36 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require ssreflect. +Require Import Arith. + +Goal (forall a b, a + b = b + a). +intros. +rewrite plus_comm, plus_comm. +split. +Abort. + +Module Foo. +Import ssreflect. + +Goal (forall a b, a + b = b + a). +intros. +rewrite 2![_ + _]plus_comm. +split. +Abort. +End Foo. + +Goal (forall a b, a + b = b + a). +intros. +rewrite plus_comm, plus_comm. +split. +Abort. diff --git a/test-suite/report.sh b/test-suite/report.sh new file mode 100755 index 00000000..05f39b4b --- /dev/null +++ b/test-suite/report.sh @@ -0,0 +1,55 @@ +#!/usr/bin/env bash + +# save failed logs to logs/, then print failure information +# returns failure code if any failed logs exist + +# save step + +SAVEDIR="logs" + +# reset for local builds +rm -rf "$SAVEDIR" +mkdir "$SAVEDIR" + +# keep this synced with test-suite/Makefile +FAILMARK="==========> FAILURE <==========" + +FAILED=$(mktemp /tmp/coq-check-XXXXXX) +find . '(' -path ./bugs/opened -prune ')' -o '(' -name '*.log' -exec grep "$FAILMARK" -q '{}' ';' -print0 ')' > "$FAILED" + +rsync -a --from0 --files-from="$FAILED" . "$SAVEDIR" +cp summary.log "$SAVEDIR"/ + +# cleanup +rm "$FAILED" + +# print info +if [ -n "$TRAVIS" ] || [ -n "$PRINT_LOGS" ]; then + find logs/ -name '*.log' -not -name 'summary.log' -print0 | while IFS= read -r -d '' file; do + if [ -n "$TRAVIS" ]; then + # ${foo////.} replaces every / by . in $foo + printf 'travis_fold:start:coq.logs.%s\n' "${file////.}"; + else printf '%s\n' "$file" + fi + + cat "$file" + + if [ -n "$TRAVIS" ]; then + # ${foo////.} replaces every / by . in $foo + printf 'travis_fold:end:coq.logs.%s\n' "${file////.}"; + else printf '\n' + fi + done +fi + +if grep -q -F 'Error!' summary.log ; then + echo FAILURES; + grep -F 'Error!' summary.log; + if [ -z "$TRAVIS" ] && [ -z "$PRINT_LOGS" ]; then + echo 'To print details of failed tests, rerun with environment variable PRINT_LOGS=1' + echo 'eg "make report PRINT_LOGS=1" from the test suite directory"' + echo 'See README.md in the test suite directory for more information.' + fi + false +else echo NO FAILURES; +fi diff --git a/test-suite/save-logs.sh b/test-suite/save-logs.sh deleted file mode 100755 index 9b8fff09..00000000 --- a/test-suite/save-logs.sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/bin/env bash - -SAVEDIR="logs" - -# reset for local builds -rm -rf "$SAVEDIR" -mkdir "$SAVEDIR" - -# keep this synced with test-suite/Makefile -FAILMARK="==========> FAILURE <==========" - -FAILED=$(mktemp /tmp/coq-check-XXXXXX) -find . '(' -path ./bugs/opened -prune ')' -o '(' -name '*.log' -exec grep "$FAILMARK" -q '{}' ';' -print0 ')' > "$FAILED" - -rsync -a --from0 --files-from="$FAILED" . "$SAVEDIR" -cp summary.log "$SAVEDIR"/ - -# cleanup -rm "$FAILED" diff --git a/test-suite/ssr/absevarprop.v b/test-suite/ssr/absevarprop.v new file mode 100644 index 00000000..fa1de009 --- /dev/null +++ b/test-suite/ssr/absevarprop.v @@ -0,0 +1,96 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect ssrbool ssrfun. +Require Import TestSuite.ssr_mini_mathcomp. + +Lemma test15: forall (y : nat) (x : 'I_2), y < 1 -> val x = y -> Some x = insub y. +move=> y x le_1 defx; rewrite insubT ?(leq_trans le_1) // => ?. +by congr (Some _); apply: val_inj=> /=; exact: defx. +Qed. + +Axiom P : nat -> Prop. +Axiom Q : forall n, P n -> Prop. +Definition R := fun (x : nat) (p : P x) m (q : P (x+1)) => m > 0. + +Inductive myEx : Type := ExI : forall n (pn : P n) pn', Q n pn -> R n pn n pn' -> myEx. + +Variable P1 : P 1. +Variable P11 : P (1 + 1). +Variable Q1 : forall P1, Q 1 P1. + +Lemma testmE1 : myEx. +Proof. +apply: ExI 1 _ _ _ _. + match goal with |- P 1 => exact: P1 | _ => fail end. + match goal with |- P (1+1) => exact: P11 | _ => fail end. + match goal with |- forall p : P 1, Q 1 p => move=> *; exact: Q1 | _ => fail end. +match goal with |- forall (p : P 1) (q : P (1+1)), is_true (R 1 p 1 q) => done | _ => fail end. +Qed. + +Lemma testE2 : exists y : { x | P x }, sval y = 1. +Proof. +apply: ex_intro (exist _ 1 _) _. + match goal with |- P 1 => exact: P1 | _ => fail end. +match goal with |- forall p : P 1, @sval _ _ (@exist _ _ 1 p) = 1 => done | _ => fail end. +Qed. + +Lemma testE3 : exists y : { x | P x }, sval y = 1. +Proof. +have := (ex_intro _ (exist _ 1 _) _); apply. + match goal with |- P 1 => exact: P1 | _ => fail end. +match goal with |- forall p : P 1, @sval _ _ (@exist _ _ 1 p) = 1 => done | _ => fail end. +Qed. + +Lemma testE4 : P 2 -> exists y : { x | P x }, sval y = 2. +Proof. +move=> P2; apply: ex_intro (exist _ 2 _) _. +match goal with |- @sval _ _ (@exist _ _ 2 P2) = 2 => done | _ => fail end. +Qed. + +Hint Resolve P1. + +Lemma testmE12 : myEx. +Proof. +apply: ExI 1 _ _ _ _. + match goal with |- P (1+1) => exact: P11 | _ => fail end. + match goal with |- Q 1 P1 => exact: Q1 | _ => fail end. +match goal with |- forall (q : P (1+1)), is_true (R 1 P1 1 q) => done | _ => fail end. +Qed. + +Create HintDb SSR. + +Hint Resolve P11 : SSR. + +Ltac ssrautoprop := trivial with SSR. + +Lemma testmE13 : myEx. +Proof. +apply: ExI 1 _ _ _ _. + match goal with |- Q 1 P1 => exact: Q1 | _ => fail end. +match goal with |- is_true (R 1 P1 1 P11) => done | _ => fail end. +Qed. + +Definition R1 := fun (x : nat) (p : P x) m (q : P (x+1)) (r : Q x p) => m > 0. + +Inductive myEx1 : Type := + ExI1 : forall n (pn : P n) pn' (q : Q n pn), R1 n pn n pn' q -> myEx1. + +Hint Resolve (Q1 P1) : SSR. + +(* tests that goals in prop are solved in the right order, propagating instantiations, + thus the goal Q 1 ?p1 is faced by trivial after ?p1, and is thus evar free *) +Lemma testmE14 : myEx1. +Proof. +apply: ExI1 1 _ _ _ _. +match goal with |- is_true (R1 1 P1 1 P11 (Q1 P1)) => done | _ => fail end. +Qed. diff --git a/test-suite/ssr/abstract_var2.v b/test-suite/ssr/abstract_var2.v new file mode 100644 index 00000000..7c57d202 --- /dev/null +++ b/test-suite/ssr/abstract_var2.v @@ -0,0 +1,25 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +Require Import ssreflect. + +Set Implicit Arguments. + +Axiom P : nat -> nat -> Prop. + +Axiom tr : + forall x y z, P x y -> P y z -> P x z. + +Lemma test a b c : P a c -> P a b. +Proof. +intro H. +Fail have [: s1 s2] H1 : P a b := @tr _ _ _ s1 s2. +have [: w s1 s2] H1 : P a b := @tr _ w _ s1 s2. +Abort. diff --git a/test-suite/ssr/binders.v b/test-suite/ssr/binders.v new file mode 100644 index 00000000..97b7d830 --- /dev/null +++ b/test-suite/ssr/binders.v @@ -0,0 +1,55 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Lemma test (x : bool) : True. +have H1 x := x. +have (x) := x => H2. +have H3 T (x : T) := x. +have ? : bool := H1 _ x. +have ? : bool := H2 _ x. +have ? : bool := H3 _ x. +have ? (z : bool) : forall y : bool, z = z := fun y => refl_equal _. +have ? w : w = w := @refl_equal nat w. +have ? y : true by []. +have ? (z : bool) : z = z. + exact: (@refl_equal _ z). +have ? (z w : bool) : z = z by exact: (@refl_equal _ z). +have H w (a := 3) (_ := 4) : w && true = w. + by rewrite andbT. +exact I. +Qed. + +Lemma test1 : True. +suff (x : bool): x = x /\ True. + by move/(_ true); case=> _. +split; first by exact: (@refl_equal _ x). +suff H y : y && true = y /\ True. + by case: (H true). +suff H1 /= : true && true /\ True. + by rewrite andbT; split; [exact: (@refl_equal _ y) | exact: I]. +match goal with |- is_true true /\ True => idtac end. +by split. +Qed. + +Lemma foo n : n >= 0. +have f i (j := i + n) : j < n. + match goal with j := i + n |- _ => idtac end. +Undo 2. +suff f i (j := i + n) : j < n. + done. +match goal with j := i + n |- _ => idtac end. +Undo 3. +done. +Qed. diff --git a/test-suite/ssr/binders_of.v b/test-suite/ssr/binders_of.v new file mode 100644 index 00000000..69b52eac --- /dev/null +++ b/test-suite/ssr/binders_of.v @@ -0,0 +1,23 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + + +Require Import ssreflect. +Require Import TestSuite.ssr_mini_mathcomp. + +Lemma test1 : True. +have f of seq nat & nat : nat. + exact 3. +have g of nat := 3. +have h of nat : nat := 3. +have _ : f [::] 3 = g 3 + h 4. +Admitted. diff --git a/test-suite/ssr/caseview.v b/test-suite/ssr/caseview.v new file mode 100644 index 00000000..94b064b0 --- /dev/null +++ b/test-suite/ssr/caseview.v @@ -0,0 +1,17 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + + +Lemma test (A B : Prop) : A /\ B -> True. +Proof. by case=> _ /id _. Qed. diff --git a/test-suite/ssr/congr.v b/test-suite/ssr/congr.v new file mode 100644 index 00000000..7e60b04a --- /dev/null +++ b/test-suite/ssr/congr.v @@ -0,0 +1,34 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Lemma test1 : forall a b : nat, a == b -> a == 0 -> b == 0. +Proof. move=> a b Eab Eac; congr (_ == 0) : Eac; exact: eqP Eab. Qed. + +Definition arrow A B := A -> B. + +Lemma test2 : forall a b : nat, a == b -> arrow (a == 0) (b == 0). +Proof. move=> a b Eab; congr (_ == 0); exact: eqP Eab. Qed. + +Definition equals T (A B : T) := A = B. + +Lemma test3 : forall a b : nat, a = b -> equals nat (a + b) (b + b). +Proof. move=> a b E; congr (_ + _); exact E. Qed. + +Variable S : eqType. +Variable f : nat -> S. +Coercion f : nat >-> Equality.sort. + +Lemma test4 : forall a b : nat, b = a -> @eq S (b + b) (a + a). +Proof. move=> a b Eba; congr (_ + _); exact: Eba. Qed. diff --git a/test-suite/ssr/deferclear.v b/test-suite/ssr/deferclear.v new file mode 100644 index 00000000..85353dad --- /dev/null +++ b/test-suite/ssr/deferclear.v @@ -0,0 +1,37 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Variable T : Type. + +Lemma test0 : forall a b c d : T, True. +Proof. by move=> a b {a} a c; exact I. Qed. + +Variable P : T -> Prop. + +Lemma test1 : forall a b c : T, P a -> forall d : T, True. +Proof. move=> a b {a} a _ d; exact I. Qed. + +Definition Q := forall x y : nat, x = y. +Axiom L : 0 = 0 -> Q. +Axiom L' : 0 = 0 -> forall x y : nat, x = y. +Lemma test3 : Q. +by apply/L. +Undo. +rewrite /Q. +by apply/L. +Undo 2. +by apply/L'. +Qed. diff --git a/test-suite/success/ssr_delayed_clear_rename.v b/test-suite/ssr/delayed_clear_rename.v index 951e5aff..951e5aff 100644 --- a/test-suite/success/ssr_delayed_clear_rename.v +++ b/test-suite/ssr/delayed_clear_rename.v diff --git a/test-suite/ssr/dependent_type_err.v b/test-suite/ssr/dependent_type_err.v new file mode 100644 index 00000000..a5789d8d --- /dev/null +++ b/test-suite/ssr/dependent_type_err.v @@ -0,0 +1,20 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrfun ssrbool TestSuite.ssr_mini_mathcomp. + +Lemma ltn_leq_trans : forall n m p : nat, m < n -> n <= p -> m < p. +move=> n m p Hmn Hnp; rewrite -ltnS. +Fail rewrite (_ : forall n0 m0 p0 : nat, m0 <= n0 -> n0 < p0 -> m0 < p0). +Fail rewrite leq_ltn_trans. +Admitted. diff --git a/test-suite/ssr/derive_inversion.v b/test-suite/ssr/derive_inversion.v new file mode 100644 index 00000000..abf63a20 --- /dev/null +++ b/test-suite/ssr/derive_inversion.v @@ -0,0 +1,29 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +Require Import ssreflect ssrbool. + +Set Implicit Arguments. + + Inductive wf T : bool -> option T -> Type := + | wf_f : wf false None + | wf_t : forall x, wf true (Some x). + + Derive Inversion wf_inv with (forall T b (o : option T), wf b o) Sort Prop. + + Lemma Problem T b (o : option T) : + wf b o -> + match b with + | true => exists x, o = Some x + | false => o = None + end. + Proof. + by case: b; elim/wf_inv=> //; case: o=> // a *; exists a. + Qed. diff --git a/test-suite/ssr/elim.v b/test-suite/ssr/elim.v new file mode 100644 index 00000000..908249a3 --- /dev/null +++ b/test-suite/ssr/elim.v @@ -0,0 +1,279 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool ssrfun TestSuite.ssr_mini_mathcomp. +Axiom daemon : False. Ltac myadmit := case: daemon. + +(* Ltac debugging feature: recursive elim + eq generation *) +Lemma testL1 : forall A (s : seq A), s = s. +Proof. +move=> A s; elim branch: s => [|x xs _]. +match goal with _ : _ = [::] |- [::] = [::] => move: branch => // | _ => fail end. +match goal with _ : _ = _ :: _ |- _ :: _ = _ :: _ => move: branch => // | _ => fail end. +Qed. + +(* The same but with explicit eliminator and a conflict in the intro pattern *) +Lemma testL2 : forall A (s : seq A), s = s. +Proof. +move=> A s; elim/last_ind branch: s => [|x s _]. +match goal with _ : _ = [::] |- [::] = [::] => move: branch => // | _ => fail end. +match goal with _ : _ = rcons _ _ |- rcons _ _ = rcons _ _ => move: branch => // | _ => fail end. +Qed. + +(* The same but without names for variables involved in the generated eq *) +Lemma testL3 : forall A (s : seq A), s = s. +Proof. +move=> A s; elim branch: s; move: (s) => _. +match goal with _ : _ = [::] |- [::] = [::] => move: branch => // | _ => fail end. +move=> _; match goal with _ : _ = _ :: _ |- _ :: _ = _ :: _ => move: branch => // | _ => fail end. +Qed. + +Inductive foo : Type := K1 : foo | K2 : foo -> foo -> foo | K3 : (nat -> foo) -> foo. + +(* The same but with more intros to be done *) +Lemma testL4 : forall (o : foo), o = o. +Proof. +move=> o; elim branch: o. +match goal with _ : _ = K1 |- K1 = K1 => move: branch => // | _ => fail end. +move=> _; match goal with _ : _ = K2 _ _ |- K2 _ _ = K2 _ _ => move: branch => // | _ => fail end. +move=> _; match goal with _ : _ = K3 _ |- K3 _ = K3 _ => move: branch => // | _ => fail end. +Qed. + +(* Occurrence counting *) +Lemma testO1: forall (b : bool), b = b. +Proof. +move=> b; case: (b) / idP. +match goal with |- is_true b -> true = true => done | _ => fail end. +match goal with |- ~ is_true b -> false = false => done | _ => fail end. +Qed. + +(* The same but only the second occ *) +Lemma testO2: forall (b : bool), b = b. +Proof. +move=> b; case: {2}(b) / idP. +match goal with |- is_true b -> b = true => done | _ => fail end. +match goal with |- ~ is_true b -> b = false => move/(introF idP) => // | _ => fail end. +Qed. + +(* The same but with eq generation *) +Lemma testO3: forall (b : bool), b = b. +Proof. +move=> b; case E: {2}(b) / idP. +match goal with _ : is_true b, _ : b = true |- b = true => move: E => _; done | _ => fail end. +match goal with H : ~ is_true b, _ : b = false |- b = false => move: E => _; move/(introF idP): H => // | _ => fail end. +Qed. + +(* Views *) +Lemma testV1 : forall A (s : seq A), s = s. +Proof. +move=> A s; case/lastP E: {1}s => [| x xs]. +match goal with _ : s = [::] |- [::] = s => symmetry; exact E | _ => fail end. +match goal with _ : s = rcons x xs |- rcons _ _ = s => symmetry; exact E | _ => fail end. +Qed. + +Lemma testV2 : forall A (s : seq A), s = s. +Proof. +move=> A s; case/lastP E: s => [| x xs]. +match goal with _ : s = [::] |- [::] = [::] => done | _ => fail end. +match goal with _ : s = rcons x xs |- rcons _ _ = rcons _ _ => done | _ => fail end. +Qed. + +Lemma testV3 : forall A (s : seq A), s = s. +Proof. +move=> A s; case/lastP: s => [| x xs]. +match goal with |- [::] = [::] => done | _ => fail end. +match goal with |- rcons _ _ = rcons _ _ => done | _ => fail end. +Qed. + +(* Patterns *) +Lemma testP1: forall (x y : nat), (y == x) && (y == x) -> y == x. +move=> x y; elim: {2}(_ == _) / eqP. +match goal with |- (y = x -> is_true ((y == x) && true) -> is_true (y == x)) => move=> -> // | _ => fail end. +match goal with |- (y <> x -> is_true ((y == x) && false) -> is_true (y == x)) => move=> _; rewrite andbC // | _ => fail end. +Qed. + +(* The same but with an implicit pattern *) +Lemma testP2 : forall (x y : nat), (y == x) && (y == x) -> y == x. +move=> x y; elim: {2}_ / eqP. +match goal with |- (y = x -> is_true ((y == x) && true) -> is_true (y == x)) => move=> -> // | _ => fail end. +match goal with |- (y <> x -> is_true ((y == x) && false) -> is_true (y == x)) => move=> _; rewrite andbC // | _ => fail end. +Qed. + +(* The same but with an eq generation switch *) +Lemma testP3 : forall (x y : nat), (y == x) && (y == x) -> y == x. +move=> x y; elim E: {2}_ / eqP. +match goal with _ : y = x |- (is_true ((y == x) && true) -> is_true (y == x)) => rewrite E; reflexivity | _ => fail end. +match goal with _ : y <> x |- (is_true ((y == x) && false) -> is_true (y == x)) => rewrite E => /= H; exact H | _ => fail end. +Qed. + +Inductive spec : nat -> nat -> nat -> Prop := +| specK : forall a b c, a = 0 -> b = 2 -> c = 4 -> spec a b c. +Lemma specP : spec 0 2 4. Proof. by constructor. Qed. + +Lemma testP4 : (1+1) * 4 = 2 + (1+1) + (2 + 2). +Proof. +case: specP => a b c defa defb defc. +match goal with |- (a.+1 + a.+1) * c = b + (a.+1 + a.+1) + (b + b) => subst; done | _ => fail end. +Qed. + +Lemma testP5 : (1+1) * 4 = 2 + (1+1) + (2 + 2). +Proof. +case: (1 + 1) _ / specP => a b c defa defb defc. +match goal with |- b * c = a.+2 + b + (a.+2 + a.+2) => subst; done | _ => fail end. +Qed. + +Lemma testP6 : (1+1) * 4 = 2 + (1+1) + (2 + 2). +Proof. +case: {2}(1 + 1) _ / specP => a b c defa defb defc. +match goal with |- (a.+1 + a.+1) * c = a.+2 + b + (a.+2 + a.+2) => subst; done | _ => fail end. +Qed. + +Lemma testP7 : (1+1) * 4 = 2 + (1+1) + (2 + 2). +Proof. +case: _ (1 + 1) (2 + _) / specP => a b c defa defb defc. +match goal with |- b * a.+4 = c + c => subst; done | _ => fail end. +Qed. + +Lemma testP8 : (1+1) * 4 = 2 + (1+1) + (2 + 2). +Proof. +case E: (1 + 1) (2 + _) / specP=> [a b c defa defb defc]. +match goal with |- b * a.+4 = c + c => subst; done | _ => fail end. +Qed. + +Variables (T : Type) (tr : T -> T). + +Inductive exec (cf0 cf1 : T) : seq T -> Prop := +| exec_step : tr cf0 = cf1 -> exec cf0 cf1 [::] +| exec_star : forall cf2 t, tr cf0 = cf2 -> + exec cf2 cf1 t -> exec cf0 cf1 (cf2 :: t). + +Inductive execr (cf0 cf1 : T) : seq T -> Prop := +| execr_step : tr cf0 = cf1 -> execr cf0 cf1 [::] +| execr_star : forall cf2 t, execr cf0 cf2 t -> + tr cf2 = cf1 -> execr cf0 cf1 (t ++ [:: cf2]). + +Lemma execP : forall cf0 cf1 t, exec cf0 cf1 t <-> execr cf0 cf1 t. +Proof. +move=> cf0 cf1 t; split => [] Ecf. + elim: Ecf. + match goal with |- forall cf2 cf3 : T, tr cf2 = cf3 -> + execr cf2 cf3 [::] => myadmit | _ => fail end. + match goal with |- forall (cf2 cf3 cf4 : T) (t0 : seq T), + tr cf2 = cf4 -> exec cf4 cf3 t0 -> execr cf4 cf3 t0 -> + execr cf2 cf3 (cf4 :: t0) => myadmit | _ => fail end. +elim: Ecf. + match goal with |- forall cf2 : T, + tr cf0 = cf2 -> exec cf0 cf2 [::] => myadmit | _ => fail end. +match goal with |- forall (cf2 cf3 : T) (t0 : seq T), + execr cf0 cf3 t0 -> exec cf0 cf3 t0 -> tr cf3 = cf2 -> + exec cf0 cf2 (t0 ++ [:: cf3]) => myadmit | _ => fail end. +Qed. + +Fixpoint plus (m n : nat) {struct n} : nat := + match n with + | 0 => m + | S p => S (plus m p) + end. + +Definition plus_equation : +forall m n : nat, + plus m n = + match n with + | 0 => m + | p.+1 => (plus m p).+1 + end +:= +fun m n : nat => +match + n as n0 + return + (forall m0 : nat, + plus m0 n0 = + match n0 with + | 0 => m0 + | p.+1 => (plus m0 p).+1 + end) +with +| 0 => @erefl nat +| n0.+1 => fun m0 : nat => erefl (plus m0 n0).+1 +end m. + +Definition plus_rect : +forall (m : nat) (P : nat -> nat -> Type), + (forall n : nat, n = 0 -> P 0 m) -> + (forall n p : nat, + n = p.+1 -> P p (plus m p) -> P p.+1 (plus m p).+1) -> + forall n : nat, P n (plus m n) +:= +fun (m : nat) (P : nat -> nat -> Type) + (f0 : forall n : nat, n = 0 -> P 0 m) + (f : forall n p : nat, + n = p.+1 -> P p (plus m p) -> P p.+1 (plus m p).+1) => +fix plus0 (n : nat) : P n (plus m n) := + eq_rect_r [eta P n] + (let f1 := f0 n in + let f2 := f n in + match + n as n0 + return + (n = n0 -> + (forall p : nat, + n0 = p.+1 -> P p (plus m p) -> P p.+1 (plus m p).+1) -> + (n0 = 0 -> P 0 m) -> + P n0 match n0 with + | 0 => m + | p.+1 => (plus m p).+1 + end) + with + | 0 => + fun (_ : n = 0) + (_ : forall p : nat, + 0 = p.+1 -> + P p (plus m p) -> P p.+1 (plus m p).+1) + (f4 : 0 = 0 -> P 0 m) => unkeyed (f4 (erefl 0)) + | n0.+1 => + fun (_ : n = n0.+1) + (f3 : forall p : nat, + n0.+1 = p.+1 -> + P p (plus m p) -> P p.+1 (plus m p).+1) + (_ : n0.+1 = 0 -> P 0 m) => + let f5 := + let p := n0 in + let H := erefl n0.+1 : n0.+1 = p.+1 in f3 p H in + unkeyed (let Hrec := plus0 n0 in f5 Hrec) + end (erefl n) f2 f1) (plus_equation m n). + +Definition plus_ind := plus_rect. + +Lemma exF x y z: plus (plus x y) z = plus x (plus y z). +elim/plus_ind: z / (plus _ z). +match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. +Undo 2. +elim/plus_ind: (plus _ z). +match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. +Undo 2. +elim/plus_ind: {z}(plus _ z). +match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. +Undo 2. +elim/plus_ind: {z}_. +match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. +Undo 2. +elim/plus_ind: z / _. +match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. + done. +by move=> _ p _ ->. +Qed. + +(* BUG elim-False *) +Lemma testeF : False -> 1 = 0. +Proof. by elim. Qed. diff --git a/test-suite/ssr/elim2.v b/test-suite/ssr/elim2.v new file mode 100644 index 00000000..c7c20d8f --- /dev/null +++ b/test-suite/ssr/elim2.v @@ -0,0 +1,74 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. +(* div fintype finfun path bigop. *) + +Axiom daemon : False. Ltac myadmit := case: daemon. + +Lemma big_load R (K K' : R -> Type) idx op I r (P : pred I) F : + let s := \big[op/idx]_(i <- r | P i) F i in + K s * K' s -> K' s. +Proof. by move=> /= [_]. Qed. +Arguments big_load [R] K [K' idx op I r P F]. + +Section Elim1. + +Variables (R : Type) (K : R -> Type) (f : R -> R). +Variables (idx : R) (op op' : R -> R -> R). + +Hypothesis Kid : K idx. + +Ltac ASSERT1 := match goal with |- (K idx) => myadmit end. +Ltac ASSERT2 K := match goal with |- (forall x1 : R, R -> + forall y1 : R, R -> K x1 -> K y1 -> K (op x1 y1)) => myadmit end. + + +Lemma big_rec I r (P : pred I) F + (Kop : forall i x, P i -> K x -> K (op (F i) x)) : + K (\big[op/idx]_(i <- r | P i) F i). +Proof. +elim/big_ind2: {-}_. + ASSERT1. ASSERT2 K. match goal with |- (forall i : I, is_true (P i) -> K (F i)) => myadmit end. Undo 4. +elim/big_ind2: _ / {-}_. + ASSERT1. ASSERT2 K. match goal with |- (forall i : I, is_true (P i) -> K (F i)) => myadmit end. Undo 4. + +elim/big_rec2: (\big[op/idx]_(i <- r | P i) op idx (F i)) + / (\big[op/idx]_(i <- r | P i) F i). + ASSERT1. match goal with |- (forall i : I, R -> forall y2 : R, is_true (P i) -> K y2 -> K (op (F i) y2)) => myadmit end. Undo 3. + +elim/(big_load (phantom R)): _. + Undo. + +Fail elim/big_rec2: {2}_. + +elim/big_rec2: (\big[op/idx]_(i <- r | P i) F i) + / {1}(\big[op/idx]_(i <- r | P i) F i). + Undo. + +elim/(big_load (phantom R)): _. +Undo. + +Fail elim/big_rec2: _ / {2}(\big[op/idx]_(i <- r | P i) F i). +Admitted. + +Definition morecomplexthannecessary A (P : A -> A -> Prop) x y := P x y. + +Lemma grab A (P : A -> A -> Prop) n m : (n = m) -> (P n n) -> morecomplexthannecessary A P n m. +by move->. +Qed. + +Goal forall n m, m + (n + m) = m + (n * 1 + m). +Proof. move=> n m; elim/grab : (_ * _) / {1}n => //; exact: muln1. Qed. + +End Elim1. diff --git a/test-suite/ssr/elim_pattern.v b/test-suite/ssr/elim_pattern.v new file mode 100644 index 00000000..ef465828 --- /dev/null +++ b/test-suite/ssr/elim_pattern.v @@ -0,0 +1,27 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. +Axiom daemon : False. Ltac myadmit := case: daemon. + +Lemma test x : (x == x) = (x + x.+1 == 2 * x + 1). +case: (X in _ = X) / eqP => _. +match goal with |- (x == x) = true => myadmit end. +match goal with |- (x == x) = false => myadmit end. +Qed. + +Lemma test1 x : (x == x) = (x + x.+1 == 2 * x + 1). +elim: (x in RHS). +match goal with |- (x == x) = _ => myadmit end. +match goal with |- forall n, (x == x) = _ -> (x == x) = _ => myadmit end. +Qed. diff --git a/test-suite/ssr/first_n.v b/test-suite/ssr/first_n.v new file mode 100644 index 00000000..4971add9 --- /dev/null +++ b/test-suite/ssr/first_n.v @@ -0,0 +1,21 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool. + +Lemma test : False -> (bool -> False -> True -> True) -> True. +move=> F; let w := constr:(2) in apply; last w first. +- by apply: F. +- by apply: I. +- by apply: true. +Qed. diff --git a/test-suite/ssr/gen_have.v b/test-suite/ssr/gen_have.v new file mode 100644 index 00000000..249e006f --- /dev/null +++ b/test-suite/ssr/gen_have.v @@ -0,0 +1,174 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrfun ssrbool TestSuite.ssr_mini_mathcomp. +Axiom daemon : False. Ltac myadmit := case: daemon. + +Axiom P : nat -> Prop. +Lemma clear_test (b1 b2 : bool) : b2 = b2. +Proof. +(* wlog gH : (b3 := b2) / b2 = b3. myadmit. *) +gen have {b1} H, gH : (b3 := b2) (w := erefl 3) / b2 = b3. + myadmit. +Fail exact (H b1). +exact (H b2 (erefl _)). +Qed. + + +Lemma test1 n (ngt0 : 0 < n) : P n. +gen have lt2le, /andP[H1 H2] : n ngt0 / (0 <= n) && (n != 0). + match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. +Check (lt2le : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). +Check (H1 : 0 <= n). +Check (H2 : n != 0). +myadmit. +Qed. + +Lemma test2 n (ngt0 : 0 < n) : P n. +gen have _, /andP[H1 H2] : n ngt0 / (0 <= n) && (n != 0). + match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. +lazymatch goal with + | lt2le : forall n : nat, is_true(0 < n) -> is_true((0 <= n) && (n != 0)) + |- _ => fail "not cleared" + | _ => idtac end. +Check (H1 : 0 <= n). +Check (H2 : n != 0). +myadmit. +Qed. + +Lemma test3 n (ngt0 : 0 < n) : P n. +gen have H : n ngt0 / (0 <= n) && (n != 0). + match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. +Check (H : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). +myadmit. +Qed. + +Lemma test4 n (ngt0 : 0 < n) : P n. +gen have : n ngt0 / (0 <= n) && (n != 0). + match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. +move=> H. +Check(H : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). +myadmit. +Qed. + +Lemma test4bis n (ngt0 : 0 < n) : P n. +wlog suff : n ngt0 / (0 <= n) && (n != 0); last first. + match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. +move=> H. +Check(H : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). +myadmit. +Qed. + +Lemma test5 n (ngt0 : 0 < n) : P n. +Fail gen have : / (0 <= n) && (n != 0). +Abort. + +Lemma test6 n (ngt0 : 0 < n) : P n. +gen have : n ngt0 / (0 <= n) && (n != 0) by myadmit. +Abort. + +Lemma test7 n (ngt0 : 0 < n) : P n. +Fail gen have : n / (0 <= n) && (n != 0). +Abort. + +Lemma test3wlog2 n (ngt0 : 0 < n) : P n. +gen have H : (m := n) ngt0 / (0 <= m) && (m != 0). + match goal with + ngt0 : is_true(0 < m) |- is_true((0 <= m) && (m != 0)) => myadmit end. +Check (H : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). +myadmit. +Qed. + +Lemma test3wlog3 n (ngt0 : 0 < n) : P n. +gen have H : {n} (m := n) (n := 0) ngt0 / (0 <= m) && (m != n). + match goal with + ngt0 : is_true(n < m) |- is_true((0 <= m) && (m != n)) => myadmit end. +Check (H : forall m n : nat, n < m -> (0 <= m) && (m != n)). +myadmit. +Qed. + +Lemma testw1 n (ngt0 : 0 < n) : n <= 0. +wlog H : (z := 0) (m := n) ngt0 / m != 0. + match goal with + |- (forall z m, + is_true(z < m) -> is_true(m != 0) -> is_true(m <= z)) -> + is_true(n <= 0) => myadmit end. +Check(n : nat). +Check(m : nat). +Check(z : nat). +Check(ngt0 : z < m). +Check(H : m != 0). +myadmit. +Qed. + +Lemma testw2 n (ngt0 : 0 < n) : n <= 0. +wlog H : (m := n) (z := (X in n <= X)) ngt0 / m != z. + match goal with + |- (forall m z : nat, + is_true(0 < m) -> is_true(m != z) -> is_true(m <= z)) -> + is_true(n <= 0) => idtac end. +Restart. +wlog H : (m := n) (one := (X in X <= _)) ngt0 / m != one. + match goal with + |- (forall m one : nat, + is_true(one <= m) -> is_true(m != one) -> is_true(m <= 0)) -> + is_true(n <= 0) => idtac end. +Restart. +wlog H : {n} (m := n) (z := (X in _ <= X)) ngt0 / m != z. + match goal with + |- (forall m z : nat, + is_true(0 < z) -> is_true(m != z) -> is_true(m <= 0)) -> + is_true(n <= 0) => idtac end. + myadmit. +Fail Check n. +myadmit. +Qed. + +Section Test. +Variable x : nat. +Definition addx y := y + x. + +Lemma testw3 (m n : nat) (ngt0 : 0 < n) : n <= addx x. +wlog H : (n0 := n) (y := x) (@twoy := (id _ as X in _ <= X)) / twoy = 2 * y. + myadmit. +myadmit. +Qed. + + +Definition twox := x + x. +Definition bis := twox. + +Lemma testw3x n (ngt0 : 0 < n) : n + x <= twox. +wlog H : (y := x) (@twoy := (X in _ <= X)) / twoy = 2 * y. + match goal with + |- (forall y : nat, + let twoy := y + y in + twoy = 2 * y -> is_true(n + y <= twoy)) -> + is_true(n + x <= twox) => myadmit end. +Restart. +wlog H : (y := x) (@twoy := (id _ as X in _ <= X)) / twoy = 2 * y. + match goal with + |- (forall y : nat, + let twoy := twox in + twoy = 2 * y -> is_true(n + y <= twoy)) -> + is_true(n + x <= twox) => myadmit end. +myadmit. +Qed. + +End Test. + +Lemma test_in n k (def_k : k = 0) (ngtk : k < n) : P n. +rewrite -(add0n n) in {def_k k ngtk} (m := k) (def_m := def_k) (ngtm := ngtk). +rewrite def_m add0n in {ngtm} (e := erefl 0 ) (ngt0 := ngtm) => {def_m}. +myadmit. +Qed. diff --git a/test-suite/ssr/gen_pattern.v b/test-suite/ssr/gen_pattern.v new file mode 100644 index 00000000..c0592e88 --- /dev/null +++ b/test-suite/ssr/gen_pattern.v @@ -0,0 +1,33 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Notation "( a 'in' c )" := (a + c) (only parsing) : myscope. +Delimit Scope myscope with myscope. + +Notation "( a 'in' c )" := (a + c) (only parsing). + +Lemma foo x y : x + x.+1 = x.+1 + y. +move: {x} (x.+1) {1}x y (x.+1 in RHS). + match goal with |- forall a b c d, b + a = d + c => idtac end. +Admitted. + +Lemma bar x y : x + x.+1 = x.+1 + y. +move E: ((x.+1 in y)) => w. + match goal with |- x + x.+1 = w => rewrite -{w}E end. +move E: (x.+1 in y)%myscope => w. + match goal with |- x + x.+1 = w => rewrite -{w}E end. +move E: ((x + y).+1 as RHS) => w. + match goal with |- x + x.+1 = w => rewrite -{}E -addSn end. +Admitted. diff --git a/test-suite/ssr/have_TC.v b/test-suite/ssr/have_TC.v new file mode 100644 index 00000000..b3a26ed2 --- /dev/null +++ b/test-suite/ssr/have_TC.v @@ -0,0 +1,50 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + +Axiom daemon : False. Ltac myadmit := case: daemon. + +Class foo (T : Type) := { n : nat }. +Instance five : foo nat := {| n := 5 |}. + +Definition bar T {f : foo T} m : Prop := + @n _ f = m. + +Eval compute in (bar nat 7). + +Lemma a : True. +set toto := bar _ 8. +have titi : bar _ 5. + reflexivity. +have titi2 : bar _ 5 := . + Fail reflexivity. + by myadmit. +have totoc (H : bar _ 5) : 3 = 3 := eq_refl. +move/totoc: nat => _. +exact I. +Qed. + +Set SsrHave NoTCResolution. + +Lemma a' : True. +set toto := bar _ 8. +have titi : bar _ 5. + Fail reflexivity. + by myadmit. +have titi2 : bar _ 5 := . + Fail reflexivity. + by myadmit. +have totoc (H : bar _ 5) : 3 = 3 := eq_refl. +move/totoc: nat => _. +exact I. +Qed. diff --git a/test-suite/ssr/have_transp.v b/test-suite/ssr/have_transp.v new file mode 100644 index 00000000..1c998da7 --- /dev/null +++ b/test-suite/ssr/have_transp.v @@ -0,0 +1,48 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrfun ssrbool TestSuite.ssr_mini_mathcomp. + + +Lemma test1 n : n >= 0. +Proof. +have [:s1] @h m : 'I_(n+m).+1. + apply: Sub 0 _. + abstract: s1 m. + by auto. +cut (forall m, 0 < (n+m).+1); last assumption. +rewrite [_ 1 _]/= in s1 h *. +by []. +Qed. + +Lemma test2 n : n >= 0. +Proof. +have [:s1] @h m : 'I_(n+m).+1 := Sub 0 (s1 m). + move=> m; reflexivity. +cut (forall m, 0 < (n+m).+1); last assumption. +by []. +Qed. + +Lemma test3 n : n >= 0. +Proof. +Fail have [:s1] @h m : 'I_(n+m).+1 by apply: (Sub 0 (s1 m)); auto. +have [:s1] @h m : 'I_(n+m).+1 by apply: (Sub 0); abstract: s1 m; auto. +cut (forall m, 0 < (n+m).+1); last assumption. +by []. +Qed. + +Lemma test4 n : n >= 0. +Proof. +have @h m : 'I_(n+m).+1 by apply: (Sub 0); abstract auto. +by []. +Qed. diff --git a/test-suite/ssr/have_view_idiom.v b/test-suite/ssr/have_view_idiom.v new file mode 100644 index 00000000..3d6c9d98 --- /dev/null +++ b/test-suite/ssr/have_view_idiom.v @@ -0,0 +1,18 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool. + +Lemma test (a b : bool) (pab : a && b) : b. +have {pab} /= /andP [pa -> //] /= : true && (a && b) := pab. +Qed. diff --git a/test-suite/ssr/havesuff.v b/test-suite/ssr/havesuff.v new file mode 100644 index 00000000..aa1f7187 --- /dev/null +++ b/test-suite/ssr/havesuff.v @@ -0,0 +1,85 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + + +Variables P G : Prop. + +Lemma test1 : (P -> G) -> P -> G. +Proof. +move=> pg p. +have suff {pg} H : P. + match goal with |- P -> G => move=> _; exact: pg p | _ => fail end. +match goal with H : P -> G |- G => exact: H p | _ => fail end. +Qed. + +Lemma test2 : (P -> G) -> P -> G. +Proof. +move=> pg p. +have suffices {pg} H : P. + match goal with |- P -> G => move=> _; exact: pg p | _ => fail end. +match goal with H : P -> G |- G => exact: H p | _ => fail end. +Qed. + +Lemma test3 : (P -> G) -> P -> G. +Proof. +move=> pg p. +suff have {pg} H : P. + match goal with H : P |- G => exact: pg H | _ => fail end. +match goal with |- (P -> G) -> G => move=> H; exact: H p | _ => fail end. +Qed. + +Lemma test4 : (P -> G) -> P -> G. +Proof. +move=> pg p. +suffices have {pg} H: P. + match goal with H : P |- G => exact: pg H | _ => fail end. +match goal with |- (P -> G) -> G => move=> H; exact: H p | _ => fail end. +Qed. + +(* +Lemma test5 : (P -> G) -> P -> G. +Proof. +move=> pg p. +suff have {pg} H : P := pg H. +match goal with |- (P -> G) -> G => move=> H; exact: H p | _ => fail end. +Qed. +*) + +(* +Lemma test6 : (P -> G) -> P -> G. +Proof. +move=> pg p. +suff have {pg} H := pg H. +match goal with |- (P -> G) -> G => move=> H; exact: H p | _ => fail end. +Qed. +*) + +Lemma test7 : (P -> G) -> P -> G. +Proof. +move=> pg p. +have suff {pg} H : P := pg. +match goal with H : P -> G |- G => exact: H p | _ => fail end. +Qed. + +Lemma test8 : (P -> G) -> P -> G. +Proof. +move=> pg p. +have suff {pg} H := pg. +match goal with H : P -> G |- G => exact: H p | _ => fail end. +Qed. + +Goal forall x y : bool, x = y -> x = y. +move=> x y E. +by have {x E} -> : x = y by []. +Qed. diff --git a/test-suite/ssr/if_isnt.v b/test-suite/ssr/if_isnt.v new file mode 100644 index 00000000..b8f6b773 --- /dev/null +++ b/test-suite/ssr/if_isnt.v @@ -0,0 +1,22 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + + +Definition unopt (x : option bool) := + if x isn't Some x then false else x. + +Lemma test1 : unopt None = false /\ + unopt (Some false) = false /\ + unopt (Some true) = true. +Proof. by auto. Qed. diff --git a/test-suite/ssr/intro_beta.v b/test-suite/ssr/intro_beta.v new file mode 100644 index 00000000..8a164bd8 --- /dev/null +++ b/test-suite/ssr/intro_beta.v @@ -0,0 +1,25 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + + +Axiom T : Type. + +Definition C (P : T -> Prop) := forall x, P x. + +Axiom P : T -> T -> Prop. + +Lemma foo : C (fun x => forall y, let z := x in P y x). +move=> a b. +match goal with |- (let y := _ in _) => idtac end. +Admitted. diff --git a/test-suite/ssr/intro_noop.v b/test-suite/ssr/intro_noop.v new file mode 100644 index 00000000..fdc85173 --- /dev/null +++ b/test-suite/ssr/intro_noop.v @@ -0,0 +1,37 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool. +Axiom daemon : False. Ltac myadmit := case: daemon. + +Lemma v : True -> bool -> bool. Proof. by []. Qed. + +Reserved Notation " a -/ b " (at level 0). +Reserved Notation " a -// b " (at level 0). +Reserved Notation " a -/= b " (at level 0). +Reserved Notation " a -//= b " (at level 0). + +Lemma test : forall a b c, a || b || c. +Proof. +move=> ---a--- - -/=- -//- -/=- -//=- b [|-]. +move: {-}a => /v/v-H; have _ := H I I. +Fail move: {-}a {H} => /v-/v-H. +have - -> : a = (id a) by []. +have --> : a = (id a) by []. +have - - _ : a = (id a) by []. +have -{1}-> : a = (id a) by []. + by myadmit. +move: a. +case: b => -[] //. +by myadmit. +Qed. diff --git a/test-suite/ssr/ipat_clear_if_id.v b/test-suite/ssr/ipat_clear_if_id.v new file mode 100644 index 00000000..7a44db2e --- /dev/null +++ b/test-suite/ssr/ipat_clear_if_id.v @@ -0,0 +1,23 @@ +Require Import ssreflect. + +Axiom v1 : nat -> bool. + +Section Foo. + +Variable v2 : nat -> bool. + +Lemma test (v3 : nat -> bool) (v4 : bool -> bool) (v5 : bool -> bool) : nat -> nat -> nat -> nat -> True. +Proof. +move=> {}/v1 b1 {}/v2 b2 {}/v3 b3 {}/v2/v4/v5 b4. +Check b1 : bool. +Check b2 : bool. +Check b3 : bool. +Check b4 : bool. +Fail Check v3. +Fail Check v4. +Fail Check v5. +Check v2 : nat -> bool. +by []. +Qed. + +End Foo. diff --git a/test-suite/ssr/ipatalternation.v b/test-suite/ssr/ipatalternation.v new file mode 100644 index 00000000..6aa9a954 --- /dev/null +++ b/test-suite/ssr/ipatalternation.v @@ -0,0 +1,18 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + + +Lemma test1 : Prop -> Prop -> Prop -> Prop -> Prop -> True = False -> Prop -> True \/ True. +by move=> A /= /= /= B C {A} {B} ? _ {C} {1}-> *; right. +Qed. diff --git a/test-suite/ssr/ltac_have.v b/test-suite/ssr/ltac_have.v new file mode 100644 index 00000000..380e52af --- /dev/null +++ b/test-suite/ssr/ltac_have.v @@ -0,0 +1,39 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Ltac SUFF1 h t := suff h x (p := x < 0) : t. +Ltac SUFF2 h t := suff h x (p := x < 0) : t by apply h. +Ltac HAVE1 h t u := have h x (p := x < 0) : t := u. +Ltac HAVE2 h t := have h x (p := x < 0) : t by []. +Ltac HAVE3 h t := have h x (p := x < 0) : t. +Ltac HAVES h t := have suff h : t. +Ltac SUFFH h t := suff have h : t. + +Lemma foo z : z < 0. +SUFF1 h1 (z+1 < 0). +Undo. +SUFF2 h2 (z < 0). +Undo. +HAVE1 h3 (z = z) (refl_equal z). +Undo. +HAVE2 h4 (z = z). +Undo. +HAVE3 h5 (z < 0). +Undo. +HAVES h6 (z < 1). +Undo. +SUFFH h7 (z < 1). +Undo. +Admitted. diff --git a/test-suite/ssr/ltac_in.v b/test-suite/ssr/ltac_in.v new file mode 100644 index 00000000..bcdf96dd --- /dev/null +++ b/test-suite/ssr/ltac_in.v @@ -0,0 +1,26 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Set Implicit Arguments. +Unset Strict Implicit. +Import Prenex Implicits. + +(* error 1 *) + +Ltac subst1 H := move: H; rewrite {1} addnC; move => H. +Ltac subst2 H := rewrite addnC in H. + +Goal ( forall a b: nat, b+a = 0 -> b+a=0). +Proof. move=> a b hyp. subst1 hyp. subst2 hyp. done. Qed. diff --git a/test-suite/ssr/move_after.v b/test-suite/ssr/move_after.v new file mode 100644 index 00000000..a7a9afea --- /dev/null +++ b/test-suite/ssr/move_after.v @@ -0,0 +1,19 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + + +Goal True -> True -> True. +move=> H1 H2. +move H1 after H2. +Admitted. diff --git a/test-suite/ssr/multiview.v b/test-suite/ssr/multiview.v new file mode 100644 index 00000000..f4e717b3 --- /dev/null +++ b/test-suite/ssr/multiview.v @@ -0,0 +1,58 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Goal forall m n p, n <= p -> m <= n -> m <= p. +by move=> m n p le_n_p /leq_trans; apply. +Undo 1. +by move=> m n p le_n_p /leq_trans /(_ le_n_p) le_m_p; exact: le_m_p. +Undo 1. +by move=> m n p le_n_p /leq_trans ->. +Qed. + +Goal forall P Q X : Prop, Q -> (True -> X -> Q = P) -> X -> P. +by move=> P Q X q V /V <-. +Qed. + +Lemma test0: forall a b, a && a && b -> b. +by move=> a b; repeat move=> /andP []; move=> *. +Qed. + +Lemma test1 : forall a b, a && b -> b. +by move=> a b /andP /andP /andP [] //. +Qed. + +Lemma test2 : forall a b, a && b -> b. +by move=> a b /andP /andP /(@andP a) [] //. +Qed. + +Lemma test3 : forall a b, a && (b && b) -> b. +by move=> a b /andP [_ /andP [_ //]]. +Qed. + +Lemma test4: forall a b, a && b = b && a. +by move=> a b; apply/andP/andP=> ?; apply/andP/andP/andP; rewrite andbC; apply/andP. +Qed. + +Lemma test5: forall C I A O, (True -> O) -> (O -> A) -> (True -> A -> I) -> (I -> C) -> C. +by move=> c i a o O A I C; apply/C/I/A/O. +Qed. + +Lemma test6: forall A B, (A -> B) -> A -> B. +move=> A B A_to_B a; move/A_to_B in a; exact: a. +Qed. + +Lemma test7: forall A B, (A -> B) -> A -> B. +move=> A B A_to_B a; apply A_to_B in a; exact: a. +Qed. diff --git a/test-suite/ssr/occarrow.v b/test-suite/ssr/occarrow.v new file mode 100644 index 00000000..49af7ae0 --- /dev/null +++ b/test-suite/ssr/occarrow.v @@ -0,0 +1,23 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import TestSuite.ssr_mini_mathcomp. + +Lemma test1 : forall n m : nat, n = m -> m * m + n * n = n * n + n * n. +move=> n m E; have [{2}-> _] : n * n = m * n /\ True by move: E => {1}<-. +by move: E => {3}->. +Qed. + +Lemma test2 : forall n m : nat, True /\ (n = m -> n * n = n * m). +by move=> n m; constructor=> [|{2}->]. +Qed. diff --git a/test-suite/ssr/patnoX.v b/test-suite/ssr/patnoX.v new file mode 100644 index 00000000..d69f03ac --- /dev/null +++ b/test-suite/ssr/patnoX.v @@ -0,0 +1,18 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool. +Goal forall x, x && true = x. +move=> x. +Fail (rewrite [X in _ && _]andbT). +Abort. diff --git a/test-suite/ssr/pattern.v b/test-suite/ssr/pattern.v new file mode 100644 index 00000000..396f4f03 --- /dev/null +++ b/test-suite/ssr/pattern.v @@ -0,0 +1,32 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +Require Import ssrmatching. + +(*Set Debug SsrMatching.*) + +Tactic Notation "at" "[" ssrpatternarg(pat) "]" tactic(t) := + let name := fresh in + let def_name := fresh in + ssrpattern pat; + intro name; + pose proof (refl_equal name) as def_name; + unfold name at 1 in def_name; + t def_name; + [ rewrite <- def_name | idtac.. ]; + clear name def_name. + +Lemma test (H : True -> True -> 3 = 7) : 28 = 3 * 4. +Proof. +at [ X in X * 4 ] ltac:(fun place => rewrite -> H in place). +- reflexivity. +- trivial. +- trivial. +Qed. diff --git a/test-suite/ssr/primproj.v b/test-suite/ssr/primproj.v new file mode 100644 index 00000000..cf61eb43 --- /dev/null +++ b/test-suite/ssr/primproj.v @@ -0,0 +1,164 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + + + +Require Import Setoid. +Set Primitive Projections. + + +Module CoqBug. +Record foo A := Foo { foo_car : A }. + +Definition bar : foo _ := Foo nat 10. + +Variable alias : forall A, foo A -> A. + +Parameter e : @foo_car = alias. + +Goal foo_car _ bar = alias _ bar. +Proof. +(* Coq equally fails *) +Fail rewrite -> e. +Fail rewrite e at 1. +Fail setoid_rewrite e. +Fail setoid_rewrite e at 1. +Set Keyed Unification. +Fail rewrite -> e. +Fail rewrite e at 1. +Fail setoid_rewrite e. +Fail setoid_rewrite e at 1. +Admitted. + +End CoqBug. + +(* ----------------------------------------------- *) +Require Import ssreflect. + +Set Primitive Projections. + +Module T1. + +Record foo A := Foo { foo_car : A }. + +Definition bar : foo _ := Foo nat 10. + +Goal foo_car _ bar = 10. +Proof. +match goal with +| |- foo_car _ bar = 10 => idtac +end. +rewrite /foo_car. +(* +Fail match goal with +| |- foo_car _ bar = 10 => idtac +end. +*) +Admitted. + +End T1. + + +Module T2. + +Record foo {A} := Foo { foo_car : A }. + +Definition bar : foo := Foo nat 10. + +Goal foo_car bar = 10. +match goal with +| |- foo_car bar = 10 => idtac +end. +rewrite /foo_car. +(* +Fail match goal with +| |- foo_car bar = 10 => idtac +end. +*) +Admitted. + +End T2. + + +Module T3. + +Record foo {A} := Foo { foo_car : A }. + +Definition bar : foo := Foo nat 10. + +Goal foo_car bar = 10. +Proof. +rewrite -[foo_car _]/(id _). +match goal with |- id _ = 10 => idtac end. +Admitted. + +Goal foo_car bar = 10. +Proof. +set x := foo_car _. +match goal with |- x = 10 => idtac end. +Admitted. + +End T3. + +Module T4. + +Inductive seal {A} (f : A) := { unseal : A; seal_eq : unseal = f }. +Arguments unseal {_ _} _. +Arguments seal_eq {_ _} _. + +Record uPred : Type := IProp { uPred_holds :> Prop }. + +Definition uPred_or_def (P Q : uPred) : uPred := + {| uPred_holds := P \/ Q |}. +Definition uPred_or_aux : seal (@uPred_or_def). by eexists. Qed. +Definition uPred_or := unseal uPred_or_aux. +Definition uPred_or_eq: @uPred_or = @uPred_or_def := seal_eq uPred_or_aux. + +Lemma foobar (P1 P2 Q : uPred) : + (P1 <-> P2) -> (uPred_or P1 Q) <-> (uPred_or P2 Q). +Proof. + rewrite uPred_or_eq. (* This fails. *) +Admitted. + +End T4. + + +Module DesignFlaw. + +Record foo A := Foo { foo_car : A }. +Definition bar : foo _ := Foo nat 10. + +Definition app (f : foo nat -> nat) x := f x. + +Goal app (foo_car _) bar = 10. +Proof. +unfold app. (* mkApp should produce a Proj *) +Fail set x := (foo_car _ _). +Admitted. + +End DesignFlaw. + + +Module Bug. + +Record foo A := Foo { foo_car : A }. + +Definition bar : foo _ := Foo nat 10. + +Variable alias : forall A, foo A -> A. + +Parameter e : @foo_car = alias. + +Goal foo_car _ bar = alias _ bar. +Proof. +Fail rewrite e. (* Issue: #86 *) +Admitted. + +End Bug. diff --git a/test-suite/ssr/rewpatterns.v b/test-suite/ssr/rewpatterns.v new file mode 100644 index 00000000..f7993f40 --- /dev/null +++ b/test-suite/ssr/rewpatterns.v @@ -0,0 +1,146 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + + +Require Import ssreflect. +Require Import ssrbool ssrfun TestSuite.ssr_mini_mathcomp. + +Lemma test1 : forall x y (f : nat -> nat), f (x + y).+1 = f (y + x.+1). +by move=> x y f; rewrite [_.+1](addnC x.+1). +Qed. + +Lemma test2 : forall x y f, x + y + f (y + x) + f (y + x) = x + y + f (y + x) + f (x + y). +by move=> x y f; rewrite {2}[in f _]addnC. +Qed. + +Lemma test2' : forall x y f, true && f (x * (y + x)) = true && f(x * (x + y)). +by move=> x y f; rewrite [in f _](addnC y). +Qed. + +Lemma test2'' : forall x y f, f (y + x) + f(y + x) + f(y + x) = f(x + y) + f(y + x) + f(x + y). +by move=> x y f; rewrite {1 3}[in f _](addnC y). +Qed. + +(* patterns catching bound vars not supported *) +Lemma test2_1 : forall x y f, true && (let z := x in f (z * (y + x))) = true && f(x * (x + y)). +by move=> x y f; rewrite [in f _](addnC x). (* put y when bound var will be OK *) +Qed. + +Lemma test3 : forall x y f, x + f (x + y) (f (y + x) x) = x + f (x + y) (f (x + y) x). +by move=> x y f; rewrite [in X in (f _ X)](addnC y). +Qed. + +Lemma test3' : forall x y f, x = y -> x + f (x + x) x + f (x + x) x = + x + f (x + y) x + f (y + x) x. +by move=> x y f E; rewrite {2 3}[in X in (f X _)]E. +Qed. + +Lemma test3'' : forall x y f, x = y -> x + f (x + y) x + f (x + y) x = + x + f (x + y) x + f (y + y) x. +by move=> x y f E; rewrite {2}[in X in (f X _)]E. +Qed. + +Lemma test4 : forall x y f, x = y -> x + f (fun _ : nat => x + x) x + f (fun _ => x + x) x = + x + f (fun _ => x + y) x + f (fun _ => y + x) x. +by move=> x y f E; rewrite {2 3}[in X in (f X _)]E. +Qed. + +Lemma test4' : forall x y f, x = y -> x + f (fun _ _ _ : nat => x + x) x = + x + f (fun _ _ _ => x + y) x. +by move=> x y f E; rewrite {2}[in X in (f X _)]E. +Qed. + +Lemma test5 : forall x y f, x = y -> x + f (y + x) x + f (y + x) x = + x + f (x + y) x + f (y + x) x. +by move=> x y f E; rewrite {1}[X in (f X _)]addnC. +Qed. + +Lemma test3''' : forall x y f, x = y -> x + f (x + y) x + f (x + y) (x + y) = + x + f (x + y) x + f (y + y) (x + y). +by move=> x y f E; rewrite {1}[in X in (f X X)]E. +Qed. + +Lemma test3'''' : forall x y f, x = y -> x + f (x + y) x + f (x + y) (x + y) = + x + f (x + y) x + f (y + y) (y + y). +by move=> x y f E; rewrite [in X in (f X X)]E. +Qed. + +Lemma test3x : forall x y f, y+y = x+y -> x + f (x + y) x + f (x + y) (x + y) = + x + f (x + y) x + f (y + y) (y + y). +by move=> x y f E; rewrite -[X in (f X X)]E. +Qed. + +Lemma test6 : forall x y (f : nat -> nat), f (x + y).+1 = f (y.+1 + x). +by move=> x y f; rewrite [(x + y) in X in (f X)]addnC. +Qed. + +Lemma test7 : forall x y (f : nat -> nat), f (x + y).+1 = f (y + x.+1). +by move=> x y f; rewrite [(x.+1 + y) as X in (f X)]addnC. +Qed. + +Lemma manual x y z (f : nat -> nat -> nat) : (x + y).+1 + f (x.+1 + y) (z + (x + y).+1) = 0. +Proof. +rewrite [in f _]addSn. +match goal with |- (x + y).+1 + f (x + y).+1 (z + (x + y).+1) = 0 => idtac end. +rewrite -[X in _ = X]addn0. +match goal with |- (x + y).+1 + f (x + y).+1 (z + (x + y).+1) = 0 + 0 => idtac end. +rewrite -{2}[in X in _ = X](addn0 0). +match goal with |- (x + y).+1 + f (x + y).+1 (z + (x + y).+1) = 0 + (0 + 0) => idtac end. +rewrite [_.+1 in X in f _ X](addnC x.+1). +match goal with |- (x + y).+1 + f (x + y).+1 (z + (y + x.+1)) = 0 + (0 + 0) => idtac end. +rewrite [x.+1 + y as X in f X _]addnC. +match goal with |- (x + y).+1 + f (y + x.+1) (z + (y + x.+1)) = 0 + (0 + 0) => idtac end. +Admitted. + +Goal (exists x : 'I_3, x > 0). +apply: (ex_intro _ (@Ordinal _ 2 _)). +Admitted. + +Goal (forall y, 1 < y < 2 -> exists x : 'I_3, x > 0). +move=> y; case/andP=> y_gt1 y_lt2; apply: (ex_intro _ (@Ordinal _ y _)). + by apply: leq_trans y_lt2 _. +by move=> y_lt3; apply: leq_trans _ y_gt1. +Qed. + +Goal (forall x y : nat, forall P : nat -> Prop, x = y -> True). +move=> x y P E. +have: P x -> P y by suff: x = y by move=> ?; congr (P _). +Admitted. + +Goal forall a : bool, a -> true && a || false && a. +by move=> a ?; rewrite [true && _]/= [_ && a]/= orbC [_ || _]//=. +Qed. + +Goal forall a : bool, a -> true && a || false && a. +by move=> a ?; rewrite [X in X || _]/= [X in _ || X]/= orbC [false && a as X in X || _]//=. +Qed. + +Variable a : bool. +Definition f x := x || a. +Definition g x := f x. + +Goal a -> g false. +by move=> Ha; rewrite [g _]/f orbC Ha. +Qed. + +Goal a -> g false || g false. +move=> Ha; rewrite {2}[g _]/f orbC Ha. +match goal with |- (is_true (false || true || g false)) => done end. +Qed. + +Goal a -> (a && a || true && a) && true. +by move=> Ha; rewrite -[_ || _]/(g _) andbC /= Ha [g _]/f. +Qed. + +Goal a -> (a || a) && true. +by move=> Ha; rewrite -[in _ || _]/(f _) Ha andbC /f. +Qed. diff --git a/test-suite/ssr/rewrite_illtyped.v b/test-suite/ssr/rewrite_illtyped.v new file mode 100644 index 00000000..7358068c --- /dev/null +++ b/test-suite/ssr/rewrite_illtyped.v @@ -0,0 +1,9 @@ +From Coq Require Import ssreflect Setoid. + +Structure SEProp := {prop_of : Prop; _ : prop_of <-> True}. + +Fact anomaly: forall P : SEProp, prop_of P. +Proof. +move=> [P E]. +Fail rewrite E. +Abort. diff --git a/test-suite/ssr/set_lamda.v b/test-suite/ssr/set_lamda.v new file mode 100644 index 00000000..a012ec68 --- /dev/null +++ b/test-suite/ssr/set_lamda.v @@ -0,0 +1,27 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool ssrfun. +Require Import TestSuite.ssr_mini_mathcomp. + +Set Implicit Arguments. +Unset Strict Implicit. +Import Prenex Implicits. + +(* error 2 *) + +Goal (exists f: Set -> nat, f nat = 0). +Proof. set (f:= fun _:Set =>0). by exists f. Qed. + +Goal (exists f: Set -> nat, f nat = 0). +Proof. set f := (fun _:Set =>0). by exists f. Qed. diff --git a/test-suite/ssr/set_pattern.v b/test-suite/ssr/set_pattern.v new file mode 100644 index 00000000..3ce75e87 --- /dev/null +++ b/test-suite/ssr/set_pattern.v @@ -0,0 +1,64 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + +Axiom daemon : False. Ltac myadmit := case: daemon. + +Ltac T1 x := match goal with |- _ => set t := (x in X in _ = X) end. +Ltac T2 x := first [set t := (x in RHS)]. +Ltac T3 x := first [set t := (x in Y in _ = Y)|idtac]. +Ltac T4 x := set t := (x in RHS); idtac. +Ltac T5 x := match goal with |- _ => set t := (x in RHS) | |- _ => idtac end. + +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Open Scope nat_scope. + +Lemma foo x y : x.+1 = y + x.+1. +set t := (_.+1 in RHS). match goal with |- x.+1 = y + t => rewrite /t {t} end. +set t := (x in RHS). match goal with |- x.+1 = y + t.+1 => rewrite /t {t} end. +set t := (x in _ = x). match goal with |- x.+1 = t => rewrite /t {t} end. +set t := (x in X in _ = X). + match goal with |- x.+1 = y + t.+1 => rewrite /t {t} end. +set t := (x in RHS). match goal with |- x.+1 = y + t.+1 => rewrite /t {t} end. +set t := (y + (1 + x) as X in _ = X). + match goal with |- x.+1 = t => rewrite /t addSn add0n {t} end. +set t := x.+1. match goal with |- t = y + t => rewrite /t {t} end. +set t := (x).+1. match goal with |- t = y + t => rewrite /t {t} end. +set t := ((x).+1 in X in _ = X). + match goal with |- x.+1 = y + t => rewrite /t {t} end. +set t := (x.+1 in RHS). match goal with |- x.+1 = y + t => rewrite /t {t} end. +T1 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. +T2 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. +T3 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. +T4 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. +T5 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. +rewrite [RHS]addnC. + match goal with |- x.+1 = x.+1 + y => rewrite -[RHS]addnC end. +rewrite -[in RHS](@subnK 1 x.+1) //. + match goal with |- x.+1 = y + (x.+1 - 1 + 1) => rewrite subnK // end. +have H : x.+1 = y by myadmit. +set t := _.+1 in H |- *. + match goal with H : t = y |- t = y + t => rewrite /t {t} in H * end. +set t := (_.+1 in X in _ + X) in H |- *. + match goal with H : x.+1 = y |- x.+1 = y + t => rewrite /t {t} in H * end. +set t := 0. match goal with t := 0 |- x.+1 = y + x.+1 => clear t end. +set t := y + _. match goal with |- x.+1 = t => rewrite /t {t} end. +set t : nat := 0. clear t. +set t : nat := (x in RHS). + match goal with |- x.+1 = y + t.+1 => rewrite /t {t} end. +set t : nat := RHS. match goal with |- x.+1 = t => rewrite /t {t} end. +(* set t := 0 + _. *) +(* set t := (x).+1 in X in _ + X in H |-. *) +(* set t := (x).+1 in X in _ = X.*) +Admitted. diff --git a/test-suite/ssr/ssrpattern.v b/test-suite/ssr/ssrpattern.v new file mode 100644 index 00000000..422bb95f --- /dev/null +++ b/test-suite/ssr/ssrpattern.v @@ -0,0 +1,7 @@ +Require Import ssrmatching. + +Goal forall n, match n with 0 => 0 | _ => 0 end = 0. +Proof. + intro n. + ssrpattern (match _ with 0 => _ | S n' => _ end). +Abort. diff --git a/test-suite/ssr/ssrsyntax2.v b/test-suite/ssr/ssrsyntax2.v new file mode 100644 index 00000000..af839fab --- /dev/null +++ b/test-suite/ssr/ssrsyntax2.v @@ -0,0 +1,20 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import TestSuite.ssr_ssrsyntax1. +Require Import Arith. + +Goal (forall a b, a + b = b + a). +intros. +rewrite plus_comm, plus_comm. +split. +Qed. diff --git a/test-suite/ssr/tc.v b/test-suite/ssr/tc.v new file mode 100644 index 00000000..ae4589ef --- /dev/null +++ b/test-suite/ssr/tc.v @@ -0,0 +1,39 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + + +Class foo (A : Type) : Type := mkFoo { val : A }. +Instance foo_pair {A B} {f1 : foo A} {f2 : foo B} : foo (A * B) | 2 := + {| val := (@val _ f1, @val _ f2) |}. +Instance foo_nat : foo nat | 3 := {| val := 0 |}. + +Definition id {A} (x : A) := x. +Axiom E : forall A {f : foo A} (a : A), id a = (@val _ f). + +Lemma test (x : nat) : id true = true -> id x = 0. +Proof. +Fail move=> _; reflexivity. +Timeout 2 rewrite E => _; reflexivity. +Qed. + +Definition P {A} (x : A) : Prop := x = x. +Axiom V : forall A {f : foo A} (x:A), P x -> P (id x). + +Lemma test1 (x : nat) : P x -> P (id x). +Proof. +move=> px. +Timeout 2 Fail move/V: px. +Timeout 2 move/V : (px) => _. +move/(V nat) : px => H; exact H. +Qed. diff --git a/test-suite/ssr/typeof.v b/test-suite/ssr/typeof.v new file mode 100644 index 00000000..ca121fdb --- /dev/null +++ b/test-suite/ssr/typeof.v @@ -0,0 +1,22 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. + +Ltac mycut x := + let tx := type of x in + cut tx. + +Lemma test : True. +Proof. +by mycut I=> [ x | ]; [ exact x | exact I ]. +Qed. diff --git a/test-suite/ssr/unfold_Opaque.v b/test-suite/ssr/unfold_Opaque.v new file mode 100644 index 00000000..7c2b51de --- /dev/null +++ b/test-suite/ssr/unfold_Opaque.v @@ -0,0 +1,18 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +Require Import ssreflect. + +Definition x := 3. +Opaque x. + +Goal x = 3. +Fail rewrite /x. +Admitted. diff --git a/test-suite/ssr/unkeyed.v b/test-suite/ssr/unkeyed.v new file mode 100644 index 00000000..710941c3 --- /dev/null +++ b/test-suite/ssr/unkeyed.v @@ -0,0 +1,31 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrfun ssrbool TestSuite.ssr_mini_mathcomp. + +Set Implicit Arguments. +Unset Strict Implicit. +Import Prenex Implicits. + +Lemma test0 (a b : unit) f : a = f b. +Proof. by rewrite !unitE. Qed. + +Lemma phE T : all_equal_to (Phant T). Proof. by case. Qed. + +Lemma test1 (a b : phant nat) f : a = f b. +Proof. by rewrite !phE. Qed. + +Lemma eq_phE (T : eqType) : all_equal_to (Phant T). Proof. by case. Qed. + +Lemma test2 (a b : phant bool) f : a = locked (f b). +Proof. by rewrite !eq_phE. Qed. diff --git a/test-suite/ssr/view_case.v b/test-suite/ssr/view_case.v new file mode 100644 index 00000000..2721470c --- /dev/null +++ b/test-suite/ssr/view_case.v @@ -0,0 +1,31 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool TestSuite.ssr_mini_mathcomp. + +Axiom P : forall T, seq T -> Prop. + +Goal (forall T (s : seq T), P _ s). +move=> T s. +elim: s => [| x /lastP [| s] IH]. +Admitted. + +Goal forall x : 'I_1, x = 0 :> nat. +move=> /ord1 -> /=; exact: refl_equal. +Qed. + +Goal forall x : 'I_1, x = 0 :> nat. +move=> x. +move=> /ord1 -> in x |- *. +exact: refl_equal. +Qed. diff --git a/test-suite/ssr/wlog_suff.v b/test-suite/ssr/wlog_suff.v new file mode 100644 index 00000000..43a8f3b8 --- /dev/null +++ b/test-suite/ssr/wlog_suff.v @@ -0,0 +1,28 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool. + +Lemma test b : b || ~~b. +wlog _ : b / b = true. + case: b; [ by apply | by rewrite orbC ]. +wlog suff: b / b || ~~b. + by case: b. +by case: b. +Qed. + +Lemma test2 b c (H : c = b) : b || ~~b. +wlog _ : b {c H} / b = true. + by case: b H. +by case: b. +Qed. diff --git a/test-suite/ssr/wlogletin.v b/test-suite/ssr/wlogletin.v new file mode 100644 index 00000000..64e1ea84 --- /dev/null +++ b/test-suite/ssr/wlogletin.v @@ -0,0 +1,50 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool. +Require Import TestSuite.ssr_mini_mathcomp. + +Variable T : Type. +Variables P : T -> Prop. + +Definition f := fun x y : T => x. + +Lemma test1 : forall x y : T, P (f x y) -> P x. +Proof. +move=> x y; set fxy := f x y; move=> Pfxy. +wlog H : @fxy Pfxy / P x. + match goal with |- (let fxy0 := f x y in P fxy0 -> P x -> P x) -> P x => by auto | _ => fail end. +exact: H. +Qed. + +Lemma test2 : forall x y : T, P (f x y) -> P x. +Proof. +move=> x y; set fxy := f x y; move=> Pfxy. +wlog H : fxy Pfxy / P x. + match goal with |- (forall fxy, P fxy -> P x -> P x) -> P x => by auto | _ => fail end. +exact: H. +Qed. + +Lemma test3 : forall x y : T, P (f x y) -> P x. +Proof. +move=> x y; set fxy := f x y; move=> Pfxy. +move: {1}@fxy (Pfxy) (Pfxy). +match goal with |- (let fxy0 := f x y in P fxy0 -> P fxy -> P x) => by auto | _ => fail end. +Qed. + +Lemma test4 : forall n m z: bool, n = z -> let x := n in x = m && n -> x = m && n. +move=> n m z E x H. +case: true. + by rewrite {1 2}E in (x) H |- *. +by rewrite {1}E in x H |- *. +Qed. diff --git a/test-suite/ssr/wlong_intro.v b/test-suite/ssr/wlong_intro.v new file mode 100644 index 00000000..dd80f043 --- /dev/null +++ b/test-suite/ssr/wlong_intro.v @@ -0,0 +1,20 @@ +(************************************************************************) +(* * The Coq Proof Assistant / The Coq Development Team *) +(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) +(* <O___,, * (see CREDITS file for the list of authors) *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(* * (see LICENSE file for the text of the license) *) +(************************************************************************) + +(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) + +Require Import ssreflect. +Require Import ssrbool. +Require Import TestSuite.ssr_mini_mathcomp. + +Goal (forall x y : nat, True). +move=> x y. +wlog suff: x y / x <= y. +Admitted. diff --git a/test-suite/stm/Nijmegen_QArithSternBrocot_Zaux.v b/test-suite/stm/Nijmegen_QArithSternBrocot_Zaux.v index 06357cfc..3c427237 100644 --- a/test-suite/stm/Nijmegen_QArithSternBrocot_Zaux.v +++ b/test-suite/stm/Nijmegen_QArithSternBrocot_Zaux.v @@ -23,7 +23,7 @@ Require Export ZArithRing. Tactic Notation "ElimCompare" constr(c) constr(d) := elim_compare c d. Ltac Flip := - apply Zgt_lt || apply Zlt_gt || apply Zle_ge || apply Zge_le; assumption. + apply Z.gt_lt || apply Z.lt_gt || apply Z.le_ge || apply Z.ge_le; assumption. Ltac Falsum := try intro; apply False_ind; @@ -37,12 +37,12 @@ Ltac Falsum := Ltac Step_l a := match goal with | |- (?X1 < ?X2)%Z => replace X1 with a; [ idtac | try ring ] - end. + end. Ltac Step_r a := match goal with | |- (?X1 < ?X2)%Z => replace X2 with a; [ idtac | try ring ] - end. + end. Ltac CaseEq formula := generalize (refl_equal formula); pattern formula at -1 in |- *; @@ -53,7 +53,7 @@ Lemma pair_1 : forall (A B : Set) (H : A * B), H = pair (fst H) (snd H). Proof. intros. case H. - intros. + intros. simpl in |- *. reflexivity. Qed. @@ -73,10 +73,10 @@ Proof. Qed. -Section projection. +Section projection. Variable A : Set. Variable P : A -> Prop. - + Definition projP1 (H : sig P) := let (x, h) := H in x. Definition projP2 (H : sig P) := let (x, h) as H return (P (projP1 H)) := H in h. @@ -131,11 +131,11 @@ Declare Right Step neq_stepr. Lemma not_O_S : forall n : nat, n <> 0 -> {p : nat | n = S p}. -Proof. +Proof. intros [| np] Hn; [ exists 0; apply False_ind; apply Hn | exists np ]; - reflexivity. + reflexivity. Qed. - + Lemma lt_minus_neq : forall m n : nat, m < n -> n - m <> 0. Proof. @@ -156,12 +156,12 @@ Proof. Qed. Lemma le_plus_O_l : forall p q : nat, p + q <= 0 -> p = 0. -Proof. +Proof. intros; omega. Qed. Lemma le_plus_O_r : forall p q : nat, p + q <= 0 -> q = 0. -Proof. +Proof. intros; omega. Qed. @@ -228,8 +228,8 @@ Proof. assumption. intro. right. - apply Zle_lt_trans with (m := x). - apply Zge_le. + apply Z.le_lt_trans with (m := x). + apply Z.ge_le. assumption. assumption. Qed. @@ -268,7 +268,7 @@ Proof. left. assumption. intro H0. - generalize (Zge_le _ _ H0). + generalize (Z.ge_le _ _ H0). intro. case (Z_le_lt_eq_dec _ _ H1). intro. @@ -290,25 +290,25 @@ Proof. left. assumption. intro H. - generalize (Zge_le _ _ H). + generalize (Z.ge_le _ _ H). intro H0. case (Z_le_lt_eq_dec y x H0). intro H1. left. right. - apply Zlt_gt. + apply Z.lt_gt. assumption. intro. right. symmetry in |- *. assumption. Qed. - + Lemma Z_dec' : forall x y : Z, {(x < y)%Z} + {(y < x)%Z} + {x = y}. Proof. intros x y. - case (Z_eq_dec x y); intro H; + case (Z.eq_dec x y); intro H; [ right; assumption | left; apply (not_Zeq_inf _ _ H) ]. Qed. @@ -321,7 +321,7 @@ Proof. assumption. intro. right. - apply Zge_le. + apply Z.ge_le. assumption. Qed. @@ -335,7 +335,7 @@ Lemma Z_lt_lt_S_eq_dec : Proof. intros. generalize (Zlt_le_succ _ _ H). - unfold Zsucc in |- *. + unfold Z.succ in |- *. apply Z_le_lt_eq_dec. Qed. @@ -347,7 +347,7 @@ Proof. case (Z_lt_le_dec a c). intro z. right. - intro. + intro. elim H. intros. generalize z. @@ -356,8 +356,8 @@ Proof. intro. case (Z_lt_le_dec b d). intro z0. - right. - intro. + right. + intro. elim H. intros. generalize z0. @@ -367,7 +367,7 @@ Proof. left. split. assumption. - assumption. + assumption. Qed. (*###########################################################################*) @@ -386,30 +386,30 @@ Qed. Lemma Zlt_minus : forall a b : Z, (b < a)%Z -> (0 < a - b)%Z. Proof. - intros a b. + intros a b. intros. apply Zplus_lt_reg_l with b. - unfold Zminus in |- *. + unfold Zminus in |- *. rewrite (Zplus_comm a). - rewrite (Zplus_assoc b (- b)). + rewrite (Zplus_assoc b (- b)). rewrite Zplus_opp_r. - simpl in |- *. - rewrite <- Zplus_0_r_reverse. + simpl in |- *. + rewrite <- Zplus_0_r_reverse. assumption. Qed. Lemma Zle_minus : forall a b : Z, (b <= a)%Z -> (0 <= a - b)%Z. Proof. - intros a b. + intros a b. intros. apply Zplus_le_reg_l with b. - unfold Zminus in |- *. + unfold Zminus in |- *. rewrite (Zplus_comm a). - rewrite (Zplus_assoc b (- b)). + rewrite (Zplus_assoc b (- b)). rewrite Zplus_opp_r. - simpl in |- *. - rewrite <- Zplus_0_r_reverse. + simpl in |- *. + rewrite <- Zplus_0_r_reverse. assumption. Qed. @@ -417,7 +417,7 @@ Lemma Zlt_plus_plus : forall m n p q : Z, (m < n)%Z -> (p < q)%Z -> (m + p < n + q)%Z. Proof. intros. - apply Zlt_trans with (m := (n + p)%Z). + apply Z.lt_trans with (m := (n + p)%Z). rewrite Zplus_comm. rewrite Zplus_comm with (n := n). apply Zplus_lt_compat_l. @@ -459,11 +459,11 @@ Lemma Zge_gt_plus_plus : Proof. intros. case (Zle_lt_or_eq n m). - apply Zge_le. + apply Z.ge_le. assumption. intro. apply Zgt_plus_plus. - apply Zlt_gt. + apply Z.lt_gt. assumption. assumption. intro. @@ -521,7 +521,7 @@ Qed. Lemma Zle_neg_opp : forall x : Z, (x <= 0)%Z -> (0 <= - x)%Z. -Proof. +Proof. intros. apply Zplus_le_reg_l with x. rewrite Zplus_opp_r. @@ -530,7 +530,7 @@ Proof. Qed. Lemma Zle_pos_opp : forall x : Z, (0 <= x)%Z -> (- x <= 0)%Z. -Proof. +Proof. intros. apply Zplus_le_reg_l with x. rewrite Zplus_opp_r. @@ -542,7 +542,7 @@ Qed. Lemma Zge_opp : forall x y : Z, (x <= y)%Z -> (- x >= - y)%Z. Proof. intros. - apply Zle_ge. + apply Z.le_ge. apply Zplus_le_reg_l with (p := (x + y)%Z). ring_simplify (x + y + - y)%Z (x + y + - x)%Z. assumption. @@ -584,8 +584,8 @@ Proof. ring_simplify (- a * x + a * x)%Z. replace (- a * x + a * y)%Z with ((y - x) * a)%Z. apply Zmult_gt_0_le_0_compat. - apply Zlt_gt. - assumption. + apply Z.lt_gt. + assumption. unfold Zminus in |- *. apply Zle_left. assumption. @@ -621,7 +621,7 @@ Proof. rewrite H0. reflexivity. Qed. - + Lemma Zsimpl_mult_l : forall n m p : Z, n <> 0%Z -> (n * m)%Z = (n * p)%Z -> m = p. Proof. @@ -642,14 +642,14 @@ Lemma Zlt_reg_mult_l : Proof. intros. case (Zcompare_Gt_spec x 0). - unfold Zgt in H. + unfold Z.gt in H. assumption. intros. - cut (x = Zpos x0). + cut (x = Zpos x0). intro. rewrite H2. - unfold Zlt in H0. - unfold Zlt in |- *. + unfold Z.lt in H0. + unfold Z.lt in |- *. cut ((Zpos x0 * y ?= Zpos x0 * z)%Z = (y ?= z)%Z). intro. exact (trans_eq H3 H0). @@ -672,10 +672,10 @@ Proof. intro. cut ((y ?= x)%Z = (- x ?= - y)%Z). intro. - exact (trans_eq H0 H1). + exact (trans_eq H0 H1). exact (Zcompare_opp y x). apply sym_eq. - exact (Zlt_gt x y H). + exact (Z.lt_gt x y H). Qed. @@ -698,22 +698,22 @@ Proof. intro. rewrite H6 in H4. assumption. - exact (Zopp_involutive (x * z)). - exact (Zopp_involutive (x * y)). + exact (Z.opp_involutive (x * z)). + exact (Z.opp_involutive (x * y)). cut ((- (- x * y))%Z = (- - (x * y))%Z). intro. rewrite H4 in H3. - cut ((- (- x * z))%Z = (- - (x * z))%Z). + cut ((- (- x * z))%Z = (- - (x * z))%Z). intro. rewrite H5 in H3. assumption. cut ((- x * z)%Z = (- (x * z))%Z). intro. - exact (f_equal Zopp H5). + exact (f_equal Z.opp H5). exact (Zopp_mult_distr_l_reverse x z). cut ((- x * y)%Z = (- (x * y))%Z). intro. - exact (f_equal Zopp H4). + exact (f_equal Z.opp H4). exact (Zopp_mult_distr_l_reverse x y). exact (Zlt_opp (- x * y) (- x * z) H2). exact (Zlt_reg_mult_l (- x) y z H1 H0). @@ -735,14 +735,14 @@ Proof. assumption. exact (sym_eq H2). exact (Zorder.Zlt_not_eq y x H0). - exact (Zgt_lt x y H). + exact (Z.gt_lt x y H). Qed. Lemma Zmult_resp_nonzero : forall x y : Z, x <> 0%Z -> y <> 0%Z -> (x * y)%Z <> 0%Z. Proof. intros x y Hx Hy Hxy. - apply Hx. + apply Hx. apply Zmult_integral_l with y; assumption. Qed. @@ -769,12 +769,12 @@ Qed. Lemma not_Zle_lt : forall x y : Z, ~ (y <= x)%Z -> (x < y)%Z. Proof. - intros; apply Zgt_lt; apply Znot_le_gt; assumption. + intros; apply Z.gt_lt; apply Znot_le_gt; assumption. Qed. Lemma not_Zlt : forall x y : Z, ~ (y < x)%Z -> (x <= y)%Z. Proof. - intros x y H1 H2; apply H1; apply Zgt_lt; assumption. + intros x y H1 H2; apply H1; apply Z.gt_lt; assumption. Qed. @@ -813,7 +813,7 @@ Proof. cut (x > 0)%Z. intro. exact (Zlt_reg_mult_l x y z H4 H2). - exact (Zlt_gt 0 x H3). + exact (Z.lt_gt 0 x H3). intro. apply False_ind. cut (x * z < x * y)%Z. @@ -849,7 +849,7 @@ Proof. cut (x > 0)%Z. intro. exact (Zlt_reg_mult_l x z y H4 H2). - exact (Zlt_gt 0 x H3). + exact (Z.lt_gt 0 x H3). Qed. Lemma Zlt_mult_mult : @@ -857,9 +857,9 @@ Lemma Zlt_mult_mult : (0 < a)%Z -> (0 < d)%Z -> (a < b)%Z -> (c < d)%Z -> (a * c < b * d)%Z. Proof. intros. - apply Zlt_trans with (a * d)%Z. + apply Z.lt_trans with (a * d)%Z. apply Zlt_reg_mult_l. - Flip. + Flip. assumption. rewrite Zmult_comm. rewrite Zmult_comm with b d. @@ -881,11 +881,11 @@ Proof. apply Zgt_not_eq. assumption. trivial. - + intro. case (not_Zeq x y H1). trivial. - + intro. apply False_ind. cut (a * y > a * x)%Z. @@ -913,14 +913,14 @@ Proof. rewrite Zmult_opp_opp. rewrite Zmult_opp_opp. assumption. - apply Zopp_involutive. - apply Zopp_involutive. - apply Zgt_lt. + apply Z.opp_involutive. + apply Z.opp_involutive. + apply Z.gt_lt. apply Zlt_opp. - apply Zgt_lt. + apply Z.gt_lt. assumption. simpl in |- *. - rewrite Zopp_involutive. + rewrite Z.opp_involutive. assumption. Qed. @@ -944,7 +944,7 @@ Proof. constructor. replace (-1 * y)%Z with (- y)%Z. replace (-1 * x)%Z with (- x)%Z. - apply Zlt_gt. + apply Z.lt_gt. assumption. ring. ring. @@ -959,13 +959,13 @@ Proof. trivial. intro. apply False_ind. - apply (Zlt_irrefl (a * x)). - apply Zle_lt_trans with (m := (a * y)%Z). + apply (Z.lt_irrefl (a * x)). + apply Z.le_lt_trans with (m := (a * y)%Z). assumption. - apply Zgt_lt. + apply Z.gt_lt. apply Zlt_conv_mult_l. assumption. - apply Zgt_lt. + apply Z.gt_lt. assumption. Qed. @@ -973,17 +973,17 @@ Lemma Zlt_mult_cancel_l : forall x y z : Z, (0 < x)%Z -> (x * y < x * z)%Z -> (y < z)%Z. Proof. intros. - apply Zgt_lt. + apply Z.gt_lt. apply Zgt_mult_reg_absorb_l with x. - apply Zlt_gt. - assumption. - apply Zlt_gt. + apply Z.lt_gt. + assumption. + apply Z.lt_gt. assumption. Qed. - + Lemma Zmin_cancel_Zle : forall x y : Z, (- x <= - y)%Z -> (y <= x)%Z. -Proof. +Proof. intros. apply Zmult_cancel_Zle with (a := (-1)%Z). constructor. @@ -1004,18 +1004,18 @@ Proof. trivial. intro. apply False_ind. - apply (Zlt_irrefl (a * y)). - apply Zle_lt_trans with (m := (a * x)%Z). + apply (Z.lt_irrefl (a * y)). + apply Z.le_lt_trans with (m := (a * x)%Z). assumption. apply Zlt_reg_mult_l. - apply Zlt_gt. + apply Z.lt_gt. assumption. - apply Zgt_lt. + apply Z.gt_lt. assumption. Qed. Lemma Zopp_Zle : forall x y : Z, (y <= x)%Z -> (- x <= - y)%Z. -Proof. +Proof. intros. apply Zmult_cancel_Zle with (a := (-1)%Z). constructor. @@ -1026,7 +1026,7 @@ Proof. clear x H; ring. Qed. - + Lemma Zle_lt_eq_S : forall x y : Z, (x <= y)%Z -> (y < x + 1)%Z -> y = x. Proof. intros. @@ -1035,8 +1035,8 @@ Proof. apply False_ind. generalize (Zlt_le_succ x y H1). intro. - apply (Zlt_not_le y (x + 1) H0). - replace (x + 1)%Z with (Zsucc x). + apply (Zlt_not_le y (x + 1) H0). + replace (x + 1)%Z with (Z.succ x). assumption. reflexivity. intro H1. @@ -1053,8 +1053,8 @@ Proof. apply False_ind. generalize (Zlt_le_succ x y H). intro. - apply (Zlt_not_le y (x + 1) H1). - replace (x + 1)%Z with (Zsucc x). + apply (Zlt_not_le y (x + 1) H1). + replace (x + 1)%Z with (Z.succ x). assumption. reflexivity. trivial. @@ -1067,9 +1067,9 @@ Proof. intros. case (Z_zerop c). intro. - rewrite e. + rewrite e. left. - apply sym_not_eq. + apply sym_not_eq. intro. apply H; repeat split; assumption. intro; right; assumption. @@ -1085,21 +1085,21 @@ Proof. [ apply False_ind; apply H; repeat split | right; right ] | right; left ] | left ]; assumption. -Qed. +Qed. Lemma mediant_1 : forall m n m' n' : Z, (m' * n < m * n')%Z -> ((m + m') * n < m * (n + n'))%Z. Proof. - intros. - rewrite Zmult_plus_distr_r. + intros. + rewrite Zmult_plus_distr_r. rewrite Zmult_plus_distr_l. apply Zplus_lt_compat_l. assumption. Qed. - + Lemma mediant_2 : forall m n m' n' : Z, - (m' * n < m * n')%Z -> (m' * (n + n') < (m + m') * n')%Z. + (m' * n < m * n')%Z -> (m' * (n + n') < (m + m') * n')%Z. Proof. intros. rewrite Zmult_plus_distr_l. @@ -1121,7 +1121,7 @@ Proof. assumption. assumption. ring. -Qed. +Qed. Lemma fraction_lt_trans : forall a b c d e f : Z, @@ -1130,21 +1130,21 @@ Lemma fraction_lt_trans : (0 < f)%Z -> (a * d < c * b)%Z -> (c * f < e * d)%Z -> (a * f < e * b)%Z. Proof. intros. - apply Zgt_lt. + apply Z.gt_lt. apply Zgt_mult_reg_absorb_l with d. Flip. apply Zgt_trans with (c * b * f)%Z. replace (d * (e * b))%Z with (b * (e * d))%Z. replace (c * b * f)%Z with (b * (c * f))%Z. - apply Zlt_gt. + apply Z.lt_gt. apply Zlt_reg_mult_l. Flip. assumption. ring. ring. - replace (c * b * f)%Z with (f * (c * b))%Z. + replace (c * b * f)%Z with (f * (c * b))%Z. replace (d * (a * f))%Z with (f * (a * d))%Z. - apply Zlt_gt. + apply Z.lt_gt. apply Zlt_reg_mult_l. Flip. assumption. @@ -1157,7 +1157,7 @@ Lemma square_pos : forall a : Z, a <> 0%Z -> (0 < a * a)%Z. Proof. intros [| p| p]; intros; [ Falsum | constructor | constructor ]. Qed. - + Hint Resolve square_pos: zarith. (*###########################################################################*) @@ -1182,19 +1182,19 @@ Proof. intros. unfold Z_of_nat in |- *. rewrite H0. - + apply f_equal with (A := positive) (B := Z) (f := Zpos). cut (P_of_succ_nat (nat_of_P p) = P_of_succ_nat (S x)). intro. rewrite P_of_succ_nat_o_nat_of_P_eq_succ in H1. - cut (Ppred (Psucc p) = Ppred (P_of_succ_nat (S x))). + cut (Pos.pred (Pos.succ p) = Pos.pred (P_of_succ_nat (S x))). intro. - rewrite Ppred_succ in H2. + rewrite Pos.pred_succ in H2. simpl in H2. - rewrite Ppred_succ in H2. + rewrite Pos.pred_succ in H2. apply sym_eq. assumption. - apply f_equal with (A := positive) (B := positive) (f := Ppred). + apply f_equal with (A := positive) (B := positive) (f := Pos.pred). assumption. apply f_equal with (f := P_of_succ_nat). assumption. @@ -1222,7 +1222,7 @@ Lemma NEG_neq_ZERO : forall p : positive, Zneg p <> 0%Z. Proof. intros. apply Zorder.Zlt_not_eq. - unfold Zlt in |- *. + unfold Z.lt in |- *. constructor. Qed. @@ -1237,7 +1237,7 @@ Qed. Lemma nat_nat_pos : forall m n : nat, ((m + 1) * (n + 1) > 0)%Z. (*QF*) Proof. intros. - apply Zlt_gt. + apply Z.lt_gt. cut (Z_of_nat m + 1 > 0)%Z. intro. cut (0 < Z_of_nat n + 1)%Z. @@ -1246,24 +1246,24 @@ Proof. rewrite Zmult_0_r. intro. assumption. - + apply Zlt_reg_mult_l. assumption. assumption. - change (0 < Zsucc (Z_of_nat n))%Z in |- *. + change (0 < Z.succ (Z_of_nat n))%Z in |- *. apply Zle_lt_succ. change (Z_of_nat 0 <= Z_of_nat n)%Z in |- *. apply Znat.inj_le. apply le_O_n. - apply Zlt_gt. - change (0 < Zsucc (Z_of_nat m))%Z in |- *. + apply Z.lt_gt. + change (0 < Z.succ (Z_of_nat m))%Z in |- *. apply Zle_lt_succ. change (Z_of_nat 0 <= Z_of_nat m)%Z in |- *. apply Znat.inj_le. apply le_O_n. Qed. - - + + Theorem S_predn : forall m : nat, m <> 0 -> S (pred m) = m. (*QF*) Proof. intros. @@ -1271,8 +1271,8 @@ Proof. intro. case s. intros. - rewrite <- e. - rewrite <- pred_Sn with (n := x). + rewrite <- e. + rewrite <- pred_Sn with (n := x). trivial. intro. apply False_ind. @@ -1281,7 +1281,7 @@ Proof. assumption. Qed. -Lemma absolu_1 : forall x : Z, Zabs_nat x = 0 -> x = 0%Z. (*QF*) +Lemma absolu_1 : forall x : Z, Z.abs_nat x = 0 -> x = 0%Z. (*QF*) Proof. intros. case (dec_eq x 0). @@ -1302,15 +1302,15 @@ Proof. apply proj1 with (B := x = 0%Z -> (x ?= 0)%Z = Datatypes.Eq). change ((x ?= 0)%Z = Datatypes.Eq <-> x = 0%Z) in |- *. apply Zcompare_Eq_iff_eq. - + (***) intro. - cut (exists h : nat, Zabs_nat x = S h). + cut (exists h : nat, Z.abs_nat x = S h). intro. case H3. rewrite H. exact O_S. - + change (x < 0)%Z in H2. cut (0 > x)%Z. intro. @@ -1324,7 +1324,7 @@ Proof. case H6. intros. rewrite H7. - unfold Zabs_nat in |- *. + unfold Z.abs_nat in |- *. generalize x1. exact ZL4. cut (x = (- Zpos x0)%Z). @@ -1335,21 +1335,21 @@ Proof. cut ((- - x)%Z = x). intro. rewrite <- H6. - exact (f_equal Zopp H5). - apply Zopp_involutive. + exact (f_equal Z.opp H5). + apply Z.opp_involutive. apply Zcompare_Gt_spec. assumption. - apply Zlt_gt. + apply Z.lt_gt. assumption. - + (***) intro. - cut (exists h : nat, Zabs_nat x = S h). + cut (exists h : nat, Z.abs_nat x = S h). intro. case H3. rewrite H. exact O_S. - + cut (exists p : positive, (x + - (0))%Z = Zpos p). simpl in |- *. rewrite Zplus_0_r. @@ -1357,12 +1357,12 @@ Proof. case H3. intros. rewrite H4. - unfold Zabs_nat in |- *. + unfold Z.abs_nat in |- *. generalize x0. exact ZL4. apply Zcompare_Gt_spec. assumption. - + (***) cut ((x < 0)%Z \/ (0 < x)%Z). intro. @@ -1373,14 +1373,14 @@ Proof. assumption. intro. right. - apply Zlt_gt. + apply Z.lt_gt. assumption. assumption. apply not_Zeq. assumption. Qed. -Lemma absolu_2 : forall x : Z, x <> 0%Z -> Zabs_nat x <> 0. (*QF*) +Lemma absolu_2 : forall x : Z, x <> 0%Z -> Z.abs_nat x <> 0. (*QF*) Proof. intros. intro. @@ -1392,7 +1392,7 @@ Qed. -Lemma absolu_inject_nat : forall n : nat, Zabs_nat (Z_of_nat n) = n. +Lemma absolu_inject_nat : forall n : nat, Z.abs_nat (Z_of_nat n) = n. Proof. simple induction n; simpl in |- *. reflexivity. @@ -1404,7 +1404,7 @@ Qed. Lemma eq_inj : forall m n : nat, m = n :>Z -> m = n. Proof. intros. - generalize (f_equal Zabs_nat H). + generalize (f_equal Z.abs_nat H). intro. rewrite (absolu_inject_nat m) in H0. rewrite (absolu_inject_nat n) in H0. @@ -1438,7 +1438,7 @@ Qed. Lemma le_absolu : forall x y : Z, - (0 <= x)%Z -> (0 <= y)%Z -> (x <= y)%Z -> Zabs_nat x <= Zabs_nat y. + (0 <= x)%Z -> (0 <= y)%Z -> (x <= y)%Z -> Z.abs_nat x <= Z.abs_nat y. Proof. intros [| x| x] [| y| y] Hx Hy Hxy; apply le_O_n || @@ -1451,7 +1451,7 @@ Proof. | id1:(Zpos _ <= Zneg _)%Z |- _ => apply False_ind; apply id1; constructor end). - simpl in |- *. + simpl in |- *. apply le_inj. do 2 rewrite ZL9. assumption. @@ -1459,7 +1459,7 @@ Qed. Lemma lt_absolu : forall x y : Z, - (0 <= x)%Z -> (0 <= y)%Z -> (x < y)%Z -> Zabs_nat x < Zabs_nat y. + (0 <= x)%Z -> (0 <= y)%Z -> (x < y)%Z -> Z.abs_nat x < Z.abs_nat y. Proof. intros [| x| x] [| y| y] Hx Hy Hxy; inversion Hxy; try @@ -1470,13 +1470,13 @@ Proof. apply False_ind; apply id1; constructor | id1:(Zpos _ <= Zneg _)%Z |- _ => apply False_ind; apply id1; constructor - end; simpl in |- *; apply lt_inj; repeat rewrite ZL9; + end; simpl in |- *; apply lt_inj; repeat rewrite ZL9; assumption. Qed. Lemma absolu_plus : forall x y : Z, - (0 <= x)%Z -> (0 <= y)%Z -> Zabs_nat (x + y) = Zabs_nat x + Zabs_nat y. + (0 <= x)%Z -> (0 <= y)%Z -> Z.abs_nat (x + y) = Z.abs_nat x + Z.abs_nat y. Proof. intros [| x| x] [| y| y] Hx Hy; trivial; try @@ -1489,23 +1489,23 @@ Proof. apply False_ind; apply id1; constructor end. rewrite <- BinInt.Zpos_plus_distr. - unfold Zabs_nat in |- *. + unfold Z.abs_nat in |- *. apply nat_of_P_plus_morphism. Qed. Lemma pred_absolu : - forall x : Z, (0 < x)%Z -> pred (Zabs_nat x) = Zabs_nat (x - 1). + forall x : Z, (0 < x)%Z -> pred (Z.abs_nat x) = Z.abs_nat (x - 1). Proof. intros x Hx. generalize (Z_lt_lt_S_eq_dec 0 x Hx); simpl in |- *; intros [H1| H1]; - [ replace (Zabs_nat x) with (Zabs_nat (x - 1 + 1)); + [ replace (Z.abs_nat x) with (Z.abs_nat (x - 1 + 1)); [ idtac | apply f_equal with Z; auto with zarith ]; rewrite absolu_plus; - [ unfold Zabs_nat at 2, nat_of_P, Piter_op in |- *; omega + [ unfold Z.abs_nat at 2, nat_of_P, Pos.iter_op in |- *; omega | auto with zarith | intro; discriminate ] | rewrite <- H1; reflexivity ]. -Qed. +Qed. Definition pred_nat : forall (x : Z) (Hx : (0 < x)%Z), nat. intros [| px| px] Hx; try abstract (discriminate Hx). @@ -1535,7 +1535,7 @@ Proof. Qed. Lemma absolu_pred_nat : - forall (m : Z) (Hm : (0 < m)%Z), S (pred_nat m Hm) = Zabs_nat m. + forall (m : Z) (Hm : (0 < m)%Z), S (pred_nat m Hm) = Z.abs_nat m. Proof. intros [| px| px] Hx; try discriminate Hx. unfold pred_nat in |- *. @@ -1545,7 +1545,7 @@ Proof. Qed. Lemma pred_nat_absolu : - forall (m : Z) (Hm : (0 < m)%Z), pred_nat m Hm = Zabs_nat (m - 1). + forall (m : Z) (Hm : (0 < m)%Z), pred_nat m Hm = Z.abs_nat (m - 1). Proof. intros [| px| px] Hx; try discriminate Hx. unfold pred_nat in |- *. @@ -1557,15 +1557,15 @@ Lemma minus_pred_nat : S (pred_nat n Hn) - S (pred_nat m Hm) = S (pred_nat (n - m) Hnm). Proof. intros. - simpl in |- *. + simpl in |- *. destruct n; try discriminate Hn. destruct m; try discriminate Hm. unfold pred_nat at 1 2 in |- *. rewrite minus_pred; try apply lt_O_nat_of_P. apply eq_inj. - rewrite <- pred_nat_unfolded. + rewrite <- pred_nat_unfolded. rewrite Znat.inj_minus1. - repeat rewrite ZL9. + repeat rewrite ZL9. reflexivity. apply le_inj. apply Zlt_le_weak. @@ -1581,13 +1581,13 @@ Qed. Lemma Zsgn_1 : - forall x : Z, {Zsgn x = 0%Z} + {Zsgn x = 1%Z} + {Zsgn x = (-1)%Z}. (*QF*) + forall x : Z, {Z.sgn x = 0%Z} + {Z.sgn x = 1%Z} + {Z.sgn x = (-1)%Z}. (*QF*) Proof. intros. case x. left. left. - unfold Zsgn in |- *. + unfold Z.sgn in |- *. reflexivity. intro. simpl in |- *. @@ -1601,13 +1601,13 @@ Proof. Qed. -Lemma Zsgn_2 : forall x : Z, Zsgn x = 0%Z -> x = 0%Z. (*QF*) +Lemma Zsgn_2 : forall x : Z, Z.sgn x = 0%Z -> x = 0%Z. (*QF*) Proof. intros [| p1| p1]; simpl in |- *; intro H; constructor || discriminate H. Qed. -Lemma Zsgn_3 : forall x : Z, x <> 0%Z -> Zsgn x <> 0%Z. (*QF*) +Lemma Zsgn_3 : forall x : Z, x <> 0%Z -> Z.sgn x <> 0%Z. (*QF*) Proof. intro. case x. @@ -1626,21 +1626,21 @@ Qed. -Theorem Zsgn_4 : forall a : Z, a = (Zsgn a * Zabs_nat a)%Z. (*QF*) +Theorem Zsgn_4 : forall a : Z, a = (Z.sgn a * Z.abs_nat a)%Z. (*QF*) Proof. intro. case a. simpl in |- *. reflexivity. intro. - unfold Zsgn in |- *. - unfold Zabs_nat in |- *. + unfold Z.sgn in |- *. + unfold Z.abs_nat in |- *. rewrite Zmult_1_l. symmetry in |- *. apply ZL9. intros. - unfold Zsgn in |- *. - unfold Zabs_nat in |- *. + unfold Z.sgn in |- *. + unfold Z.abs_nat in |- *. rewrite ZL9. constructor. Qed. @@ -1650,7 +1650,7 @@ Theorem Zsgn_5 : forall a b x y : Z, x <> 0%Z -> y <> 0%Z -> - (Zsgn a * x)%Z = (Zsgn b * y)%Z -> (Zsgn a * y)%Z = (Zsgn b * x)%Z. (*QF*) + (Z.sgn a * x)%Z = (Z.sgn b * y)%Z -> (Z.sgn a * y)%Z = (Z.sgn b * x)%Z. (*QF*) Proof. intros a b x y H H0. case a. @@ -1660,7 +1660,7 @@ Proof. trivial. intro. - unfold Zsgn in |- *. + unfold Z.sgn in |- *. intro. rewrite Zmult_1_l in H1. simpl in H1. @@ -1669,11 +1669,11 @@ Proof. symmetry in |- *. assumption. intro. - unfold Zsgn in |- *. + unfold Z.sgn in |- *. intro. apply False_ind. apply H0. - apply Zopp_inj. + apply Z.opp_inj. simpl in |- *. transitivity (-1 * y)%Z. constructor. @@ -1683,13 +1683,13 @@ Proof. simpl in |- *. reflexivity. intro. - unfold Zsgn at 1 in |- *. - unfold Zsgn at 2 in |- *. + unfold Z.sgn at 1 in |- *. + unfold Z.sgn at 2 in |- *. intro. transitivity y. rewrite Zmult_1_l. reflexivity. - transitivity (Zsgn b * (Zsgn b * y))%Z. + transitivity (Z.sgn b * (Z.sgn b * y))%Z. case (Zsgn_1 b). intro. case s. @@ -1712,20 +1712,20 @@ Proof. rewrite H1. reflexivity. intro. - unfold Zsgn at 1 in |- *. - unfold Zsgn at 2 in |- *. + unfold Z.sgn at 1 in |- *. + unfold Z.sgn at 2 in |- *. intro. - transitivity (Zsgn b * (-1 * (Zsgn b * y)))%Z. + transitivity (Z.sgn b * (-1 * (Z.sgn b * y)))%Z. case (Zsgn_1 b). intros. case s. intro. apply False_ind. apply H. - apply Zopp_inj. + apply Z.opp_inj. transitivity (-1 * x)%Z. ring. - unfold Zopp in |- *. + unfold Z.opp in |- *. rewrite e in H1. transitivity (0 * y)%Z. assumption. @@ -1741,7 +1741,7 @@ Proof. ring. Qed. -Lemma Zsgn_6 : forall x : Z, x = 0%Z -> Zsgn x = 0%Z. +Lemma Zsgn_6 : forall x : Z, x = 0%Z -> Z.sgn x = 0%Z. Proof. intros. rewrite H. @@ -1750,44 +1750,44 @@ Proof. Qed. -Lemma Zsgn_7 : forall x : Z, (x > 0)%Z -> Zsgn x = 1%Z. +Lemma Zsgn_7 : forall x : Z, (x > 0)%Z -> Z.sgn x = 1%Z. Proof. intro. case x. intro. apply False_ind. - apply (Zlt_irrefl 0). + apply (Z.lt_irrefl 0). Flip. intros. simpl in |- *. reflexivity. intros. apply False_ind. - apply (Zlt_irrefl (Zneg p)). - apply Zlt_trans with 0%Z. + apply (Z.lt_irrefl (Zneg p)). + apply Z.lt_trans with 0%Z. constructor. Flip. Qed. -Lemma Zsgn_7' : forall x : Z, (0 < x)%Z -> Zsgn x = 1%Z. +Lemma Zsgn_7' : forall x : Z, (0 < x)%Z -> Z.sgn x = 1%Z. Proof. intros; apply Zsgn_7; Flip. Qed. -Lemma Zsgn_8 : forall x : Z, (x < 0)%Z -> Zsgn x = (-1)%Z. +Lemma Zsgn_8 : forall x : Z, (x < 0)%Z -> Z.sgn x = (-1)%Z. Proof. intro. case x. intro. apply False_ind. - apply (Zlt_irrefl 0). + apply (Z.lt_irrefl 0). assumption. intros. apply False_ind. - apply (Zlt_irrefl 0). - apply Zlt_trans with (Zpos p). + apply (Z.lt_irrefl 0). + apply Z.lt_trans with (Zpos p). constructor. assumption. intros. @@ -1795,7 +1795,7 @@ Proof. reflexivity. Qed. -Lemma Zsgn_9 : forall x : Z, Zsgn x = 1%Z -> (0 < x)%Z. +Lemma Zsgn_9 : forall x : Z, Z.sgn x = 1%Z -> (0 < x)%Z. Proof. intro. case x. @@ -1809,8 +1809,8 @@ Proof. apply False_ind. discriminate. Qed. - -Lemma Zsgn_10 : forall x : Z, Zsgn x = (-1)%Z -> (x < 0)%Z. + +Lemma Zsgn_10 : forall x : Z, Z.sgn x = (-1)%Z -> (x < 0)%Z. Proof. intro. case x. @@ -1822,9 +1822,9 @@ Proof. discriminate. intros. constructor. -Qed. +Qed. -Lemma Zsgn_11 : forall x : Z, (Zsgn x < 0)%Z -> (x < 0)%Z. +Lemma Zsgn_11 : forall x : Z, (Z.sgn x < 0)%Z -> (x < 0)%Z. Proof. intros. apply Zsgn_10. @@ -1833,7 +1833,7 @@ Proof. apply False_ind. case s. intro. - generalize (Zorder.Zlt_not_eq _ _ H). + generalize (Zorder.Zlt_not_eq _ _ H). intro. apply (H0 e). intro. @@ -1842,9 +1842,9 @@ Proof. intro. discriminate. trivial. -Qed. +Qed. -Lemma Zsgn_12 : forall x : Z, (0 < Zsgn x)%Z -> (0 < x)%Z. +Lemma Zsgn_12 : forall x : Z, (0 < Z.sgn x)%Z -> (0 < x)%Z. Proof. intros. apply Zsgn_9. @@ -1852,7 +1852,7 @@ Proof. intro. case s. intro. - generalize (Zorder.Zlt_not_eq _ _ H). + generalize (Zorder.Zlt_not_eq _ _ H). intro. generalize (sym_eq e). intro. @@ -1865,78 +1865,78 @@ Proof. intro. apply False_ind. discriminate. -Qed. +Qed. -Lemma Zsgn_13 : forall x : Z, (0 <= Zsgn x)%Z -> (0 <= x)%Z. +Lemma Zsgn_13 : forall x : Z, (0 <= Z.sgn x)%Z -> (0 <= x)%Z. Proof. - intros. - case (Z_le_lt_eq_dec 0 (Zsgn x) H). + intros. + case (Z_le_lt_eq_dec 0 (Z.sgn x) H). intro. apply Zlt_le_weak. apply Zsgn_12. - assumption. + assumption. intro. - assert (x = 0%Z). + assert (x = 0%Z). apply Zsgn_2. symmetry in |- *. assumption. rewrite H0. - apply Zle_refl. + apply Z.le_refl. Qed. -Lemma Zsgn_14 : forall x : Z, (Zsgn x <= 0)%Z -> (x <= 0)%Z. +Lemma Zsgn_14 : forall x : Z, (Z.sgn x <= 0)%Z -> (x <= 0)%Z. Proof. - intros. - case (Z_le_lt_eq_dec (Zsgn x) 0 H). + intros. + case (Z_le_lt_eq_dec (Z.sgn x) 0 H). intro. apply Zlt_le_weak. apply Zsgn_11. - assumption. + assumption. intro. - assert (x = 0%Z). + assert (x = 0%Z). apply Zsgn_2. assumption. rewrite H0. - apply Zle_refl. + apply Z.le_refl. Qed. -Lemma Zsgn_15 : forall x y : Z, Zsgn (x * y) = (Zsgn x * Zsgn y)%Z. +Lemma Zsgn_15 : forall x y : Z, Z.sgn (x * y) = (Z.sgn x * Z.sgn y)%Z. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; constructor. Qed. Lemma Zsgn_16 : forall x y : Z, - Zsgn (x * y) = 1%Z -> {(0 < x)%Z /\ (0 < y)%Z} + {(x < 0)%Z /\ (y < 0)%Z}. + Z.sgn (x * y) = 1%Z -> {(0 < x)%Z /\ (0 < y)%Z} + {(x < 0)%Z /\ (y < 0)%Z}. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; try discriminate H; [ left | right ]; repeat split. -Qed. +Qed. Lemma Zsgn_17 : forall x y : Z, - Zsgn (x * y) = (-1)%Z -> {(0 < x)%Z /\ (y < 0)%Z} + {(x < 0)%Z /\ (0 < y)%Z}. + Z.sgn (x * y) = (-1)%Z -> {(0 < x)%Z /\ (y < 0)%Z} + {(x < 0)%Z /\ (0 < y)%Z}. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; try discriminate H; [ left | right ]; repeat split. -Qed. +Qed. -Lemma Zsgn_18 : forall x y : Z, Zsgn (x * y) = 0%Z -> {x = 0%Z} + {y = 0%Z}. +Lemma Zsgn_18 : forall x y : Z, Z.sgn (x * y) = 0%Z -> {x = 0%Z} + {y = 0%Z}. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; try discriminate H; [ left | right | right ]; constructor. -Qed. +Qed. -Lemma Zsgn_19 : forall x y : Z, (0 < Zsgn x + Zsgn y)%Z -> (0 < x + y)%Z. +Lemma Zsgn_19 : forall x y : Z, (0 < Z.sgn x + Z.sgn y)%Z -> (0 < x + y)%Z. Proof. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; discriminate H || (constructor || apply Zsgn_12; assumption). Qed. -Lemma Zsgn_20 : forall x y : Z, (Zsgn x + Zsgn y < 0)%Z -> (x + y < 0)%Z. +Lemma Zsgn_20 : forall x y : Z, (Z.sgn x + Z.sgn y < 0)%Z -> (x + y < 0)%Z. Proof. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; @@ -1944,43 +1944,43 @@ Proof. Qed. -Lemma Zsgn_21 : forall x y : Z, (0 < Zsgn x + Zsgn y)%Z -> (0 <= x)%Z. +Lemma Zsgn_21 : forall x y : Z, (0 < Z.sgn x + Z.sgn y)%Z -> (0 <= x)%Z. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intros H H0; discriminate H || discriminate H0. Qed. -Lemma Zsgn_22 : forall x y : Z, (Zsgn x + Zsgn y < 0)%Z -> (x <= 0)%Z. +Lemma Zsgn_22 : forall x y : Z, (Z.sgn x + Z.sgn y < 0)%Z -> (x <= 0)%Z. Proof. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intros H H0; discriminate H || discriminate H0. Qed. -Lemma Zsgn_23 : forall x y : Z, (0 < Zsgn x + Zsgn y)%Z -> (0 <= y)%Z. +Lemma Zsgn_23 : forall x y : Z, (0 < Z.sgn x + Z.sgn y)%Z -> (0 <= y)%Z. Proof. intros [|p1|p1] [|p2|p2]; simpl in |- *; intros H H0; discriminate H || discriminate H0. Qed. -Lemma Zsgn_24 : forall x y : Z, (Zsgn x + Zsgn y < 0)%Z -> (y <= 0)%Z. +Lemma Zsgn_24 : forall x y : Z, (Z.sgn x + Z.sgn y < 0)%Z -> (y <= 0)%Z. Proof. intros [|p1|p1] [|p2|p2]; simpl in |- *; intros H H0; discriminate H || discriminate H0. Qed. -Lemma Zsgn_25 : forall x : Z, Zsgn (- x) = (- Zsgn x)%Z. +Lemma Zsgn_25 : forall x : Z, Z.sgn (- x) = (- Z.sgn x)%Z. Proof. intros [| p1| p1]; simpl in |- *; reflexivity. Qed. -Lemma Zsgn_26 : forall x : Z, (0 < x)%Z -> (0 < Zsgn x)%Z. +Lemma Zsgn_26 : forall x : Z, (0 < x)%Z -> (0 < Z.sgn x)%Z. Proof. intros [| p| p] Hp; trivial. Qed. -Lemma Zsgn_27 : forall x : Z, (x < 0)%Z -> (Zsgn x < 0)%Z. +Lemma Zsgn_27 : forall x : Z, (x < 0)%Z -> (Z.sgn x < 0)%Z. Proof. intros [| p| p] Hp; trivial. Qed. @@ -1994,7 +1994,7 @@ Hint Resolve Zsgn_1 Zsgn_2 Zsgn_3 Zsgn_4 Zsgn_5 Zsgn_6 Zsgn_7 Zsgn_7' Zsgn_8 (** Properties of Zabs *) (*###########################################################################*) -Lemma Zabs_1 : forall z p : Z, (Zabs z < p)%Z -> (z < p)%Z /\ (- p < z)%Z. +Lemma Zabs_1 : forall z p : Z, (Z.abs z < p)%Z -> (z < p)%Z /\ (- p < z)%Z. Proof. intros z p. case z. @@ -2003,25 +2003,25 @@ Proof. split. assumption. apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). - replace (-1)%Z with (Zpred 0). + replace (-1)%Z with (Z.pred 0). apply Zlt_pred. simpl; trivial. ring_simplify (-1 * - p)%Z (-1 * 0)%Z. - apply Zlt_gt. + apply Z.lt_gt. assumption. intros. simpl in H. split. assumption. - apply Zlt_trans with (m := 0%Z). + apply Z.lt_trans with (m := 0%Z). apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). - replace (-1)%Z with (Zpred 0). + replace (-1)%Z with (Z.pred 0). apply Zlt_pred. simpl; trivial. ring_simplify (-1 * - p)%Z (-1 * 0)%Z. - apply Zlt_gt. - apply Zlt_trans with (m := Zpos p0). + apply Z.lt_gt. + apply Z.lt_trans with (m := Zpos p0). constructor. assumption. constructor. @@ -2029,28 +2029,28 @@ Proof. intros. simpl in H. split. - apply Zlt_trans with (m := Zpos p0). + apply Z.lt_trans with (m := Zpos p0). constructor. assumption. - + apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). - replace (-1)%Z with (Zpred 0). + replace (-1)%Z with (Z.pred 0). apply Zlt_pred. simpl;trivial. ring_simplify (-1 * - p)%Z. replace (-1 * Zneg p0)%Z with (- Zneg p0)%Z. - replace (- Zneg p0)%Z with (Zpos p0). - apply Zlt_gt. + replace (- Zneg p0)%Z with (Zpos p0). + apply Z.lt_gt. assumption. symmetry in |- *. apply Zopp_neg. - rewrite Zopp_mult_distr_l_reverse with (n := 1%Z). + rewrite Zopp_mult_distr_l_reverse with (n := 1%Z). simpl in |- *. constructor. Qed. -Lemma Zabs_2 : forall z p : Z, (Zabs z > p)%Z -> (z > p)%Z \/ (- p > z)%Z. +Lemma Zabs_2 : forall z p : Z, (Z.abs z > p)%Z -> (z > p)%Z \/ (- p > z)%Z. Proof. intros z p. case z. @@ -2067,7 +2067,7 @@ Proof. intros. simpl in H. right. - apply Zlt_gt. + apply Z.lt_gt. apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). constructor. ring_simplify (-1 * - p)%Z. @@ -2076,22 +2076,22 @@ Proof. reflexivity. Qed. -Lemma Zabs_3 : forall z p : Z, (z < p)%Z /\ (- p < z)%Z -> (Zabs z < p)%Z. +Lemma Zabs_3 : forall z p : Z, (z < p)%Z /\ (- p < z)%Z -> (Z.abs z < p)%Z. Proof. intros z p. case z. - intro. + intro. simpl in |- *. elim H. intros. assumption. - + intros. elim H. intros. simpl in |- *. assumption. - + intros. elim H. intros. @@ -2100,14 +2100,14 @@ Proof. constructor. replace (-1 * Zpos p0)%Z with (Zneg p0). replace (-1 * p)%Z with (- p)%Z. - apply Zlt_gt. + apply Z.lt_gt. assumption. - ring. + ring. simpl in |- *. reflexivity. Qed. -Lemma Zabs_4 : forall z p : Z, (Zabs z < p)%Z -> (- p < z < p)%Z. +Lemma Zabs_4 : forall z p : Z, (Z.abs z < p)%Z -> (- p < z < p)%Z. Proof. intros. split. @@ -2118,28 +2118,28 @@ Proof. apply Zabs_1. assumption. Qed. - -Lemma Zabs_5 : forall z p : Z, (Zabs z <= p)%Z -> (- p <= z <= p)%Z. + +Lemma Zabs_5 : forall z p : Z, (Z.abs z <= p)%Z -> (- p <= z <= p)%Z. Proof. intros. split. - replace (- p)%Z with (Zsucc (- Zsucc p)). + replace (- p)%Z with (Z.succ (- Z.succ p)). apply Zlt_le_succ. - apply proj2 with (A := (z < Zsucc p)%Z). + apply proj2 with (A := (z < Z.succ p)%Z). apply Zabs_1. apply Zle_lt_succ. assumption. - unfold Zsucc in |- *. + unfold Z.succ in |- *. ring. apply Zlt_succ_le. - apply proj1 with (B := (- Zsucc p < z)%Z). + apply proj1 with (B := (- Z.succ p < z)%Z). apply Zabs_1. apply Zle_lt_succ. assumption. Qed. -Lemma Zabs_6 : forall z p : Z, (Zabs z <= p)%Z -> (z <= p)%Z. +Lemma Zabs_6 : forall z p : Z, (Z.abs z <= p)%Z -> (z <= p)%Z. Proof. intros. apply proj2 with (A := (- p <= z)%Z). @@ -2147,7 +2147,7 @@ Proof. assumption. Qed. -Lemma Zabs_7 : forall z p : Z, (Zabs z <= p)%Z -> (- p <= z)%Z. +Lemma Zabs_7 : forall z p : Z, (Z.abs z <= p)%Z -> (- p <= z)%Z. Proof. intros. apply proj1 with (B := (z <= p)%Z). @@ -2155,7 +2155,7 @@ Proof. assumption. Qed. -Lemma Zabs_8 : forall z p : Z, (- p <= z <= p)%Z -> (Zabs z <= p)%Z. +Lemma Zabs_8 : forall z p : Z, (- p <= z <= p)%Z -> (Z.abs z <= p)%Z. Proof. intros. apply Zlt_succ_le. @@ -2165,14 +2165,14 @@ Proof. split. apply Zle_lt_succ. assumption. - apply Zlt_le_trans with (m := (- p)%Z). - apply Zgt_lt. + apply Z.lt_le_trans with (m := (- p)%Z). + apply Z.gt_lt. apply Zlt_opp. apply Zlt_succ. assumption. Qed. -Lemma Zabs_min : forall z : Z, Zabs z = Zabs (- z). +Lemma Zabs_min : forall z : Z, Z.abs z = Z.abs (- z). Proof. intro. case z. @@ -2187,67 +2187,67 @@ Proof. Qed. Lemma Zabs_9 : - forall z p : Z, (0 <= p)%Z -> (p < z)%Z \/ (z < - p)%Z -> (p < Zabs z)%Z. + forall z p : Z, (0 <= p)%Z -> (p < z)%Z \/ (z < - p)%Z -> (p < Z.abs z)%Z. Proof. intros. case H0. intro. - replace (Zabs z) with z. + replace (Z.abs z) with z. assumption. symmetry in |- *. - apply Zabs_eq. + apply Z.abs_eq. apply Zlt_le_weak. - apply Zle_lt_trans with (m := p). + apply Z.le_lt_trans with (m := p). assumption. assumption. intro. - cut (Zabs z = (- z)%Z). + cut (Z.abs z = (- z)%Z). intro. rewrite H2. apply Zmin_cancel_Zlt. ring_simplify (- - z)%Z. assumption. rewrite Zabs_min. - apply Zabs_eq. + apply Z.abs_eq. apply Zlt_le_weak. - apply Zle_lt_trans with (m := p). + apply Z.le_lt_trans with (m := p). assumption. apply Zmin_cancel_Zlt. ring_simplify (- - z)%Z. assumption. Qed. -Lemma Zabs_10 : forall z : Z, (0 <= Zabs z)%Z. +Lemma Zabs_10 : forall z : Z, (0 <= Z.abs z)%Z. Proof. intro. case (Z_zerop z). intro. rewrite e. simpl in |- *. - apply Zle_refl. + apply Z.le_refl. intro. case (not_Zeq z 0 n). intro. apply Zlt_le_weak. apply Zabs_9. - apply Zle_refl. + apply Z.le_refl. simpl in |- *. right. assumption. intro. apply Zlt_le_weak. apply Zabs_9. - apply Zle_refl. + apply Z.le_refl. simpl in |- *. left. assumption. Qed. -Lemma Zabs_11 : forall z : Z, z <> 0%Z -> (0 < Zabs z)%Z. +Lemma Zabs_11 : forall z : Z, z <> 0%Z -> (0 < Z.abs z)%Z. Proof. intros. apply Zabs_9. - apply Zle_refl. + apply Z.le_refl. simpl in |- *. apply not_Zeq. intro. @@ -2256,14 +2256,14 @@ Proof. assumption. Qed. -Lemma Zabs_12 : forall z m : Z, (m < Zabs z)%Z -> {(m < z)%Z} + {(z < - m)%Z}. +Lemma Zabs_12 : forall z m : Z, (m < Z.abs z)%Z -> {(m < z)%Z} + {(z < - m)%Z}. Proof. intros [| p| p] m; simpl in |- *; intros H; - [ left | left | right; apply Zmin_cancel_Zlt; rewrite Zopp_involutive ]; + [ left | left | right; apply Zmin_cancel_Zlt; rewrite Z.opp_involutive ]; assumption. Qed. -Lemma Zabs_mult : forall z p : Z, Zabs (z * p) = (Zabs z * Zabs p)%Z. +Lemma Zabs_mult : forall z p : Z, Z.abs (z * p) = (Z.abs z * Z.abs p)%Z. Proof. intros. case z. @@ -2290,22 +2290,22 @@ Proof. reflexivity. Qed. -Lemma Zabs_plus : forall z p : Z, (Zabs (z + p) <= Zabs z + Zabs p)%Z. +Lemma Zabs_plus : forall z p : Z, (Z.abs (z + p) <= Z.abs z + Z.abs p)%Z. Proof. intros. case z. simpl in |- *. - apply Zle_refl. + apply Z.le_refl. case p. intro. simpl in |- *. - apply Zle_refl. + apply Z.le_refl. intros. simpl in |- *. - apply Zle_refl. + apply Z.le_refl. intros. - unfold Zabs at 2 in |- *. - unfold Zabs at 2 in |- *. + unfold Z.abs at 2 in |- *. + unfold Z.abs at 2 in |- *. apply Zabs_8. split. apply Zplus_le_reg_l with (Zpos p1 - Zneg p0)%Z. @@ -2322,17 +2322,17 @@ Proof. ring. ring. apply Zplus_le_compat. - apply Zle_refl. + apply Z.le_refl. apply Zlt_le_weak. constructor. - + case p. simpl in |- *. intro. - apply Zle_refl. + apply Z.le_refl. intros. - unfold Zabs at 2 in |- *. - unfold Zabs at 2 in |- *. + unfold Z.abs at 2 in |- *. + unfold Z.abs at 2 in |- *. apply Zabs_8. split. apply Zplus_le_reg_l with (Zpos p1 + Zneg p0)%Z. @@ -2360,13 +2360,13 @@ Proof. apply Zplus_le_compat. apply Zlt_le_weak. constructor. - apply Zle_refl. + apply Z.le_refl. intros. simpl in |- *. - apply Zle_refl. + apply Z.le_refl. Qed. -Lemma Zabs_neg : forall z : Z, (z <= 0)%Z -> Zabs z = (- z)%Z. +Lemma Zabs_neg : forall z : Z, (z <= 0)%Z -> Z.abs z = (- z)%Z. Proof. intro. case z. @@ -2383,11 +2383,11 @@ Proof. reflexivity. Qed. -Lemma Zle_Zabs: forall z, (z <= Zabs z)%Z. +Lemma Zle_Zabs: forall z, (z <= Z.abs z)%Z. Proof. - intros [|z|z]; simpl; auto with zarith; apply Zle_neg_pos. + intros [|z|z]; simpl; auto with zarith; apply Zle_neg_pos. Qed. - + Hint Resolve Zabs_1 Zabs_2 Zabs_3 Zabs_4 Zabs_5 Zabs_6 Zabs_7 Zabs_8 Zabs_9 Zabs_10 Zabs_11 Zabs_12 Zabs_min Zabs_neg Zabs_mult Zabs_plus Zle_Zabs: zarith. @@ -2400,7 +2400,7 @@ Lemma Zind : forall (P : Z -> Prop) (p : Z), P p -> (forall q : Z, (p <= q)%Z -> P q -> P (q + 1)%Z) -> - forall q : Z, (p <= q)%Z -> P q. + forall q : Z, (p <= q)%Z -> P q. Proof. intros P p. intro. @@ -2426,14 +2426,14 @@ Proof. replace (p + Z_of_nat (S k))%Z with (p + k + 1)%Z. apply H0. apply Zplus_le_reg_l with (p := (- p)%Z). - replace (- p + p)%Z with (Z_of_nat 0). + replace (- p + p)%Z with (Z_of_nat 0). ring_simplify (- p + (p + Z_of_nat k))%Z. apply Znat.inj_le. apply le_O_n. - ring_simplify; auto with arith. + ring_simplify; auto with arith. assumption. rewrite (Znat.inj_S k). - unfold Zsucc in |- *. + unfold Z.succ in |- *. ring. intros. cut (exists k : nat, (q - p)%Z = Z_of_nat k). @@ -2457,7 +2457,7 @@ Lemma Zrec : forall (P : Z -> Set) (p : Z), P p -> (forall q : Z, (p <= q)%Z -> P q -> P (q + 1)%Z) -> - forall q : Z, (p <= q)%Z -> P q. + forall q : Z, (p <= q)%Z -> P q. Proof. intros F p. intro. @@ -2483,7 +2483,7 @@ Proof. replace (p + Z_of_nat (S k))%Z with (p + k + 1)%Z. apply H0. apply Zplus_le_reg_l with (p := (- p)%Z). - replace (- p + p)%Z with (Z_of_nat 0). + replace (- p + p)%Z with (Z_of_nat 0). replace (- p + (p + Z_of_nat k))%Z with (Z_of_nat k). apply Znat.inj_le. apply le_O_n. @@ -2491,7 +2491,7 @@ Proof. rewrite Zplus_opp_l; reflexivity. assumption. rewrite (Znat.inj_S k). - unfold Zsucc in |- *. + unfold Z.succ in |- *. apply Zplus_assoc_reverse. intros. cut {k : nat | (q - p)%Z = Z_of_nat k}. @@ -2540,14 +2540,14 @@ Proof. replace (p - 0)%Z with p. assumption. unfold Zminus in |- *. - unfold Zopp in |- *. + unfold Z.opp in |- *. rewrite Zplus_0_r; reflexivity. replace (p - Z_of_nat (S k))%Z with (p - k - 1)%Z. apply H0. apply Zplus_le_reg_l with (p := (- p)%Z). - replace (- p + p)%Z with (- Z_of_nat 0)%Z. + replace (- p + p)%Z with (- Z_of_nat 0)%Z. replace (- p + (p - Z_of_nat k))%Z with (- Z_of_nat k)%Z. - apply Zge_le. + apply Z.ge_le. apply Zge_opp. apply Znat.inj_le. apply le_O_n. @@ -2555,7 +2555,7 @@ Proof. rewrite Zplus_opp_l; reflexivity. assumption. rewrite (Znat.inj_S k). - unfold Zsucc in |- *. + unfold Z.succ in |- *. unfold Zminus at 1 2 in |- *. rewrite Zplus_assoc_reverse. rewrite <- Zopp_plus_distr. @@ -2567,16 +2567,16 @@ Proof. intro k. intros. exists k. - apply Zopp_inj. + apply Z.opp_inj. apply Zplus_reg_l with (n := p). - replace (p + - (p - Z_of_nat k))%Z with (Z_of_nat k). + replace (p + - (p - Z_of_nat k))%Z with (Z_of_nat k). rewrite <- e. reflexivity. unfold Zminus in |- *. rewrite Zopp_plus_distr. rewrite Zplus_assoc. rewrite Zplus_opp_r. - rewrite Zopp_involutive. + rewrite Z.opp_involutive. reflexivity. apply Z_of_nat_complete_inf. unfold Zminus in |- *. @@ -2615,17 +2615,17 @@ Proof. replace (p - Z_of_nat (S k))%Z with (p - k - 1)%Z. apply H0. apply Zplus_le_reg_l with (p := (- p)%Z). - replace (- p + p)%Z with (- Z_of_nat 0)%Z. + replace (- p + p)%Z with (- Z_of_nat 0)%Z. replace (- p + (p - Z_of_nat k))%Z with (- Z_of_nat k)%Z. - apply Zge_le. + apply Z.ge_le. apply Zge_opp. apply Znat.inj_le. apply le_O_n. - ring. + ring. ring_simplify; auto with arith. assumption. rewrite (Znat.inj_S k). - unfold Zsucc in |- *. + unfold Z.succ in |- *. ring. intros. cut (exists k : nat, (p - q)%Z = Z_of_nat k). @@ -2634,9 +2634,9 @@ Proof. intro k. intros. exists k. - apply Zopp_inj. + apply Z.opp_inj. apply Zplus_reg_l with (n := p). - replace (p + - (p - Z_of_nat k))%Z with (Z_of_nat k). + replace (p + - (p - Z_of_nat k))%Z with (Z_of_nat k). rewrite <- H3. ring. ring. @@ -2654,44 +2654,44 @@ Proof. intros P p WF_ind_step q Hq. cut (forall x : Z, (p <= x)%Z -> forall y : Z, (p <= y < x)%Z -> P y). intro. - apply (H (Zsucc q)). + apply (H (Z.succ q)). apply Zle_le_succ. assumption. - + split; [ assumption | exact (Zlt_succ q) ]. - intros x0 Hx0; generalize Hx0; pattern x0 in |- *. + intros x0 Hx0; generalize Hx0; pattern x0 in |- *. apply Zrec with (p := p). intros. absurd (p <= p)%Z. apply Zgt_not_le. apply Zgt_le_trans with (m := y). - apply Zlt_gt. + apply Z.lt_gt. elim H. intros. assumption. elim H. intros. assumption. - apply Zle_refl. + apply Z.le_refl. - intros. - apply WF_ind_step. + intros. + apply WF_ind_step. intros. apply (H0 H). - split. + split. elim H2. intros. assumption. - apply Zlt_le_trans with y. + apply Z.lt_le_trans with y. elim H2. intros. assumption. - apply Zgt_succ_le. - apply Zlt_gt. + apply Zgt_succ_le. + apply Z.lt_gt. elim H1. intros. - unfold Zsucc in |- *. + unfold Z.succ in |- *. assumption. assumption. Qed. @@ -2744,44 +2744,44 @@ Proof. intros P p WF_ind_step q Hq. cut (forall x : Z, (p <= x)%Z -> forall y : Z, (p <= y < x)%Z -> P y). intro. - apply (H (Zsucc q)). + apply (H (Z.succ q)). apply Zle_le_succ. assumption. - + split; [ assumption | exact (Zlt_succ q) ]. - intros x0 Hx0; generalize Hx0; pattern x0 in |- *. + intros x0 Hx0; generalize Hx0; pattern x0 in |- *. apply Zind with (p := p). intros. absurd (p <= p)%Z. apply Zgt_not_le. apply Zgt_le_trans with (m := y). - apply Zlt_gt. + apply Z.lt_gt. elim H. intros. assumption. elim H. intros. assumption. - apply Zle_refl. + apply Z.le_refl. - intros. - apply WF_ind_step. + intros. + apply WF_ind_step. intros. apply (H0 H). - split. + split. elim H2. intros. assumption. - apply Zlt_le_trans with y. + apply Z.lt_le_trans with y. elim H2. intros. assumption. - apply Zgt_succ_le. - apply Zlt_gt. + apply Zgt_succ_le. + apply Z.lt_gt. elim H1. intros. - unfold Zsucc in |- *. + unfold Z.succ in |- *. assumption. assumption. Qed. @@ -2830,16 +2830,16 @@ Qed. (** Properties of Zmax *) (*###########################################################################*) -Definition Zmax (n m : Z) := (n + m - Zmin n m)%Z. +Definition Zmax (n m : Z) := (n + m - Z.min n m)%Z. Lemma ZmaxSS : forall n m : Z, (Zmax n m + 1)%Z = Zmax (n + 1) (m + 1). Proof. intros. unfold Zmax in |- *. - replace (Zmin (n + 1) (m + 1)) with (Zmin n m + 1)%Z. + replace (Z.min (n + 1) (m + 1)) with (Z.min n m + 1)%Z. ring. symmetry in |- *. - change (Zmin (Zsucc n) (Zsucc m) = Zsucc (Zmin n m)) in |- *. + change (Z.min (Z.succ n) (Z.succ m) = Z.succ (Z.min n m)) in |- *. symmetry in |- *. apply Zmin_SS. Qed. @@ -2848,29 +2848,29 @@ Lemma Zle_max_l : forall n m : Z, (n <= Zmax n m)%Z. Proof. intros. unfold Zmax in |- *. - apply Zplus_le_reg_l with (p := (- n + Zmin n m)%Z). - ring_simplify (- n + Zmin n m + n)%Z. - ring_simplify (- n + Zmin n m + (n + m - Zmin n m))%Z. - apply Zle_min_r. + apply Zplus_le_reg_l with (p := (- n + Z.min n m)%Z). + ring_simplify (- n + Z.min n m + n)%Z. + ring_simplify (- n + Z.min n m + (n + m - Z.min n m))%Z. + apply Z.le_min_r. Qed. Lemma Zle_max_r : forall n m : Z, (m <= Zmax n m)%Z. Proof. intros. unfold Zmax in |- *. - apply Zplus_le_reg_l with (p := (- m + Zmin n m)%Z). - ring_simplify (- m + Zmin n m + m)%Z. - ring_simplify (- m + Zmin n m + (n + m - Zmin n m))%Z. - apply Zle_min_l. + apply Zplus_le_reg_l with (p := (- m + Z.min n m)%Z). + ring_simplify (- m + Z.min n m + m)%Z. + ring_simplify (- m + Z.min n m + (n + m - Z.min n m))%Z. + apply Z.le_min_l. Qed. -Lemma Zmin_or_informative : forall n m : Z, {Zmin n m = n} + {Zmin n m = m}. +Lemma Zmin_or_informative : forall n m : Z, {Z.min n m = n} + {Z.min n m = m}. Proof. intros. case (Z_lt_ge_dec n m). - unfold Zmin in |- *. - unfold Zlt in |- *. + unfold Z.min in |- *. + unfold Z.lt in |- *. intro z. rewrite z. left. @@ -2880,8 +2880,8 @@ Proof. intro. case H. intros z0. - unfold Zmin in |- *. - unfold Zgt in z0. + unfold Z.min in |- *. + unfold Z.gt in z0. rewrite z0. right. reflexivity. @@ -2894,14 +2894,14 @@ Proof. elim H. intro. left. - apply Zlt_gt. + apply Z.lt_gt. assumption. intro. right. symmetry in |- *. assumption. - apply Z_le_lt_eq_dec. - apply Zge_le. + apply Z_le_lt_eq_dec. + apply Z.ge_le. assumption. Qed. @@ -2925,8 +2925,8 @@ Proof. assumption. ring. Qed. - -Lemma Zmax_or_informative : forall n m : Z, {Zmax n m = n} + {Zmax n m = m}. + +Lemma Zmax_or_informative : forall n m : Z, {Zmax n m = n} + {Zmax n m = m}. Proof. intros. unfold Zmax in |- *. @@ -2960,12 +2960,12 @@ Proof. exact Zeven.Zeven_Sn. Qed. -Lemma Zeven_pred : forall x : Z, Zeven.Zodd x -> Zeven.Zeven (x - 1). +Lemma Zeven_pred : forall x : Z, Zeven.Zodd x -> Zeven.Zeven (x - 1). Proof. exact Zeven.Zeven_pred. Qed. -(* This lemma used to be useful since it was mentioned with an unnecessary premise +(* This lemma used to be useful since it was mentioned with an unnecessary premise `x>=0` as Z_modulo_2 in ZArith, but the ZArith version has been fixed. *) Definition Z_modulo_2_always : @@ -2987,10 +2987,10 @@ Proof. Qed. Lemma Z_div_le : - forall a b c : Z, (0 < c)%Z -> (b <= a)%Z -> (b / c <= a / c)%Z. + forall a b c : Z, (0 < c)%Z -> (b <= a)%Z -> (b / c <= a / c)%Z. Proof. intros. - apply Zge_le. + apply Z.ge_le. apply Z_div_ge; Flip; assumption. Qed. @@ -2998,7 +2998,7 @@ Lemma Z_div_nonneg : forall a b : Z, (0 < b)%Z -> (0 <= a)%Z -> (0 <= a / b)%Z. Proof. intros. - apply Zge_le. + apply Z.ge_le. apply Z_div_ge0; Flip; assumption. Qed. @@ -3012,7 +3012,7 @@ Proof. intro. apply (Zlt_not_le (b * (a / b) + a mod b) 0 H0). apply Zplus_le_0_compat. - apply Zmult_le_0_compat. + apply Zmult_le_0_compat. apply Zlt_le_weak; assumption. Flip. assumption. diff --git a/test-suite/success/AdvancedTypeClasses.v b/test-suite/success/AdvancedTypeClasses.v index b4efa7ed..d0aa5c85 100644 --- a/test-suite/success/AdvancedTypeClasses.v +++ b/test-suite/success/AdvancedTypeClasses.v @@ -28,8 +28,8 @@ Class interp_pair (abs : Type) := { repr : term; link: abs = interp repr }. -Implicit Arguments repr [[interp_pair]]. -Implicit Arguments link [[interp_pair]]. +Arguments repr _ {interp_pair}. +Arguments link _ {interp_pair}. Lemma prod_interp `{interp_pair a, interp_pair b} : a * b = interp (Prod (repr a) (repr b)). simpl. intros. rewrite <- link. rewrite <- (link b). reflexivity. diff --git a/test-suite/success/BracketsWithGoalSelector.v b/test-suite/success/BracketsWithGoalSelector.v index ed035f52..2f7425bc 100644 --- a/test-suite/success/BracketsWithGoalSelector.v +++ b/test-suite/success/BracketsWithGoalSelector.v @@ -14,3 +14,12 @@ Proof. Fail Qed. } Qed. + +Lemma foo (n: nat) (P : nat -> Prop): + P n. +Proof. + intros. + refine (nat_ind _ ?[Base] ?[Step] _). + [Base]: { admit. } + [Step]: { admit. } +Abort. diff --git a/test-suite/success/Case11.v b/test-suite/success/Case11.v index 445ffac8..fbe909ec 100644 --- a/test-suite/success/Case11.v +++ b/test-suite/success/Case11.v @@ -5,9 +5,9 @@ Section A. Variables (Alpha : Set) (Beta : Set). -Definition nodep_prod_of_dep (c : sigS (fun a : Alpha => Beta)) : +Definition nodep_prod_of_dep (c : sigT (fun a : Alpha => Beta)) : Alpha * Beta := match c with - | existS _ a b => (a, b) + | existT _ a b => (a, b) end. End A. diff --git a/test-suite/success/Case17.v b/test-suite/success/Case17.v index 861d0466..a4efcca9 100644 --- a/test-suite/success/Case17.v +++ b/test-suite/success/Case17.v @@ -1,5 +1,5 @@ (* Check the synthesis of predicate from a cast in case of matching of - the first component (here [list bool]) of a dependent type (here [sigS]) + the first component (here [list bool]) of a dependent type (here [sigT]) (Simplification of an example from file parsing2.v of the Coq'Art exercises) *) @@ -19,10 +19,10 @@ Axiom HHH : forall A : Prop, A. Check (match rec l0 (HHH _) with - | inleft (existS _ (false :: l1) _) => inright _ (HHH _) - | inleft (existS _ (true :: l1) (exist _ t1 (conj Hp Hl))) => + | inleft (existT _ (false :: l1) _) => inright _ (HHH _) + | inleft (existT _ (true :: l1) (exist _ t1 (conj Hp Hl))) => inright _ (HHH _) - | inleft (existS _ _ _) => inright _ (HHH _) + | inleft (existT _ _ _) => inright _ (HHH _) | inright Hnp => inright _ (HHH _) end :{l'' : list bool & @@ -39,10 +39,10 @@ Check {t : nat | parse_rel l' l'' t /\ length l'' <= length l'}} + {(forall (l'' : list bool) (t : nat), ~ parse_rel l' l'' t)}) => match rec l0 (HHH _) with - | inleft (existS _ (false :: l1) _) => inright _ (HHH _) - | inleft (existS _ (true :: l1) (exist _ t1 (conj Hp Hl))) => + | inleft (existT _ (false :: l1) _) => inright _ (HHH _) + | inleft (existT _ (true :: l1) (exist _ t1 (conj Hp Hl))) => inright _ (HHH _) - | inleft (existS _ _ _) => inright _ (HHH _) + | inleft (existT _ _ _) => inright _ (HHH _) | inright Hnp => inright _ (HHH _) end :{l'' : list bool & diff --git a/test-suite/success/Compat88.v b/test-suite/success/Compat88.v new file mode 100644 index 00000000..e2045900 --- /dev/null +++ b/test-suite/success/Compat88.v @@ -0,0 +1,18 @@ +(* -*- coq-prog-args: ("-compat" "8.8") -*- *) +(** Check that various syntax usage is available without importing + relevant files. *) +Require Coq.Strings.Ascii Coq.Strings.String. +Require Coq.ZArith.BinIntDef Coq.PArith.BinPosDef Coq.NArith.BinNatDef. +Require Coq.Reals.Rdefinitions. +Require Coq.Numbers.Cyclic.Int31.Cyclic31. + +Require Import Coq.Compat.Coq88. (* XXX FIXME Should not need [Require], see https://github.com/coq/coq/issues/8311 *) + +Check String.String "a" String.EmptyString. +Check String.eqb "a" "a". +Check Nat.eqb 1 1. +Check BinNat.N.eqb 1 1. +Check BinInt.Z.eqb 1 1. +Check BinPos.Pos.eqb 1 1. +Check Rdefinitions.Rplus 1 1. +Check Int31.iszero 1. diff --git a/test-suite/success/CompatCurrentFlag.v b/test-suite/success/CompatCurrentFlag.v index 288c9d1d..5650dba2 100644 --- a/test-suite/success/CompatCurrentFlag.v +++ b/test-suite/success/CompatCurrentFlag.v @@ -1,3 +1,3 @@ -(* -*- coq-prog-args: ("-compat" "8.8") -*- *) +(* -*- coq-prog-args: ("-compat" "8.9") -*- *) (** Check that the current compatibility flag actually requires the relevant modules. *) -Import Coq.Compat.Coq88. +Import Coq.Compat.Coq89. diff --git a/test-suite/success/CompatOldFlag.v b/test-suite/success/CompatOldFlag.v index b7bbc505..37d50ee6 100644 --- a/test-suite/success/CompatOldFlag.v +++ b/test-suite/success/CompatOldFlag.v @@ -1,5 +1,5 @@ -(* -*- coq-prog-args: ("-compat" "8.6") -*- *) +(* -*- coq-prog-args: ("-compat" "8.7") -*- *) (** Check that the current-minus-two compatibility flag actually requires the relevant modules. *) +Import Coq.Compat.Coq89. Import Coq.Compat.Coq88. Import Coq.Compat.Coq87. -Import Coq.Compat.Coq86. diff --git a/test-suite/success/CompatPreviousFlag.v b/test-suite/success/CompatPreviousFlag.v index 9cfe6039..99813883 100644 --- a/test-suite/success/CompatPreviousFlag.v +++ b/test-suite/success/CompatPreviousFlag.v @@ -1,4 +1,4 @@ -(* -*- coq-prog-args: ("-compat" "8.7") -*- *) +(* -*- coq-prog-args: ("-compat" "8.8") -*- *) (** Check that the current-minus-one compatibility flag actually requires the relevant modules. *) +Import Coq.Compat.Coq89. Import Coq.Compat.Coq88. -Import Coq.Compat.Coq87. diff --git a/test-suite/success/FunindExtraction_compat86.v b/test-suite/success/FunindExtraction_compat86.v deleted file mode 100644 index 8912197d..00000000 --- a/test-suite/success/FunindExtraction_compat86.v +++ /dev/null @@ -1,506 +0,0 @@ -(* -*- coq-prog-args: ("-compat" "8.6") -*- *) - -Definition iszero (n : nat) : bool := - match n with - | O => true - | _ => false - end. - -Functional Scheme iszero_ind := Induction for iszero Sort Prop. - -Lemma toto : forall n : nat, n = 0 -> iszero n = true. -intros x eg. - functional induction iszero x; simpl. -trivial. -inversion eg. -Qed. - - -Function ftest (n m : nat) : nat := - match n with - | O => match m with - | O => 0 - | _ => 1 - end - | S p => 0 - end. -(* MS: FIXME: apparently can't define R_ftest_complete. Rest of the file goes through. *) - -Lemma test1 : forall n m : nat, ftest n m <= 2. -intros n m. - functional induction ftest n m; auto. -Qed. - -Lemma test2 : forall m n, ~ 2 = ftest n m. -Proof. -intros n m;intro H. -functional inversion H ftest. -Qed. - -Lemma test3 : forall n m, ftest n m = 0 -> (n = 0 /\ m = 0) \/ n <> 0. -Proof. -functional inversion 1 ftest;auto. -Qed. - - -Require Import Arith. -Lemma test11 : forall m : nat, ftest 0 m <= 2. -intros m. - functional induction ftest 0 m. -auto. -auto. -auto with *. -Qed. - -Function lamfix (m n : nat) {struct n } : nat := - match n with - | O => m - | S p => lamfix m p - end. - -(* Parameter v1 v2 : nat. *) - -Lemma lamfix_lem : forall v1 v2 : nat, lamfix v1 v2 = v1. -intros v1 v2. - functional induction lamfix v1 v2. -trivial. -assumption. -Defined. - - - -(* polymorphic function *) -Require Import List. - -Functional Scheme app_ind := Induction for app Sort Prop. - -Lemma appnil : forall (A : Set) (l l' : list A), l' = nil -> l = l ++ l'. -intros A l l'. - functional induction app A l l'; intuition. - rewrite <- H0; trivial. -Qed. - - - - - -Require Export Arith. - - -Function trivfun (n : nat) : nat := - match n with - | O => 0 - | S m => trivfun m - end. - - -(* essaie de parametre variables non locaux:*) - -Parameter varessai : nat. - -Lemma first_try : trivfun varessai = 0. - functional induction trivfun varessai. -trivial. -assumption. -Defined. - - - Functional Scheme triv_ind := Induction for trivfun Sort Prop. - -Lemma bisrepetita : forall n' : nat, trivfun n' = 0. -intros n'. - functional induction trivfun n'. -trivial. -assumption. -Qed. - - - - - - - -Function iseven (n : nat) : bool := - match n with - | O => true - | S (S m) => iseven m - | _ => false - end. - - -Function funex (n : nat) : nat := - match iseven n with - | true => n - | false => match n with - | O => 0 - | S r => funex r - end - end. - - -Function nat_equal_bool (n m : nat) {struct n} : bool := - match n with - | O => match m with - | O => true - | _ => false - end - | S p => match m with - | O => false - | S q => nat_equal_bool p q - end - end. - - -Require Export Div2. -Require Import Nat. -Functional Scheme div2_ind := Induction for div2 Sort Prop. -Lemma div2_inf : forall n : nat, div2 n <= n. -intros n. - functional induction div2 n. -auto. -auto. - -apply le_S. -apply le_n_S. -exact IHn0. -Qed. - -(* reuse this lemma as a scheme:*) - -Function nested_lam (n : nat) : nat -> nat := - match n with - | O => fun m : nat => 0 - | S n' => fun m : nat => m + nested_lam n' m - end. - - -Lemma nest : forall n m : nat, nested_lam n m = n * m. -intros n m. - functional induction nested_lam n m; simpl;auto. -Qed. - - -Function essai (x : nat) (p : nat * nat) {struct x} : nat := - let (n, m) := (p: nat*nat) in - match n with - | O => 0 - | S q => match x with - | O => 1 - | S r => S (essai r (q, m)) - end - end. - -Lemma essai_essai : - forall (x : nat) (p : nat * nat), let (n, m) := p in 0 < n -> 0 < essai x p. -intros x p. - functional induction essai x p; intros. -inversion H. -auto with arith. - auto with arith. -Qed. - -Function plus_x_not_five'' (n m : nat) {struct n} : nat := - let x := nat_equal_bool m 5 in - let y := 0 in - match n with - | O => y - | S q => - let recapp := plus_x_not_five'' q m in - match x with - | true => S recapp - | false => S recapp - end - end. - -Lemma notplusfive'' : forall x y : nat, y = 5 -> plus_x_not_five'' x y = x. -intros a b. - functional induction plus_x_not_five'' a b; intros hyp; simpl; auto. -Qed. - -Lemma iseq_eq : forall n m : nat, n = m -> nat_equal_bool n m = true. -intros n m. - functional induction nat_equal_bool n m; simpl; intros hyp; auto. -rewrite <- hyp in y; simpl in y;tauto. -inversion hyp. -Qed. - -Lemma iseq_eq' : forall n m : nat, nat_equal_bool n m = true -> n = m. -intros n m. - functional induction nat_equal_bool n m; simpl; intros eg; auto. -inversion eg. -inversion eg. -Qed. - - -Inductive istrue : bool -> Prop := - istrue0 : istrue true. - -Functional Scheme add_ind := Induction for add Sort Prop. - -Lemma inf_x_plusxy' : forall x y : nat, x <= x + y. -intros n m. - functional induction add n m; intros. -auto with arith. -auto with arith. -Qed. - - -Lemma inf_x_plusxy'' : forall x : nat, x <= x + 0. -intros n. -unfold plus. - functional induction plus n 0; intros. -auto with arith. -apply le_n_S. -assumption. -Qed. - -Lemma inf_x_plusxy''' : forall x : nat, x <= 0 + x. -intros n. - functional induction plus 0 n; intros; auto with arith. -Qed. - -Function mod2 (n : nat) : nat := - match n with - | O => 0 - | S (S m) => S (mod2 m) - | _ => 0 - end. - -Lemma princ_mod2 : forall n : nat, mod2 n <= n. -intros n. - functional induction mod2 n; simpl; auto with arith. -Qed. - -Function isfour (n : nat) : bool := - match n with - | S (S (S (S O))) => true - | _ => false - end. - -Function isononeorfour (n : nat) : bool := - match n with - | S O => true - | S (S (S (S O))) => true - | _ => false - end. - -Lemma toto'' : forall n : nat, istrue (isfour n) -> istrue (isononeorfour n). -intros n. - functional induction isononeorfour n; intros istr; simpl; - inversion istr. -apply istrue0. -destruct n. inversion istr. -destruct n. tauto. -destruct n. inversion istr. -destruct n. inversion istr. -destruct n. tauto. -simpl in *. inversion H0. -Qed. - -Lemma toto' : forall n m : nat, n = 4 -> istrue (isononeorfour n). -intros n. - functional induction isononeorfour n; intros m istr; inversion istr. -apply istrue0. -rewrite H in y; simpl in y;tauto. -Qed. - -Function ftest4 (n m : nat) : nat := - match n with - | O => match m with - | O => 0 - | S q => 1 - end - | S p => match m with - | O => 0 - | S r => 1 - end - end. - -Lemma test4 : forall n m : nat, ftest n m <= 2. -intros n m. - functional induction ftest n m; auto with arith. -Qed. - -Lemma test4' : forall n m : nat, ftest4 (S n) m <= 2. -intros n m. -assert ({n0 | n0 = S n}). -exists (S n);reflexivity. -destruct H as [n0 H1]. -rewrite <- H1;revert H1. - functional induction ftest4 n0 m. -inversion 1. -inversion 1. - -auto with arith. -auto with arith. -Qed. - -Function ftest44 (x : nat * nat) (n m : nat) : nat := - let (p, q) := (x: nat*nat) in - match n with - | O => match m with - | O => 0 - | S q => 1 - end - | S p => match m with - | O => 0 - | S r => 1 - end - end. - -Lemma test44 : - forall (pq : nat * nat) (n m o r s : nat), ftest44 pq n (S m) <= 2. -intros pq n m o r s. - functional induction ftest44 pq n (S m). -auto with arith. -auto with arith. -auto with arith. -auto with arith. -Qed. - -Function ftest2 (n m : nat) {struct n} : nat := - match n with - | O => match m with - | O => 0 - | S q => 0 - end - | S p => ftest2 p m - end. - -Lemma test2' : forall n m : nat, ftest2 n m <= 2. -intros n m. - functional induction ftest2 n m; simpl; intros; auto. -Qed. - -Function ftest3 (n m : nat) {struct n} : nat := - match n with - | O => 0 - | S p => match m with - | O => ftest3 p 0 - | S r => 0 - end - end. - -Lemma test3' : forall n m : nat, ftest3 n m <= 2. -intros n m. - functional induction ftest3 n m. -intros. -auto. -intros. -auto. -intros. -simpl. -auto. -Qed. - -Function ftest5 (n m : nat) {struct n} : nat := - match n with - | O => 0 - | S p => match m with - | O => ftest5 p 0 - | S r => ftest5 p r - end - end. - -Lemma test5 : forall n m : nat, ftest5 n m <= 2. -intros n m. - functional induction ftest5 n m. -intros. -auto. -intros. -auto. -intros. -simpl. -auto. -Qed. - -Function ftest7 (n : nat) : nat := - match ftest5 n 0 with - | O => 0 - | S r => 0 - end. - -Lemma essai7 : - forall (Hrec : forall n : nat, ftest5 n 0 = 0 -> ftest7 n <= 2) - (Hrec0 : forall n r : nat, ftest5 n 0 = S r -> ftest7 n <= 2) - (n : nat), ftest7 n <= 2. -intros hyp1 hyp2 n. - functional induction ftest7 n; auto. -Qed. - -Function ftest6 (n m : nat) {struct n} : nat := - match n with - | O => 0 - | S p => match ftest5 p 0 with - | O => ftest6 p 0 - | S r => ftest6 p r - end - end. - - -Lemma princ6 : - (forall n m : nat, n = 0 -> ftest6 0 m <= 2) -> - (forall n m p : nat, - ftest6 p 0 <= 2 -> ftest5 p 0 = 0 -> n = S p -> ftest6 (S p) m <= 2) -> - (forall n m p r : nat, - ftest6 p r <= 2 -> ftest5 p 0 = S r -> n = S p -> ftest6 (S p) m <= 2) -> - forall x y : nat, ftest6 x y <= 2. -intros hyp1 hyp2 hyp3 n m. -generalize hyp1 hyp2 hyp3. -clear hyp1 hyp2 hyp3. - functional induction ftest6 n m; auto. -Qed. - -Lemma essai6 : forall n m : nat, ftest6 n m <= 2. -intros n m. - functional induction ftest6 n m; simpl; auto. -Qed. - -(* Some tests with modules *) -Module M. -Function test_m (n:nat) : nat := - match n with - | 0 => 0 - | S n => S (S (test_m n)) - end. - -Lemma test_m_is_double : forall n, div2 (test_m n) = n. -Proof. -intros n. -functional induction (test_m n). -reflexivity. -simpl;rewrite IHn0;reflexivity. -Qed. -End M. -(* We redefine a new Function with the same name *) -Function test_m (n:nat) : nat := - pred n. - -Lemma test_m_is_pred : forall n, test_m n = pred n. -Proof. -intro n. -functional induction (test_m n). (* the test_m_ind to use is the last defined saying that test_m = pred*) -reflexivity. -Qed. - -(* Checks if the dot notation are correctly treated in infos *) -Lemma M_test_m_is_double : forall n, div2 (M.test_m n) = n. -intro n. -(* here we should apply M.test_m_ind *) -functional induction (M.test_m n). -reflexivity. -simpl;rewrite IHn0;reflexivity. -Qed. - -Import M. -(* Now test_m is the one which defines double *) - -Lemma test_m_is_double : forall n, div2 (M.test_m n) = n. -intro n. -(* here we should apply M.test_m_ind *) -functional induction (test_m n). -reflexivity. -simpl;rewrite IHn0;reflexivity. -Qed. - -Extraction iszero. diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v index 8d08f597..2f13b7c2 100644 --- a/test-suite/success/Hints.v +++ b/test-suite/success/Hints.v @@ -183,3 +183,33 @@ End HintCut. Goal forall (m : nat), exists n, m = n /\ m = n. intros m; eexists; split; [trivial | reflexivity]. Qed. + +Section HintTransparent. + + Definition fn (x : nat) := S x. + + Create HintDb trans. + + Hint Resolve eq_refl | (_ = _) : trans. + + (* No reduction *) + Hint Variables Opaque : trans. Hint Constants Opaque : trans. + + Goal forall x : nat, fn x = S x. + Proof. + intros. + Fail typeclasses eauto with trans. + unfold fn. + typeclasses eauto with trans. + Qed. + + (** Now allow unfolding fn *) + Hint Constants Transparent : trans. + + Goal forall x : nat, fn x = S x. + Proof. + intros. + typeclasses eauto with trans. + Qed. + +End HintTransparent. diff --git a/test-suite/success/ImplicitArguments.v b/test-suite/success/ImplicitArguments.v index 921433ca..9a19b595 100644 --- a/test-suite/success/ImplicitArguments.v +++ b/test-suite/success/ImplicitArguments.v @@ -2,7 +2,7 @@ Inductive vector {A : Type} : nat -> Type := | vnil : vector 0 | vcons : A -> forall {n'}, vector n' -> vector (S n'). -Implicit Arguments vector []. +Arguments vector A : clear implicits. Require Import Coq.Program.Program. diff --git a/test-suite/success/ImplicitTactic.v b/test-suite/success/ImplicitTactic.v deleted file mode 100644 index d8fa3043..00000000 --- a/test-suite/success/ImplicitTactic.v +++ /dev/null @@ -1,16 +0,0 @@ -(* A Wiedijk-Cruz-Filipe style tactic for solving implicit arguments *) - -(* Declare a term expression with a hole *) -Parameter quo : nat -> forall n:nat, n<>0 -> nat. -Notation "x / y" := (quo x y _) : nat_scope. - -(* Declare the tactic for resolving implicit arguments still - unresolved after type-checking; it must complete the subgoal to - succeed *) -Declare Implicit Tactic assumption. - -Goal forall n d, d<>0 -> { q:nat & { r:nat | d * q + r = n }}. -intros. -(* Here, assumption is used to solve the implicit argument of quo *) -exists (n / d). - diff --git a/test-suite/success/Inductive.v b/test-suite/success/Inductive.v index 5b1482fd..c2130995 100644 --- a/test-suite/success/Inductive.v +++ b/test-suite/success/Inductive.v @@ -1,7 +1,5 @@ (* Test des definitions inductives imbriquees *) -Require Import List. - Inductive X : Set := cons1 : list X -> X. @@ -73,7 +71,7 @@ CoInductive LList (A : Set) : Set := | LNil : LList A | LCons : A -> LList A -> LList A. -Implicit Arguments LNil [A]. +Arguments LNil [A]. Inductive Finite (A : Set) : LList A -> Prop := | Finite_LNil : Finite LNil diff --git a/test-suite/success/Injection.v b/test-suite/success/Injection.v index 78652fb6..7ee471ba 100644 --- a/test-suite/success/Injection.v +++ b/test-suite/success/Injection.v @@ -19,8 +19,8 @@ Qed. (* Check that no tuple needs to be built *) Lemma l3 : forall x y : nat, - existS (fun n : nat => {n = n} + {n = n}) x (left _ (refl_equal x)) = - existS (fun n : nat => {n = n} + {n = n}) y (left _ (refl_equal y)) -> + existT (fun n : nat => {n = n} + {n = n}) x (left _ (refl_equal x)) = + existT (fun n : nat => {n = n} + {n = n}) y (left _ (refl_equal y)) -> x = y. intros x y H. injection H. @@ -30,10 +30,10 @@ Qed. (* Check that a tuple is built (actually the same as the initial one) *) Lemma l4 : forall p1 p2 : {0 = 0} + {0 = 0}, - existS (fun n : nat => {n = n} + {n = n}) 0 p1 = - existS (fun n : nat => {n = n} + {n = n}) 0 p2 -> - existS (fun n : nat => {n = n} + {n = n}) 0 p1 = - existS (fun n : nat => {n = n} + {n = n}) 0 p2. + existT (fun n : nat => {n = n} + {n = n}) 0 p1 = + existT (fun n : nat => {n = n} + {n = n}) 0 p2 -> + existT (fun n : nat => {n = n} + {n = n}) 0 p1 = + existT (fun n : nat => {n = n} + {n = n}) 0 p2. intros. injection H. exact (fun H => H). diff --git a/test-suite/success/Inversion.v b/test-suite/success/Inversion.v index 45c71615..ee540d71 100644 --- a/test-suite/success/Inversion.v +++ b/test-suite/success/Inversion.v @@ -31,7 +31,7 @@ Inductive in_extension (I : Set) (r : rule I) : extension I -> Type := | in_first : forall e, in_extension r (add_rule r e) | in_rest : forall e r', in_extension r e -> in_extension r (add_rule r' e). -Implicit Arguments NL [I]. +Arguments NL [I]. Inductive super_extension (I : Set) (e : extension I) : extension I -> Type := @@ -107,6 +107,7 @@ Goal forall o, foo2 o -> 0 = 1. intros. eapply trans_eq. inversion H. +Abort. (* Check that the part of "injection" that is called by "inversion" does the same number of intros as the number of equations @@ -136,6 +137,7 @@ Goal True -> True. intro. Fail inversion H using False. Fail inversion foo using True_ind. +Abort. (* Was failing at some time between 7 and 10 September 2014 *) (* even though, it is not clear that the resulting context is interesting *) diff --git a/test-suite/success/Fourier.v b/test-suite/success/LraTest.v index b63bead4..bf3a87da 100644 --- a/test-suite/success/Fourier.v +++ b/test-suite/success/LraTest.v @@ -1,12 +1,14 @@ -Require Import Rfunctions. -Require Import Fourier. +Require Import Reals. +Require Import Lra. + +Open Scope R_scope. Lemma l1 : forall x y z : R, Rabs (x - z) <= Rabs (x - y) + Rabs (y - z). -intros; split_Rabs; fourier. +intros; split_Rabs; lra. Qed. Lemma l2 : forall x y : R, x < Rabs y -> y < 1 -> x >= 0 -> - y <= 1 -> Rabs x <= 1. intros. -split_Rabs; fourier. +split_Rabs; lra. Qed. diff --git a/test-suite/success/LtacDeprecation.v b/test-suite/success/LtacDeprecation.v new file mode 100644 index 00000000..633a5e47 --- /dev/null +++ b/test-suite/success/LtacDeprecation.v @@ -0,0 +1,32 @@ +Set Warnings "+deprecated". + +#[deprecated(since = "8.8", note = "Use idtac instead")] +Ltac foo x := idtac. + +Goal True. +Fail (foo true). +Abort. + +Fail Ltac bar := foo. +Fail Tactic Notation "bar" := foo. + +#[deprecated(since = "8.8", note = "Use idtac instead")] +Tactic Notation "bar" := idtac. + +Goal True. +Fail bar. +Abort. + +Fail Ltac zar := bar. + +Set Warnings "-deprecated". + +Ltac zar := foo. +Ltac zarzar := bar. + +Set Warnings "+deprecated". + +Goal True. +zar x. +zarzar. +Abort. diff --git a/test-suite/success/Notations2.v b/test-suite/success/Notations2.v index 7c2cf3ee..1b33863e 100644 --- a/test-suite/success/Notations2.v +++ b/test-suite/success/Notations2.v @@ -126,3 +126,31 @@ Notation "'myexists' x , p" := (ex (fun x => p)) (at level 200, x ident, p at level 200, right associativity) : type_scope. Check myexists I, I = 0. (* Should not be seen as a constructor *) End M14. + +(* 15. Testing different ways to give the same levels without failing *) + +Module M15. + Local Notation "###### x" := (S x) (right associativity, at level 79, x at next level). + Fail Local Notation "###### x" := (S x) (right associativity, at level 79). + Local Notation "###### x" := (S x) (at level 79). +End M15. + +(* 16. Some test about custom entries *) +Module M16. + (* Test locality *) + Local Declare Custom Entry foo. + Fail Notation "#" := 0 (in custom foo). (* Should be local *) + Local Notation "#" := 0 (in custom foo). + + (* Test import *) + Module A. + Declare Custom Entry foo2. + End A. + Fail Notation "##" := 0 (in custom foo2). + Import A. + Local Notation "##" := 0 (in custom foo2). + + (* Test Print Grammar *) + Print Grammar foo. + Print Grammar foo2. +End M16. diff --git a/test-suite/success/NumeralNotations.v b/test-suite/success/NumeralNotations.v new file mode 100644 index 00000000..47ef3812 --- /dev/null +++ b/test-suite/success/NumeralNotations.v @@ -0,0 +1,302 @@ +(* Test that we fail, rather than raising anomalies, on opaque terms during interpretation *) + +(* https://github.com/coq/coq/pull/8064#discussion_r202497516 *) +Module Test1. + Axiom hold : forall {A B C}, A -> B -> C. + Definition opaque3 (x : Decimal.int) : Decimal.int := hold x (fix f (x : nat) : nat := match x with O => O | S n => S (f n) end). + Numeral Notation Decimal.int opaque3 opaque3 : opaque_scope. + Delimit Scope opaque_scope with opaque. + Fail Check 1%opaque. +End Test1. + +(* https://github.com/coq/coq/pull/8064#discussion_r202497990 *) +Module Test2. + Axiom opaque4 : option Decimal.int. + Definition opaque6 (x : Decimal.int) : option Decimal.int := opaque4. + Numeral Notation Decimal.int opaque6 opaque6 : opaque_scope. + Delimit Scope opaque_scope with opaque. + Open Scope opaque_scope. + Fail Check 1%opaque. +End Test2. + +Module Test3. + Inductive silly := SILLY (v : Decimal.uint) (f : forall A, A -> A). + Definition to_silly (v : Decimal.uint) := SILLY v (fun _ x => x). + Definition of_silly (v : silly) := match v with SILLY v _ => v end. + Numeral Notation silly to_silly of_silly : silly_scope. + Delimit Scope silly_scope with silly. + Fail Check 1%silly. +End Test3. + + +Module Test4. + Polymorphic NonCumulative Inductive punit := ptt. + Polymorphic Definition pto_punit (v : Decimal.uint) : option punit := match Nat.of_uint v with O => Some ptt | _ => None end. + Polymorphic Definition pto_punit_all (v : Decimal.uint) : punit := ptt. + Polymorphic Definition pof_punit (v : punit) : Decimal.uint := Nat.to_uint 0. + Definition to_punit (v : Decimal.uint) : option punit := match Nat.of_uint v with O => Some ptt | _ => None end. + Definition of_punit (v : punit) : Decimal.uint := Nat.to_uint 0. + Polymorphic Definition pto_unit (v : Decimal.uint) : option unit := match Nat.of_uint v with O => Some tt | _ => None end. + Polymorphic Definition pof_unit (v : unit) : Decimal.uint := Nat.to_uint 0. + Definition to_unit (v : Decimal.uint) : option unit := match Nat.of_uint v with O => Some tt | _ => None end. + Definition of_unit (v : unit) : Decimal.uint := Nat.to_uint 0. + Numeral Notation punit to_punit of_punit : pto. + Numeral Notation punit pto_punit of_punit : ppo. + Numeral Notation punit to_punit pof_punit : ptp. + Numeral Notation punit pto_punit pof_punit : ppp. + Numeral Notation unit to_unit of_unit : uto. + Delimit Scope pto with pto. + Delimit Scope ppo with ppo. + Delimit Scope ptp with ptp. + Delimit Scope ppp with ppp. + Delimit Scope uto with uto. + Check let v := 0%pto in v : punit. + Check let v := 0%ppo in v : punit. + Check let v := 0%ptp in v : punit. + Check let v := 0%ppp in v : punit. + Check let v := 0%uto in v : unit. + Fail Check 1%uto. + Fail Check (-1)%uto. + Numeral Notation unit pto_unit of_unit : upo. + Numeral Notation unit to_unit pof_unit : utp. + Numeral Notation unit pto_unit pof_unit : upp. + Delimit Scope upo with upo. + Delimit Scope utp with utp. + Delimit Scope upp with upp. + Check let v := 0%upo in v : unit. + Check let v := 0%utp in v : unit. + Check let v := 0%upp in v : unit. + + Polymorphic Definition pto_punits := pto_punit_all@{Set}. + Polymorphic Definition pof_punits := pof_punit@{Set}. + Numeral Notation punit pto_punits pof_punits : ppps (abstract after 1). + Delimit Scope ppps with ppps. + Universe u. + Constraint Set < u. + Check let v := 0%ppps in v : punit@{u}. (* Check that universes are refreshed *) + Fail Check let v := 1%ppps in v : punit@{u}. (* Note that universes are not refreshed here *) +End Test4. + +Module Test5. + Check S. (* At one point gave Error: Anomaly "Uncaught exception Pretype_errors.PretypeError(_, _, _)." Please report at http://coq.inria.fr/bugs/. *) +End Test5. + +Module Test6. + (* Check that numeral notations on enormous terms don't take forever to print/parse *) + (* Ackerman definition from https://stackoverflow.com/a/10303475/377022 *) + Fixpoint ack (n m : nat) : nat := + match n with + | O => S m + | S p => let fix ackn (m : nat) := + match m with + | O => ack p 1 + | S q => ack p (ackn q) + end + in ackn m + end. + + Timeout 1 Check (S (ack 4 4)). (* should be instantaneous *) + + Local Set Primitive Projections. + Record > wnat := wrap { unwrap :> nat }. + Definition to_uint (x : wnat) : Decimal.uint := Nat.to_uint x. + Definition of_uint (x : Decimal.uint) : wnat := Nat.of_uint x. + Module Export Scopes. + Delimit Scope wnat_scope with wnat. + End Scopes. + Module Export Notations. + Export Scopes. + Numeral Notation wnat of_uint to_uint : wnat_scope (abstract after 5000). + End Notations. + Check let v := 0%wnat in v : wnat. + Check wrap O. + Timeout 1 Check wrap (ack 4 4). (* should be instantaneous *) +End Test6. + +Module Test6_2. + Import Test6.Scopes. + Check Test6.wrap 0. + Import Test6.Notations. + Check let v := 0%wnat in v : Test6.wnat. +End Test6_2. + +Module Test7. + Local Set Primitive Projections. + Record wuint := wrap { unwrap : Decimal.uint }. + Delimit Scope wuint_scope with wuint. + Numeral Notation wuint wrap unwrap : wuint_scope. + Check let v := 0%wuint in v : wuint. + Check let v := 1%wuint in v : wuint. +End Test7. + +Module Test8. + Local Set Primitive Projections. + Record wuint := wrap { unwrap : Decimal.uint }. + Delimit Scope wuint8_scope with wuint8. + Delimit Scope wuint8'_scope with wuint8'. + Section with_var. + Context (dummy : unit). + Definition wrap' := let __ := dummy in wrap. + Definition unwrap' := let __ := dummy in unwrap. + Numeral Notation wuint wrap' unwrap' : wuint8_scope. + Check let v := 0%wuint8 in v : wuint. + End with_var. + Check let v := 0%wuint8 in v : nat. + Fail Check let v := 0%wuint8 in v : wuint. + Compute wrap (Nat.to_uint 0). + + Notation wrap'' := wrap. + Notation unwrap'' := unwrap. + Numeral Notation wuint wrap'' unwrap'' : wuint8'_scope. + Check let v := 0%wuint8' in v : wuint. +End Test8. + +Module Test9. + Delimit Scope wuint9_scope with wuint9. + Delimit Scope wuint9'_scope with wuint9'. + Section with_let. + Local Set Primitive Projections. + Record wuint := wrap { unwrap : Decimal.uint }. + Let wrap' := wrap. + Let unwrap' := unwrap. + Local Notation wrap'' := wrap. + Local Notation unwrap'' := unwrap. + Numeral Notation wuint wrap' unwrap' : wuint9_scope. + Check let v := 0%wuint9 in v : wuint. + Numeral Notation wuint wrap'' unwrap'' : wuint9'_scope. + Check let v := 0%wuint9' in v : wuint. + End with_let. + Check let v := 0%wuint9 in v : nat. + Fail Check let v := 0%wuint9 in v : wuint. +End Test9. + +Module Test10. + (* Test that it is only a warning to add abstract after to an optional parsing function *) + Definition to_uint (v : unit) := Nat.to_uint 0. + Definition of_uint (v : Decimal.uint) := match Nat.of_uint v with O => Some tt | _ => None end. + Definition of_any_uint (v : Decimal.uint) := tt. + Delimit Scope unit_scope with unit. + Delimit Scope unit2_scope with unit2. + Numeral Notation unit of_uint to_uint : unit_scope (abstract after 1). + Local Set Warnings Append "+abstract-large-number-no-op". + (* Check that there is actually a warning here *) + Fail Numeral Notation unit of_uint to_uint : unit2_scope (abstract after 1). + (* Check that there is no warning here *) + Numeral Notation unit of_any_uint to_uint : unit2_scope (abstract after 1). +End Test10. + +Module Test11. + (* Test that numeral notations don't work on proof-local variables, especially not ones containing evars *) + Inductive unit11 := tt11. + Delimit Scope unit11_scope with unit11. + Goal True. + evar (to_uint : unit11 -> Decimal.uint). + evar (of_uint : Decimal.uint -> unit11). + Fail Numeral Notation unit11 of_uint to_uint : uint11_scope. + exact I. + Unshelve. + all: solve [ constructor ]. + Qed. +End Test11. + +Module Test12. + (* Test for numeral notations on context variables *) + Delimit Scope test12_scope with test12. + Section test12. + Context (to_uint : unit -> Decimal.uint) (of_uint : Decimal.uint -> unit). + + Numeral Notation unit of_uint to_uint : test12_scope. + Check let v := 1%test12 in v : unit. + End test12. +End Test12. + +Module Test13. + (* Test for numeral notations on notations which do not denote references *) + Delimit Scope test13_scope with test13. + Delimit Scope test13'_scope with test13'. + Delimit Scope test13''_scope with test13''. + Definition to_uint (x y : unit) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : unit := tt. + Definition to_uint_good := to_uint tt. + Notation to_uint' := (to_uint tt). + Notation to_uint'' := (to_uint _). + Numeral Notation unit of_uint to_uint_good : test13_scope. + Check let v := 0%test13 in v : unit. + Fail Numeral Notation unit of_uint to_uint' : test13'_scope. + Fail Check let v := 0%test13' in v : unit. + Fail Numeral Notation unit of_uint to_uint'' : test13''_scope. + Fail Check let v := 0%test13'' in v : unit. +End Test13. + +Module Test14. + (* Test that numeral notations follow [Import], not [Require], and + also test that [Local Numeral Notation]s do not escape modules + nor sections. *) + Delimit Scope test14_scope with test14. + Delimit Scope test14'_scope with test14'. + Delimit Scope test14''_scope with test14''. + Delimit Scope test14'''_scope with test14'''. + Module Inner. + Definition to_uint (x : unit) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : unit := tt. + Local Numeral Notation unit of_uint to_uint : test14_scope. + Global Numeral Notation unit of_uint to_uint : test14'_scope. + Check let v := 0%test14 in v : unit. + Check let v := 0%test14' in v : unit. + End Inner. + Fail Check let v := 0%test14 in v : unit. + Fail Check let v := 0%test14' in v : unit. + Import Inner. + Fail Check let v := 0%test14 in v : unit. + Check let v := 0%test14' in v : unit. + Section InnerSection. + Definition to_uint (x : unit) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : unit := tt. + Local Numeral Notation unit of_uint to_uint : test14''_scope. + Fail Global Numeral Notation unit of_uint to_uint : test14'''_scope. + Check let v := 0%test14'' in v : unit. + Fail Check let v := 0%test14''' in v : unit. + End InnerSection. + Fail Check let v := 0%test14'' in v : unit. + Fail Check let v := 0%test14''' in v : unit. +End Test14. + +Module Test15. + (** Test module include *) + Delimit Scope test15_scope with test15. + Module Inner. + Definition to_uint (x : unit) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : unit := tt. + Numeral Notation unit of_uint to_uint : test15_scope. + Check let v := 0%test15 in v : unit. + End Inner. + Module Inner2. + Include Inner. + Check let v := 0%test15 in v : unit. + End Inner2. + Import Inner Inner2. + Check let v := 0%test15 in v : unit. +End Test15. + +Module Test16. + (** Test functors *) + Delimit Scope test16_scope with test16. + Module Type A. + Axiom T : Set. + Axiom t : T. + End A. + Module F (a : A). + Inductive Foo := foo (_ : a.T). + Definition to_uint (x : Foo) : Decimal.uint := Nat.to_uint O. + Definition of_uint (x : Decimal.uint) : Foo := foo a.t. + Global Numeral Notation Foo of_uint to_uint : test16_scope. + Check let v := 0%test16 in v : Foo. + End F. + Module a <: A. + Definition T : Set := unit. + Definition t : T := tt. + End a. + Module Import f := F a. + (** Ideally this should work, but it should definitely not anomaly *) + Fail Check let v := 0%test16 in v : Foo. +End Test16. diff --git a/test-suite/success/ROmega4.v b/test-suite/success/ROmega4.v index 58ae5b8f..a7245927 100644 --- a/test-suite/success/ROmega4.v +++ b/test-suite/success/ROmega4.v @@ -3,12 +3,12 @@ See also #148 for the corresponding improvement in Omega. *) -Require Import ZArith ROmega. +Require Import ZArith Lia. Open Scope Z. Goal let x := 3 in x = 3. intros. -romega. +lia. Qed. (** Example seen in #4132 @@ -22,5 +22,5 @@ Lemma foo (H : - zxy' <= zxy) (H' : zxy' <= x') : - b <= zxy. Proof. -romega. +lia. Qed. diff --git a/test-suite/success/RecTutorial.v b/test-suite/success/RecTutorial.v index 84194049..6370cab6 100644 --- a/test-suite/success/RecTutorial.v +++ b/test-suite/success/RecTutorial.v @@ -589,6 +589,8 @@ Close Scope Z_scope. Theorem S_is_not_O : forall n, S n <> 0. +Set Nested Proofs Allowed. + Definition Is_zero (x:nat):= match x with | 0 => True | _ => False @@ -991,10 +993,10 @@ Proof. Qed. -Implicit Arguments Vector.cons [A n]. -Implicit Arguments Vector.nil [A]. -Implicit Arguments Vector.hd [A n]. -Implicit Arguments Vector.tl [A n]. +Arguments Vector.cons [A] _ [n]. +Arguments Vector.nil [A]. +Arguments Vector.hd [A n]. +Arguments Vector.tl [A n]. Definition Vid : forall (A : Type)(n:nat), Vector.t A n -> Vector.t A n. Proof. @@ -1064,7 +1066,7 @@ Fixpoint vector_nth (A:Set)(n:nat)(p:nat)(v:Vector.t A p){struct v} | S n', Vector.cons _ v' => vector_nth A n' _ v' end. -Implicit Arguments vector_nth [A p]. +Arguments vector_nth [A] _ [p]. Lemma nth_bitwise : forall (n:nat) (v1 v2: Vector.t bool n) i a b, @@ -1159,7 +1161,7 @@ infiniteproof map_iterate'. Qed. -Implicit Arguments LNil [A]. +Arguments LNil [A]. Lemma Lnil_not_Lcons : forall (A:Set)(a:A)(l:LList A), LNil <> (LCons a l). diff --git a/test-suite/success/Record.v b/test-suite/success/Record.v index 6f27c1d3..18ebcd63 100644 --- a/test-suite/success/Record.v +++ b/test-suite/success/Record.v @@ -5,7 +5,7 @@ Require Import Program. Require Import List. Record vector {A : Type} {n : nat} := { vec_list : list A ; vec_len : length vec_list = n }. -Implicit Arguments vector []. +Arguments vector : clear implicits. Coercion vec_list : vector >-> list. diff --git a/test-suite/success/Scopes.v b/test-suite/success/Scopes.v index ca374671..2da63063 100644 --- a/test-suite/success/Scopes.v +++ b/test-suite/success/Scopes.v @@ -11,7 +11,7 @@ Check (A.opp 3). Record B := { f :> Z -> Z }. Variable a:B. -Arguments Scope a [Z_scope]. +Arguments a _%Z_scope : extra scopes. Check a 0. (* Check that casts activate scopes if ever possible *) diff --git a/test-suite/success/Typeclasses.v b/test-suite/success/Typeclasses.v index cd6eac35..400479ae 100644 --- a/test-suite/success/Typeclasses.v +++ b/test-suite/success/Typeclasses.v @@ -128,8 +128,8 @@ Record Monad {m : Type -> Type} := { Print Visibility. Print unit. -Implicit Arguments unit [[m] [m0] [α]]. -Implicit Arguments Monad []. +Arguments unit {m m0 α}. +Arguments Monad : clear implicits. Notation "'return' t" := (unit t). (* Test correct handling of existentials and defined fields. *) diff --git a/test-suite/success/apply.v b/test-suite/success/apply.v index 02e043bc..e1df9ba8 100644 --- a/test-suite/success/apply.v +++ b/test-suite/success/apply.v @@ -39,7 +39,7 @@ Qed. (* Check apply/eapply distinction in presence of open terms *) Parameter h : forall x y z : nat, x = z -> x = y. -Implicit Arguments h [[x] [y]]. +Arguments h {x y}. Goal 1 = 0 -> True. intro H. apply h in H || exact I. @@ -559,3 +559,26 @@ split. - (* clear b:True *) match goal with H:_ |- _ => clear H end. (* use a:0=0 *) match goal with H:_ |- _ => exact H end. Qed. + +(* Test choice of most dependent solution *) +Goal forall n, n = 0 -> exists p, p = n /\ p = 0. +intros. eexists ?[p]. split. rewrite H. +reflexivity. (* Compatibility tells [?p:=n] rather than [?p:=0] *) +exact H. (* this checks that the goal is [n=0], not [0=0] *) +Qed. + +(* Check insensitivity to alphabetic order of names*) +(* In both cases, the last name is conventionally chosen *) +(* Before 8.9, the name coming first in alphabetic order *) +(* was chosen. *) +Goal forall m n, m = n -> n = 0 -> exists p, p = n /\ p = 0. +intros. eexists ?[p]. split. rewrite H. +reflexivity. +exact H0. +Qed. + +Goal forall n m, n = m -> m = 0 -> exists p, p = m /\ p = 0. +intros. eexists ?[p]. split. rewrite H. +reflexivity. +exact H0. +Qed. diff --git a/test-suite/success/attribute-syntax.v b/test-suite/success/attribute-syntax.v new file mode 100644 index 00000000..83fb3d0c --- /dev/null +++ b/test-suite/success/attribute-syntax.v @@ -0,0 +1,23 @@ +From Coq Require Program. + +Section Scope. + +#[local] Coercion nat_of_bool (b: bool) : nat := + if b then 0 else 1. + +Check (refl_equal : true = 0 :> nat). + +End Scope. + +Fail Check 0 = true :> nat. + +#[polymorphic] +Definition ι T (x: T) := x. + +Check ι _ ι. + +#[program] +Fixpoint f (n: nat) {wf lt n} : nat := _. + +#[deprecated(since="8.9.0")] +Ltac foo := foo. diff --git a/test-suite/success/dependentind.v b/test-suite/success/dependentind.v index f5bb884d..55ae54ca 100644 --- a/test-suite/success/dependentind.v +++ b/test-suite/success/dependentind.v @@ -42,7 +42,7 @@ Inductive ctx : Type := Bind Scope context_scope with ctx. Delimit Scope context_scope with ctx. -Arguments Scope snoc [context_scope]. +Arguments snoc _%context_scope. Notation " Γ , τ " := (snoc Γ τ) (at level 25, τ at next level, left associativity) : context_scope. diff --git a/test-suite/success/destruct.v b/test-suite/success/destruct.v index 6fbe61a9..d1d38465 100644 --- a/test-suite/success/destruct.v +++ b/test-suite/success/destruct.v @@ -422,6 +422,7 @@ Abort. Goal forall b:bool, b = b. intros. destruct b eqn:H. +Abort. (* Check natural instantiation behavior when the goal has already an evar *) diff --git a/test-suite/success/evars.v b/test-suite/success/evars.v index 0f9fb745..253b48e4 100644 --- a/test-suite/success/evars.v +++ b/test-suite/success/evars.v @@ -386,7 +386,7 @@ Record iffT (X Y:Type) : Type := mkIff { iffLR : X->Y; iffRL : Y->X }. Record tri (R:Type->Type->Type) (S:Type->Type->Type) (T:Type->Type->Type) := mkTri { tri0 : forall a b c, R a b -> S a c -> T b c }. -Implicit Arguments mkTri [R S T]. +Arguments mkTri [R S T]. Definition tri_iffT : tri iffT iffT iffT := (mkTri (fun X0 X1 X2 E01 E02 => diff --git a/test-suite/success/goal_selector.v b/test-suite/success/goal_selector.v index 86814051..0951c5c8 100644 --- a/test-suite/success/goal_selector.v +++ b/test-suite/success/goal_selector.v @@ -53,3 +53,17 @@ Goal True -> exists (x : Prop), x. Proof. intro H; eexists ?[x]; only [x]: exact True. 1: assumption. Qed. + +(* Strict focusing! *) +Set Default Goal Selector "!". + +Goal True -> True /\ True /\ True. +Proof. + intro. + split;only 2:split. + Fail exact I. + Fail !:exact I. + 1:exact I. + - !:exact H. + - exact I. +Qed. diff --git a/test-suite/success/implicit.v b/test-suite/success/implicit.v index a0981311..23853890 100644 --- a/test-suite/success/implicit.v +++ b/test-suite/success/implicit.v @@ -33,11 +33,11 @@ Definition eq1 := fun (A:Type) (x y:A) => x=y. Definition eq2 := fun (A:Type) (x y:A) => x=y. Definition eq3 := fun (A:Type) (x y:A) => x=y. -Implicit Arguments op' []. -Global Implicit Arguments op'' []. +Arguments op' : clear implicits. +Global Arguments op'' : clear implicits. -Implicit Arguments eq2 []. -Global Implicit Arguments eq3 []. +Arguments eq2 : clear implicits. +Global Arguments eq3 : clear implicits. Check (op 0 0). Check (op' nat 0 0). @@ -89,14 +89,14 @@ Fixpoint plus n m {struct n} := (* Check multiple implicit arguments signatures *) -Implicit Arguments eq_refl [[A] [x]] [[A]]. +Arguments eq_refl {A x}, {A}. Check eq_refl : 0 = 0. (* Check that notations preserve implicit (since 8.3) *) Parameter p : forall A, A -> forall n, n = 0 -> True. -Implicit Arguments p [A n]. +Arguments p [A] _ [n]. Notation Q := (p 0). Check Q eq_refl. diff --git a/test-suite/success/intros.v b/test-suite/success/intros.v index a329894a..d37ad9f5 100644 --- a/test-suite/success/intros.v +++ b/test-suite/success/intros.v @@ -127,4 +127,28 @@ induction 1 as (n,H,IH). exact Logic.I. Qed. +(* Make "intro"/"intros" progress on existential variables *) +Module Evar. + +Goal exists (A:Prop), A. +eexists. +unshelve (intro x). +- exact nat. +- exact (x=x). +- auto. +Qed. + +Goal exists (A:Prop), A. +eexists. +unshelve (intros x). +- exact nat. +- exact (x=x). +- auto. +Qed. + +Definition d := ltac:(intro x; exact (x*x)). + +Definition d' : nat -> _ := ltac:(intros;exact 0). + +End Evar. diff --git a/test-suite/success/letproj.v b/test-suite/success/letproj.v index de2857b4..2f0d8bf8 100644 --- a/test-suite/success/letproj.v +++ b/test-suite/success/letproj.v @@ -7,3 +7,5 @@ Definition test (A : Type) (f : Foo A) := Scheme foo_case := Case for Foo Sort Type. +Definition test' (A : Type) (f : Foo A) := + let 'Build_Foo _ x y := f in x. diff --git a/test-suite/success/mutual_record.v b/test-suite/success/mutual_record.v new file mode 100644 index 00000000..77529733 --- /dev/null +++ b/test-suite/success/mutual_record.v @@ -0,0 +1,57 @@ +Module M0. + +Inductive foo (A : Type) := Foo { + foo0 : option (bar A); + foo1 : nat; + foo2 := foo1 = 0; + foo3 : foo2; +} + +with bar (A : Type) := Bar { + bar0 : A; + bar1 := 0; + bar2 : bar1 = 0; + bar3 : nat -> foo A; +}. + +End M0. + +Module M1. + +Set Primitive Projections. + +Inductive foo (A : Type) := Foo { + foo0 : option (bar A); + foo1 : nat; + foo2 := foo1 = 0; + foo3 : foo2; +} + +with bar (A : Type) := Bar { + bar0 : A; + bar1 := 0; + bar2 : bar1 = 0; + bar3 : nat -> foo A; +}. + +End M1. + +Module M2. + +Set Primitive Projections. + +CoInductive foo (A : Type) := Foo { + foo0 : option (bar A); + foo1 : nat; + foo2 := foo1 = 0; + foo3 : foo2; +} + +with bar (A : Type) := Bar { + bar0 : A; + bar1 := 0; + bar2 : bar1 = 0; + bar3 : nat -> foo A; +}. + +End M2. diff --git a/test-suite/success/primitiveproj.v b/test-suite/success/primitiveproj.v index 31a1608c..299b08bd 100644 --- a/test-suite/success/primitiveproj.v +++ b/test-suite/success/primitiveproj.v @@ -193,9 +193,37 @@ Set Primitive Projections. Record s (x:nat) (y:=S x) := {c:=x; d:x=c}. Lemma f : 0=1. Proof. -Fail apply d. + Fail apply d. (* split. reflexivity. Qed. *) +Abort. + +(* Primitive projection match compilation *) +Require Import List. +Set Primitive Projections. + +Record prod (A B : Type) := pair { fst : A ; snd : B }. +Arguments pair {_ _} _ _. + +Fixpoint split_at {A} (l : list A) (n : nat) : prod (list A) (list A) := + match n with + | 0 => pair nil l + | S n => + match l with + | nil => pair nil nil + | x :: l => let 'pair l1 l2 := split_at l n in pair (x :: l1) l2 + end + end. + +Time Eval vm_compute in split_at (repeat 0 20) 10. (* Takes 0s *) +Time Eval vm_compute in split_at (repeat 0 40) 20. (* Takes 0.001s *) +Timeout 1 Time Eval vm_compute in split_at (repeat 0 60) 30. (* Used to take 60s, now takes 0.001s *) + +Check (@eq_refl _ 0 <: 0 = fst (pair 0 1)). +Fail Check (@eq_refl _ 0 <: 0 = snd (pair 0 1)). + +Check (@eq_refl _ 0 <<: 0 = fst (pair 0 1)). +Fail Check (@eq_refl _ 0 <<: 0 = snd (pair 0 1)). diff --git a/test-suite/success/refine.v b/test-suite/success/refine.v index 22fb4d75..40986e57 100644 --- a/test-suite/success/refine.v +++ b/test-suite/success/refine.v @@ -121,14 +121,16 @@ Abort. (* Wish 1988: that fun forces unfold in refine *) Goal (forall A : Prop, A -> ~~A). -Proof. refine(fun A a f => _). +Proof. refine(fun A a f => _). Abort. (* Checking beta-iota normalization of hypotheses in created evars *) Goal {x|x=0} -> True. refine (fun y => let (x,a) := y in _). match goal with a:_=0 |- _ => idtac end. +Abort. Goal (forall P, {P 0}+{P 1}) -> True. refine (fun H => if H (fun x => x=x) then _ else _). match goal with _:0=0 |- _ => idtac end. +Abort. diff --git a/test-suite/success/rewrite.v b/test-suite/success/rewrite.v index 448d0082..baf08979 100644 --- a/test-suite/success/rewrite.v +++ b/test-suite/success/rewrite.v @@ -7,7 +7,7 @@ Inductive listn : nat -> Set := Axiom ax : forall (n n' : nat) (l : listn (n + n')) (l' : listn (n' + n)), - existS _ (n + n') l = existS _ (n' + n) l'. + existT _ (n + n') l = existT _ (n' + n) l'. Lemma lem : forall (n n' : nat) (l : listn (n + n')) (l' : listn (n' + n)), @@ -72,7 +72,7 @@ Qed. Require Import JMeq. -Goal forall A B (a:A) (b:B), JMeq a b -> JMeq b a -> True. +Goal forall A B (a:A) (b:B), JMeq a b -> JMeq b a -> True. inversion 1; (* Goal is now [JMeq a a -> True] *) dependent rewrite H3. Undo. intros; inversion H; dependent rewrite H4 in H0. @@ -135,7 +135,7 @@ Abort. Goal forall x y, x=y+0 -> let z := x+1 in x+1=y -> z=z -> z=x. intros. subst x. (* was failing *) -subst z. +subst z. rewrite H0. auto with arith. Qed. diff --git a/test-suite/success/sideff.v b/test-suite/success/sideff.v index 3c0b8156..b9a1273b 100644 --- a/test-suite/success/sideff.v +++ b/test-suite/success/sideff.v @@ -5,6 +5,8 @@ Proof. apply (const tt tt). Qed. +Set Nested Proofs Allowed. + Lemma foobar' : unit. Lemma aux : forall A : Type, A -> unit. Proof. intros. pose (foo := idw A). exact tt. Show Universes. Qed. diff --git a/test-suite/success/uniform_inductive_parameters.v b/test-suite/success/uniform_inductive_parameters.v new file mode 100644 index 00000000..42236a53 --- /dev/null +++ b/test-suite/success/uniform_inductive_parameters.v @@ -0,0 +1,13 @@ +Set Uniform Inductive Parameters. + +Inductive list (A : Type) := + | nil : list + | cons : A -> list -> list. +Check (list : Type -> Type). +Check (cons : forall A, A -> list A -> list A). + +Inductive list2 (A : Type) (A' := prod A A) := + | nil2 : list2 + | cons2 : A' -> list2 -> list2. +Check (list2 : Type -> Type). +Check (cons2 : forall A (A' := prod A A), A' -> list2 A -> list2 A). diff --git a/test-suite/success/univers.v b/test-suite/success/univers.v index 28634045..28426b57 100644 --- a/test-suite/success/univers.v +++ b/test-suite/success/univers.v @@ -60,7 +60,7 @@ Qed. Record U : Type := { A:=Type; a:A }. -(** Check assignement of sorts to inductives and records. *) +(** Check assignment of sorts to inductives and records. *) Variable sh : list nat. diff --git a/test-suite/success/vm_records.v b/test-suite/success/vm_records.v new file mode 100644 index 00000000..8a1544c8 --- /dev/null +++ b/test-suite/success/vm_records.v @@ -0,0 +1,40 @@ +Set Primitive Projections. + +Module M. + +CoInductive foo := Foo { + foo0 : foo; + foo1 : bar; +} +with bar := Bar { + bar0 : foo; + bar1 : bar; +}. + +CoFixpoint f : foo := Foo f g +with g : bar := Bar f g. + +Check (@eq_refl _ g.(bar0) <: f.(foo0).(foo0) = g.(bar0)). +Check (@eq_refl _ g <: g.(bar1).(bar0).(foo1) = g). + +End M. + +Module N. + +Inductive foo := Foo { + foo0 : option foo; + foo1 : list bar; +} +with bar := Bar { + bar0 : option bar; + bar1 : list foo; +}. + +Definition f_0 := Foo None nil. +Definition g_0 := Bar None nil. + +Definition f := Foo (Some f_0) (cons g_0 nil). + +Check (@eq_refl _ f.(foo1) <: f.(foo1) = cons g_0 nil). + +End N. diff --git a/test-suite/tools/update-compat/run.sh b/test-suite/tools/update-compat/run.sh new file mode 100755 index 00000000..02a23484 --- /dev/null +++ b/test-suite/tools/update-compat/run.sh @@ -0,0 +1,9 @@ +#!/usr/bin/env bash + +# allow running this script from any directory by basing things on where the script lives +SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null && pwd )" + +# we assume that the script lives in test-suite/tools/update-compat/, +# and that update-compat.py lives in dev/tools/ +cd "${SCRIPT_DIR}/../../.." +dev/tools/update-compat.py --assert-unchanged --cur-version=8.9 || exit $? diff --git a/test-suite/unit-tests/.merlin.in b/test-suite/unit-tests/.merlin.in new file mode 100644 index 00000000..b2279de7 --- /dev/null +++ b/test-suite/unit-tests/.merlin.in @@ -0,0 +1,6 @@ +REC + +S ** +B ** + +PKG oUnit diff --git a/test-suite/unit-tests/clib/inteq.ml b/test-suite/unit-tests/clib/inteq.ml new file mode 100644 index 00000000..89717c79 --- /dev/null +++ b/test-suite/unit-tests/clib/inteq.ml @@ -0,0 +1,15 @@ +open Utest + +let log_out_ch = open_log_out_ch __FILE__ + +let eq0 = mk_bool_test "clib-inteq0" + "Int.equal on 0" + (Int.equal 0 0) + +let eq42 = mk_bool_test "clib-inteq42" + "Int.equal on 42" + (Int.equal 42 42) + +let tests = [ eq0; eq42 ] + +let _ = run_tests __FILE__ log_out_ch tests diff --git a/test-suite/unit-tests/clib/unicode_tests.ml b/test-suite/unit-tests/clib/unicode_tests.ml new file mode 100644 index 00000000..95316ad3 --- /dev/null +++ b/test-suite/unit-tests/clib/unicode_tests.ml @@ -0,0 +1,17 @@ +open Utest + +let log_out_ch = open_log_out_ch __FILE__ + +let unicode0 = mk_eq_test "clib-unicode0" + "split_at_first_letter, first letter is character" + None + (Unicode.split_at_first_letter "ident") + +let unicode1 = mk_eq_test "clib-unicode1" + "split_at_first_letter, first letter not character" + (Some ("__","ident")) + (Unicode.split_at_first_letter "__ident") + +let tests = [ unicode0; unicode1 ] + +let _ = run_tests __FILE__ log_out_ch tests diff --git a/test-suite/unit-tests/printing/proof_diffs_test.ml b/test-suite/unit-tests/printing/proof_diffs_test.ml new file mode 100644 index 00000000..526cefec --- /dev/null +++ b/test-suite/unit-tests/printing/proof_diffs_test.ml @@ -0,0 +1,333 @@ +open OUnit +open Utest +open Pp_diff +open Proof_diffs + +let tokenize_string = Proof_diffs.tokenize_string +let diff_pp = diff_pp ~tokenize_string +let diff_str = diff_str ~tokenize_string + +let tests = ref [] +let add_test name test = tests := (mk_test name (TestCase test)) :: !tests + +let log_out_ch = open_log_out_ch __FILE__ +let cfprintf oc = Printf.(kfprintf (fun oc -> fprintf oc "") oc) +let cprintf s = cfprintf log_out_ch s +let _ = Proof_diffs.log_out_ch := log_out_ch + +let string_of_string s : string = "\"" ^ s ^ "\"" + +(* todo: OCaml: why can't the body of the test function be given in the add_test line? *) + +let t () = + let expected : diff_list = [] in + let diffs = diff_str "" " " in + + assert_equal ~msg:"empty" ~printer:string_of_diffs expected diffs; + let (has_added, has_removed) = has_changes diffs in + assert_equal ~msg:"has `Added" ~printer:string_of_bool false has_added; + assert_equal ~msg:"has `Removed" ~printer:string_of_bool false has_removed +let _ = add_test "diff_str empty" t + + +let t () = + let expected : diff_list = + [ `Common (0, 0, "a"); `Common (1, 1, "b"); `Common (2, 2, "c")] in + let diffs = diff_str "a b c" " a b\t c\n" in + + assert_equal ~msg:"white space" ~printer:string_of_diffs expected diffs; + let (has_added, has_removed) = has_changes diffs in + assert_equal ~msg:"no `Added" ~printer:string_of_bool false has_added; + assert_equal ~msg:"no `Removed" ~printer:string_of_bool false has_removed +let _ = add_test "diff_str white space" t + +let t () = + let expected : diff_list = [ `Removed (0, "a"); `Added (0, "b")] in + let diffs = diff_str "a" "b" in + + assert_equal ~msg:"add/remove" ~printer:string_of_diffs expected diffs; + let (has_added, has_removed) = has_changes diffs in + assert_equal ~msg:"has `Added" ~printer:string_of_bool true has_added; + assert_equal ~msg:"has `Removed" ~printer:string_of_bool true has_removed +let _ = add_test "diff_str add/remove" t + +(* example of a limitation, not really a test *) +let t () = + try + let _ = diff_str "a" ">" in + assert_failure "unlexable string gives an exception" + with _ -> () +let _ = add_test "diff_str unlexable" t + +(* problematic examples for tokenize_string: + comments omitted + quoted string loses quote marks (are escapes supported/handled?) + char constant split into 2 + *) +let t () = + List.iter (fun x -> cprintf "'%s' " x) (tokenize_string "(* comment *) \"string\" 'c' xx"); + cprintf "\n" +let _ = add_test "tokenize_string examples" t + +open Pp + +(* note pp_to_string concatenates adjacent strings, could become one token, +e.g. str " a" ++ str "b " will give a token "ab" *) +(* checks background is present and correct *) +let t () = + let o_pp = str "a" ++ str "!" ++ str "c" in + let n_pp = str "a" ++ str "?" ++ str "c" in + let (o_exp, n_exp) = (wrap_in_bg "diff.removed" (str "a" ++ (tag "diff.removed" (str "!")) ++ str "c"), + wrap_in_bg "diff.added" (str "a" ++ (tag "diff.added" (str "?")) ++ str "c")) in + let (o_diff, n_diff) = diff_pp o_pp n_pp in + + assert_equal ~msg:"removed" ~printer:db_string_of_pp o_exp o_diff; + assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp n_diff +let _ = add_test "diff_pp/add_diff_tags add/remove" t + +let t () = + (*Printf.printf "%s\n" (string_of_diffs (diff_str "a d" "a b c d"));*) + let o_pp = str "a" ++ str " d" in + let n_pp = str "a" ++ str " b " ++ str " c " ++ str "d" ++ str " e " in + let n_exp = flatten (wrap_in_bg "diff.added" (seq [ + str "a"; + str " "; (tag "start.diff.added" (str "b ")); + (tag "end.diff.added" (str " c")); str " "; + (str "d"); + str " "; (tag "diff.added" (str "e")); str " " + ])) in + let (_, n_diff) = diff_pp o_pp n_pp in + + assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff);; +let _ = add_test "diff_pp/add_diff_tags a span with spaces" t + + +let t () = + let o_pp = str " " in + let n_pp = tag "sometag" (str "a") in + let n_exp = flatten (wrap_in_bg "diff.added" (tag "diff.added" (tag "sometag" (str "a")))) in + let (_, n_diff) = diff_pp o_pp n_pp in + + assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) +let _ = add_test "diff_pp/add_diff_tags diff tags outside existing tags" t + +let t () = + let o_pp = str " " in + let n_pp = seq [(tag "sometag" (str " a ")); str "b"] in + let n_exp = flatten (wrap_in_bg "diff.added" + (seq [tag "sometag" (str " "); (tag "start.diff.added" (tag "sometag" (str "a "))); + (tag "end.diff.added" (str "b"))]) ) in + let (_, n_diff) = diff_pp o_pp n_pp in + + assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) +let _ = add_test "diff_pp/add_diff_tags existing tagged values with spaces" t + +let t () = + let o_pp = str " " in + let n_pp = str " a b " in + let n_exp = flatten (wrap_in_bg "diff.added" + (seq [str " "; tag "diff.added" (str "a b"); str " "])) in + let (_, n_diff) = diff_pp o_pp n_pp in + + assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) +let _ = add_test "diff_pp/add_diff_tags multiple tokens in pp" t + +let t () = + let o_pp = str "a d" in + let n_pp = seq [str "a b"; str "c d"] in + let n_exp = flatten (wrap_in_bg "diff.added" + (seq [str "a "; tag "start.diff.added" (str "b"); + tag "end.diff.added" (str "c"); str " d"])) in + let (_, n_diff) = diff_pp o_pp n_pp in + + assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) +let _ = add_test "diff_pp/add_diff_tags token spanning multiple Ppcmd_strs" t + +let t () = + let o_pp = seq [str ""; str "a"] in + let n_pp = seq [str ""; str "a b"] in + let n_exp = flatten (wrap_in_bg "diff.added" + (seq [str ""; str "a "; tag "diff.added" (str "b")])) in + let (_, n_diff) = diff_pp o_pp n_pp in + + assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) +let _ = add_test "diff_pp/add_diff_tags empty string preserved" t + +(* todo: awaiting a change in the lexer to return the quotes of the string token *) +let t () = + let s = "\"a b\"" in + let o_pp = seq [str s] in + let n_pp = seq [str "\"a b\" "] in + cprintf "ppcmds: %s\n" (string_of_ppcmds n_pp); + let n_exp = flatten (wrap_in_bg "diff.added" + (seq [str ""; str "a "; tag "diff.added" (str "b")])) in + let (_, n_diff) = diff_pp o_pp n_pp in + + assert_equal ~msg:"string" ~printer:string_of_string "a b" (List.hd (tokenize_string s)); + assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) +let _ = if false then add_test "diff_pp/add_diff_tags token containing white space" t + +let add_entries map idents rhs_pp = + let make_entry() = { idents; rhs_pp; done_ = false } in + List.iter (fun ident -> map := (StringMap.add ident (make_entry ()) !map); ()) idents;; + +let print_list hyps = List.iter (fun x -> cprintf "%s\n" (string_of_ppcmds (flatten x))) hyps +let db_print_list hyps = List.iter (fun x -> cprintf "%s\n" (db_string_of_pp (flatten x))) hyps + + +(* a : foo + b : bar car -> + b : car + a : foo bar *) +let t () = + write_diffs_option "removed"; (* turn on "removed" option *) + let o_line_idents = [ ["a"]; ["b"]] in + let o_hyp_map = ref StringMap.empty in + add_entries o_hyp_map ["a"] (str " : foo"); + add_entries o_hyp_map ["b"] (str " : bar car"); + let n_line_idents = [ ["b"]; ["a"]] in + let n_hyp_map = ref StringMap.empty in + add_entries n_hyp_map ["b"] (str " : car"); + add_entries n_hyp_map ["a"] (str " : foo bar"); + let expected = [flatten (wrap_in_bg "diff.removed" (seq [str "b"; str " : "; (tag "diff.removed" (str "bar")); str " car" ])); + flatten (wrap_in_bg "diff.added" (seq [str "b"; str " : car" ])); + flatten (wrap_in_bg "diff.added" (seq [str "a"; str " : foo "; (tag "diff.added" (str "bar")) ])) + ] in + + let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in + + (*print_list hyps_diff_list;*) + (*db_print_list hyps_diff_list;*) + + List.iter2 (fun exp act -> + assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) + expected hyps_diff_list +let _ = add_test "diff_hyps simple diffs" t + +(* a : nat + c, d : int -> + a, b : nat + d : int + and keeps old order *) +let t () = + write_diffs_option "removed"; (* turn on "removed" option *) + let o_line_idents = [ ["a"]; ["c"; "d"]] in + let o_hyp_map = ref StringMap.empty in + add_entries o_hyp_map ["a"] (str " : nat"); + add_entries o_hyp_map ["c"; "d"] (str " : int"); + let n_line_idents = [ ["a"; "b"]; ["d"]] in + let n_hyp_map = ref StringMap.empty in + add_entries n_hyp_map ["a"; "b"] (str " : nat"); + add_entries n_hyp_map ["d"] (str " : int"); + let expected = [flatten (wrap_in_bg "diff.added" (seq [str "a"; (tag "start.diff.added" (str ", ")); (tag "end.diff.added" (str "b")); str " : nat" ])); + flatten (wrap_in_bg "diff.removed" (seq [(tag "start.diff.removed" (str "c")); (tag "end.diff.removed" (str ",")); str " "; str "d"; str " : int" ])); + flatten (wrap_in_bg "diff.added" (seq [str "d"; str " : int" ])) + ] in + + let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in + + (*print_list hyps_diff_list;*) + (*print_list expected;*) + + (*db_print_list hyps_diff_list;*) + (*db_print_list expected;*) + + List.iter2 (fun exp act -> + assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) + expected hyps_diff_list +let _ = add_test "diff_hyps compacted" t + +(* a : foo + b : bar + c : nat -> + b, a, c : nat +DIFFS + b : bar (remove bar) + b : nat (add nat) + a : foo (remove foo) + a : nat (add nat) + c : nat + is this a realistic use case? +*) +let t () = + write_diffs_option "removed"; (* turn on "removed" option *) + let o_line_idents = [ ["a"]; ["b"]; ["c"]] in + let o_hyp_map = ref StringMap.empty in + add_entries o_hyp_map ["a"] (str " : foo"); + add_entries o_hyp_map ["b"] (str " : bar"); + add_entries o_hyp_map ["c"] (str " : nat"); + let n_line_idents = [ ["b"; "a"; "c"] ] in + let n_hyp_map = ref StringMap.empty in + add_entries n_hyp_map ["b"; "a"; "c"] (str " : nat"); + let expected = [flatten (wrap_in_bg "diff.removed" (seq [str "b"; str " : "; (tag "diff.removed" (str "bar"))])); + flatten (wrap_in_bg "diff.added" (seq [str "b"; str " : "; (tag "diff.added" (str "nat"))])); + flatten (wrap_in_bg "diff.removed" (seq [str "a"; str " : "; (tag "diff.removed" (str "foo"))])); + flatten (wrap_in_bg "diff.added" (seq [str "a"; str " : "; (tag "diff.added" (str "nat"))])); + flatten (seq [str "c"; str " : nat"]) + ] in + + let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in + + (*print_list hyps_diff_list;*) + (*db_print_list hyps_diff_list;*) + + List.iter2 (fun exp act -> + assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) + expected hyps_diff_list +let _ = add_test "diff_hyps compacted with join" t + +(* b, a, c : nat -> + a : foo + b : bar + c : nat +DIFFS + a : nat (remove nat) + a : foo (add foo) + b : nat (remove nat) + b : bar (add bar) + c : nat + is this a realistic use case? *) +let t () = + write_diffs_option "removed"; (* turn on "removed" option *) + let o_line_idents = [ ["b"; "a"; "c"] ] in + let o_hyp_map = ref StringMap.empty in + add_entries o_hyp_map ["b"; "a"; "c"] (str " : nat"); + let n_line_idents = [ ["a"]; ["b"]; ["c"]] in + let n_hyp_map = ref StringMap.empty in + add_entries n_hyp_map ["a"] (str " : foo"); + add_entries n_hyp_map ["b"] (str " : bar"); + add_entries n_hyp_map ["c"] (str " : nat"); + let expected = [flatten (wrap_in_bg "diff.removed" (seq [str "a"; str " : "; (tag "diff.removed" (str "nat"))])); + flatten (wrap_in_bg "diff.added" (seq [str "a"; str " : "; (tag "diff.added" (str "foo"))])); + flatten (wrap_in_bg "diff.removed" (seq [str "b"; str " : "; (tag "diff.removed" (str "nat"))])); + flatten (wrap_in_bg "diff.added" (seq [str "b"; str " : "; (tag "diff.added" (str "bar"))])); + flatten (seq [str "c"; str " : nat"]) + ] in + + let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in + + (*print_list hyps_diff_list;*) + (*db_print_list hyps_diff_list;*) + + List.iter2 (fun exp act -> + assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) + expected hyps_diff_list +let _ = add_test "diff_hyps compacted with split" t + + +(* other potential tests +coqtop/terminal formatting BLOCKED: CAN'T GET TAGS IN FORMATTER + white space at end of line + spanning diffs +shorten_diff_span + +MAYBE NOT WORTH IT +diff_pp/add_diff_tags + add/remove - show it preserves, recurs and processes: + nested in boxes + breaks, etc. preserved +diff_pp_combined with/without removed +*) + + +let _ = run_tests __FILE__ log_out_ch (List.rev !tests) diff --git a/test-suite/unit-tests/src/utest.ml b/test-suite/unit-tests/src/utest.ml new file mode 100644 index 00000000..0cb1780e --- /dev/null +++ b/test-suite/unit-tests/src/utest.ml @@ -0,0 +1,76 @@ +open OUnit + +(* general case to build a test *) +let mk_test nm test = nm >: test + +(* common cases for building tests *) +let mk_eq_test nm descr expected actual = + mk_test nm (TestCase (fun _ -> assert_equal ~msg:descr expected actual)) + +let mk_bool_test nm descr actual = + mk_test nm (TestCase (fun _ -> assert_bool descr actual)) + +let cfprintf oc = Printf.(kfprintf (fun oc -> fprintf oc "\n%!") oc) + +(* given test result, print message, return success boolean *) +let logger out_ch result = + let cprintf s = cfprintf out_ch s in + match result with + | RSuccess path -> + cprintf "TEST SUCCEEDED: %s" (string_of_path path); + true + | RError (path,msg) + | RFailure (path,msg) -> + cprintf "TEST FAILED: %s (%s)" (string_of_path path) msg; + false + | RSkip (path,msg) + | RTodo (path,msg) -> + cprintf "TEST DID NOT SUCCEED: %s (%s)" (string_of_path path) msg; + false + +(* run one OUnit test case, return successes, no. of tests *) +(* notionally one test, which might be a TestList *) +let run_one logit test = + let rec process_results rs = + match rs with + [] -> (0,0) + | (r::rest) -> + let succ = if logit r then 1 else 0 in + let succ_results,tot_results = process_results rest in + (succ + succ_results,tot_results + 1) + in + let results = perform_test (fun _ -> ()) test in + process_results results + +let open_log_out_ch ml_fn = + let log_fn = ml_fn ^ ".log" in + open_out log_fn + +(* run list of OUnit test cases, log results *) +let run_tests ml_fn out_ch tests = + let cprintf s = cfprintf out_ch s in + let ceprintf s = cfprintf stderr s in + let logit = logger out_ch in + let rec run_some tests succ tot = + match tests with + [] -> (succ,tot) + | (t::ts) -> + let succ_one,tot_one = run_one logit t in + run_some ts (succ + succ_one) (tot + tot_one) + in + (* format for test-suite summary to find status + success if all tests succeeded, else failure + *) + let succ,tot = run_some tests 0 0 in + cprintf + "*** Ran %d tests, with %d successes and %d failures ***" + tot succ (tot - succ); + if succ = tot then + cprintf + "==========> SUCCESS <==========\n %s...Ok" ml_fn + else begin + cprintf + "==========> FAILURE <==========\n %s...Error!" ml_fn; + ceprintf "FAILED %s.log" ml_fn + end; + close_out out_ch diff --git a/test-suite/unit-tests/src/utest.mli b/test-suite/unit-tests/src/utest.mli new file mode 100644 index 00000000..2e0f26e9 --- /dev/null +++ b/test-suite/unit-tests/src/utest.mli @@ -0,0 +1,18 @@ +(** give a name to a unit test *) +val mk_test : string -> OUnit.test -> OUnit.test + +(** simple ways to build a test *) +val mk_eq_test : string -> string -> 'a -> 'a -> OUnit.test +val mk_bool_test : string -> string -> bool -> OUnit.test + +(** run unit tests *) +(* the string argument should be the name of the .ml file + containing the tests; use __FILE__ for that purpose. + *) +val run_tests : string -> out_channel -> OUnit.test list -> unit + +(** open output channel for the test log file *) +(* the string argument should be the name of the .ml file + containing the tests; use __FILE__ for that purpose. + *) +val open_log_out_ch : string -> out_channel diff --git a/test-suite/vio/numeral.v b/test-suite/vio/numeral.v new file mode 100644 index 00000000..f28355bb --- /dev/null +++ b/test-suite/vio/numeral.v @@ -0,0 +1,21 @@ +Lemma foo : True. +Proof. +Check 0 : nat. +Check 0 : nat. +exact I. +Qed. + +Lemma bar : True. +Proof. +pose (0 : nat). +exact I. +Qed. + +Require Import Coq.Strings.Ascii. +Open Scope char_scope. + +Lemma baz : True. +Proof. +pose "s". +exact I. +Qed. |