Commit 164c6861860e6b52818c031f901ffeff91fca16a - coq

+46

-4

CHANGES less more

	0	Changes from V8.5beta3 to V8.5
	1	==============================
	2
	3	Tools
	4
	5	- Flag "-compat 8.4" now loads Coq.Compat.Coq84. The standard way of
	6	putting Coq in v8.4 compatibility mode is to pass the command line flag
	7	"-compat 8.4". It can be followed by "-require Coq.Compat.AdmitAxiom"
	8	if the 8.4 behavior of admit is needed, in which case it uses an axiom.
	9
	10	Specification language
	11
	12	- Syntax "$(tactic)$" changed to "ltac:(tactic)".
	13
	14	Tactics
	15
	16	- Syntax "destruct !hyp" changed to "destruct (hyp)", and similarly
	17	for induction (rare source of incompatibilities easily solvable by
	18	removing parentheses around "hyp" when not for the purpose of keeping
	19	the hypothesis).
	20	- Syntax "p/c" for on-the-fly application of a lemma c before
	21	introducing along pattern p changed to p%c1..%cn. The feature and
	22	syntax are in experimental stage.
	23	- "Proof using" does not clear unused section variables.
	24	- Tactic "refine" has been changed back to the 8.4 behavior of shelving subgoals
	25	that occur in other subgoals. The "refine" tactic of 8.5beta3 has been
	26	renamed "simple refine"; it does not shelve any subgoal.
	27	- New tactical "unshelve tac" which grab existential variables put on
	28	the tactic shelve by the execution of "tac".
	29
0	30	Changes from V8.5beta2 to V8.5beta3
1	31	===================================
2	32

8	38	declaration of all polymorphic universes appearing in a definition when
9	39	introducing it.
10	40	- New command "Show id" to show goal named id.
	41	- Option "Virtual Machine" removed.
11	42
12	43	Tactics
13	44

66	97	- The -require and -load-vernac-object command-line options now take a logical
67	98	path of a given library rather than a physical path, thus they behave like
68	99	Require [Import] path.
	100	- The -vm command-line option has been removed.
	101
	102	Standard Library
	103
	104	- There is now a Coq.Compat.Coq84 library, which sets the various compatibility
	105	options and does a few redefinitions to make Coq behave more like Coq v8.4.
	106	The standard way of putting Coq in v8.4 compatibility mode is to pass the command
	107	line flags "-require Coq.Compat.Coq84 -compat 8.4".
69	108
70	109	Changes from V8.5beta1 to V8.5beta2
71	110	===================================

74	113
75	114	- The VM now supports inductive types with up to 8388851 non-constant
76	115	constructors and up to 8388607 constant ones.
	116
	117	Specification language
	118
	119	- Syntax "$(tactic)$" changed to "ltac: tactic".
77	120
78	121	Tactics
79	122

99	142
100	143	- The interface of [change] has changed to take a [change_arg], which
101	144	can be built from a [constr] using [make_change_arg].
102		- [pattern_of_constr] now returns a triplet including the cleaned-up
103		[evar_map], removing the evars that were turned into metas.
104	145
105	146	Changes from V8.4 to V8.5beta1
106	147	==============================

396	437	- "Solve Obligations using" changed to "Solve Obligations with",
397	438	consistent with "Proof with".
398	439	- Program Lemma, Definition now respect automatic introduction.
	440	- Program Lemma, Definition, etc.. now interpret "->" like Lemma and
	441	Definition as a non-dependent arrow (potential source of
	442	incompatibility).
399	443	- Add/document "Set Hide Obligations" (to hide obligations in the final
400	444	term inside an implicit argument) and "Set Shrink Obligations" (to
401	445	minimize dependencies of obligations defined by tactics).

452	496	documentation of OCaml's Str module for the supported syntax.
453	497	- Many CoqIDE windows, including the query one, are now detachable to
454	498	improve usability on multi screen work stations.
455
456	499	- Coqtop/coqc outputs highlighted syntax. Colors can be configured thanks
457	500	to the COQ_COLORS environment variable, and their current state can
458	501	be displayed with the -list-tags command line option.
459
460	502	- Third party user interfaces can install their main loop in $COQLIB/toploop
461	503	and call coqtop with the -toploop flag to select it.
462	504

+2

-2

INSTALL.doc less more

21	21	- dvips
22	22	- bibtex
23	23	- makeindex
24		- fig2dev
25		- convert
	24	- fig2dev (transfig)
	25	- convert (ImageMagick)
26	26	- hevea
27	27	- hacha
28	28

+10

-9

Makefile.build less more

131	131	SYSCMA:=$(addsuffix .cma,$(SYSMOD))
132	132	SYSCMXA:=$(addsuffix .cmxa,$(SYSMOD))
133	133
	134	# We do not repeat the dependencies already in SYSMOD here
134	135	ifeq ($(CAMLP4),camlp5)
135	136	P4CMA:=gramlib.cma
136	137	else
137		P4CMA:=dynlink.cma camlp4lib.cma
	138	P4CMA:=camlp4lib.cma
138	139	endif
139	140
140	141

293	294	# Csdp to micromega special targets
294	295	###########################################################################
295	296
296		plugins/micromega/csdpcert$(EXE): $(CSDPCERTCMO:.cmo=$(BESTOBJ))
297		$(SHOW)'OCAMLBEST -o $@'
298		$(HIDE)$(call bestocaml,,nums unix)
	297	plugins/micromega/csdpcert$(EXE): $(CSDPCERTCMO:.cmo=$(BESTOBJ)) \
	298	$(addsuffix $(BESTLIB), lib/clib)
	299	$(SHOW)'OCAMLBEST -o $@'
	300	$(HIDE)$(call bestocaml,,nums unix clib)
299	301
300	302	###########################################################################
301	303	# CoqIde special targets

493	495	test-suite: world $(ALLSTDLIB).v
494	496	$(MAKE) $(MAKE_TSOPTS) clean
495	497	$(MAKE) $(MAKE_TSOPTS) all
496		$(HIDE)if grep -F 'Error!' test-suite/summary.log ; then false; fi
	498	$(MAKE) $(MAKE_TSOPTS) report
497	499
498	500	##################################################################
499	501	# partial targets: 1) core ML parts

552	554	structures: $(STRUCTURESVO)
553	555	vectors: $(VECTORSVO)
554	556	msets: $(MSETSVO)
555		mmaps: $(MMAPSVO)
556	557	compat: $(COMPATVO)
557	558
558	559	noreal: unicode logic arith bool zarith qarith lists sets fsets \

585	586	###########################################################################
586	587
587	588	theories/Init/%.vo theories/Init/%.glob: theories/Init/%.v $(VO_TOOLS_DEP) \| theories/Init/%.v.d
588		$(SHOW)'COQC -noinit $<'
	589	$(SHOW)'COQC $(COQ_XML) -noinit $<'
589	590	$(HIDE)rm -f theories/Init/$*.glob
590		$(HIDE)$(BOOTCOQC) $< -noinit -R theories Coq
	591	$(HIDE)$(BOOTCOQC) $< $(COQ_XML) -noinit -R theories Coq
591	592
592	593	theories/Numbers/Natural/BigN/NMake_gen.v: theories/Numbers/Natural/BigN/NMake_gen.ml
593	594	$(OCAML) $< $(TOTARGET)

881	882	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -thread $(SYSCMA) $(P4CMA) $^ -o test-printer
882	883	@rm -f test-printer
883	884	$(SHOW)'OCAMLC -a $@'
884		$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -thread $(SYSCMA) $^ -linkall -a -o $@
	885	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -thread $(SYSCMA) $(P4CMA) $^ -linkall -a -o $@
885	886
886	887	grammar/grammar.cma: \| grammar/grammar.mllib.d
887	888	$(SHOW)'Testing $@'

+1

-2

Makefile.common less more

292	292	SETSVO:=$(call cat_vo_itarget, theories/Sets)
293	293	FSETSVO:=$(call cat_vo_itarget, theories/FSets)
294	294	MSETSVO:=$(call cat_vo_itarget, theories/MSets)
295		MMAPSVO:=$(call cat_vo_itarget, theories/MMaps)
296	295	RELATIONSVO:=$(call cat_vo_itarget, theories/Relations)
297	296	WELLFOUNDEDVO:=$(call cat_vo_itarget, theories/Wellfounded)
298	297	REALSVO:=$(call cat_vo_itarget, theories/Reals)

309	308	$(RELATIONSVO) $(WELLFOUNDEDVO) $(SETOIDSVO) \
310	309	$(LISTSVO) $(STRINGSVO) \
311	310	$(PARITHVO) $(NARITHVO) $(ZARITHVO) \
312		$(SETSVO) $(FSETSVO) $(MSETSVO) $(MMAPSVO) \
	311	$(SETSVO) $(FSETSVO) $(MSETSVO) \
313	312	$(REALSVO) $(SORTINGVO) $(QARITHVO) \
314	313	$(NUMBERSVO) $(STRUCTURESVO) $(VECTORSVO) \
315	314	$(COMPATVO)

+1

-1

checker/check.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

checker/check.mllib less more

16	16	Control
17	17	Pp_control
18	18	Loc
	19	CList
	20	CString
19	21	Serialize
20	22	Stateid
21	23	Feedback

24	26	Unicodetable
25	27	Unicode
26	28	CObj
27		CList
28		CString
29	29	CArray
30	30	CStack
31	31	Util

+1

-1

checker/check_stat.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/check_stat.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/checker.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/cic.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/closure.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/closure.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/indtypes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/indtypes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/inductive.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/inductive.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/mod_checking.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/modops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/modops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/print.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/reduction.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/reduction.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/safe_typing.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/safe_typing.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/subtyping.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/subtyping.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/term.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/type_errors.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/type_errors.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/typeops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/typeops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

checker/univ.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

checker/univ.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

129	129	(** {6 Support for universe polymorphism } *)
130	130
131	131	(** Polymorphic maps from universe levels to 'a *)
132		module LMap : Map.S with type key = universe_level
	132	module LMap : CSig.MapS with type key = universe_level
133	133	module LSet : CSig.SetS with type elt = universe_level
134	134	type 'a universe_map = 'a LMap.t
135	135

+1

-1

checker/validate.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

checker/values.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

12	12	To ensure this file is up-to-date, 'make' now compares the md5 of cic.mli
13	13	with a copy we maintain here:
14	14
15		MD5 76312d06933f47498a1981a6261c9f75 checker/cic.mli
	15	MD5 7c050ff1db22f14ee3a4c44aae533082 checker/cic.mli
16	16
17	17	*)
18	18

+1

-1

checker/votour.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

config/coq_config.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-4

configure.ml less more

10	10	#load "str.cma"
11	11	open Printf
12	12
13		let coq_version = "8.5beta3"
14		let coq_macos_version = "8.4.93" (** "[...] should be a string comprised of
	13	let coq_version = "8.5"
	14	let coq_macos_version = "8.5.0" (** "[...] should be a string comprised of
15	15	three non-negative, period-separed integers [...]" *)
16		let vo_magic = 8493
17		let state_magic = 58503
	16	let vo_magic = 8500
	17	let state_magic = 58500
18	18	let distributed_exec = ["coqtop";"coqc";"coqchk";"coqdoc";"coqmktop";"coqworkmgr";
19	19	"coqdoc";"coq_makefile";"coq-tex";"gallina";"coqwc";"csdpcert";"coqdep"]
20	20

+0

-2

dev/db less more

0		load_printer "gramlib.cma"
1		load_printer "str.cma"
2	0	load_printer "printers.cma"
3	1
4	2	install_printer Top_printers.ppfuture

+1

-1

dev/db_printers.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-4

dev/doc/README-V1-V5 less more

0	0
1	1	Notes on the prehistory of Coq
2	2
3		This archive contains the sources of the CONSTR ancestor of the Coq proof
4		assistant. CONSTR, then Coq, was designed and implemented in the Formel team,
5		joint between the INRIA Rocquencourt laboratory and the Ecole Normale Supérieure
6		of Paris, from 1984 onwards.
	3	This document is a copy within the Coq archive of a document written
	4	in September 2015 by Gérard Huet, Thierry Coquand and Christine Paulin
	5	to accompany their public release of the archive of versions 1.10 to 6.2
	6	of Coq and of its CONSTR ancestor. CONSTR, then Coq, was designed and
	7	implemented in the Formel team, joint between the INRIA Rocquencourt
	8	laboratory and the Ecole Normale Supérieure of Paris, from 1984
	9	onwards.
7	10
8	11	Version 1
9	12

+1

-0

dev/doc/versions-history.tex less more

222	222	Coq ``V6'' archive & 20 March 1996 & new cvs repository on pauillac.inria.fr with code ported \\
223	223	& & to Caml Special Light (to later become Objective Caml)\\
224	224	& & has implicit arguments and coercions\\
	225	& & has coinductive types\\
225	226
226	227	Coq V6.1beta& released 18 November 1996 & \feature{coercions} [23-5-1996], \feature{user-level implicit arguments} [23-5-1996]\\
227	228	& & \feature{omega} [10-9-1996] \\

+1

-1

dev/header less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+31

-0

dev/make-macos-dmg.sh less more

	0	#!/bin/bash
	1
	2	# Fail on first error
	3	set -e
	4
	5	# Configuration setup
	6	eval `opam config env`
	7	make distclean
	8	OUTDIR=$PWD/_install
	9	DMGDIR=$PWD/_dmg
	10	./configure -debug -prefix $OUTDIR
	11	VERSION=$(sed -n -e '/^let coq_version/ s/^[^"]"$[^"]$"$/\1/p' configure.ml)
	12	APP=bin/CoqIDE_${VERSION}.app
	13
	14	# Create a .app file with CoqIDE
	15	~/.local/bin/jhbuild run make -j -l2 $APP
	16
	17	# Build Coq and run test-suite
	18	make && make check
	19
	20	# Add Coq to the .app file
	21	make OLDROOT=$OUTDIR COQINSTALLPREFIX=$APP/Contents/Resources/ install-coq install-ide-toploop
	22
	23	# Sign the .app file
	24	codesign -f -s - $APP
	25
	26	# Create the dmg bundle
	27	mkdir -p $DMGDIR
	28	ln -sf /Applications $DMGDIR/Applications
	29	cp -r $APP $DMGDIR
	30	hdiutil create -imagekey zlib-level=9 -volname CoqIDE_$VERSION -srcfolder $DMGDIR -ov -format UDZO CoqIDE_$VERSION.dmg

+5

-5

dev/printers.mllib less more

15	15	IStream
16	16	Pp_control
17	17	Loc
	18	CList
	19	CString
18	20	Compat
19	21	Flags
20	22	Control

27	29	Unicodetable
28	30	Unicode
29	31	CObj
30		CList
31		CString
32	32	CArray
33	33	CStack
34	34	Util

159	159	Constrexpr_ops
160	160	Genintern
161	161	Notation_ops
162		Topconstr
163	162	Notation
164	163	Dumpglob
	164	Syntax_def
	165	Smartlocate
	166	Topconstr
165	167	Reserve
166	168	Impargs
167		Syntax_def
168	169	Implicit_quantifiers
169		Smartlocate
170	170	Constrintern
171	171	Modintern
172	172	Constrextern

+1

-1

dev/top_printers.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

dev/v8-syntax/syntax-v8.tex less more

80	80	$\GR{~}$ from the terminals $\ETERM{( )}$, and $\mid$ from terminal
81	81	\TERMbar.
82	82
83		Rules are optionaly annotated in the right margin with:
	83	Rules are optionally annotated in the right margin with:
84	84	\begin{itemize}
85	85	\item a precedence and associativity (L for left, R for right and N for no associativity), indicating how to solve conflicts;
86	86	lower levels are tighter;

+1

-7

doc/stdlib/index-list.html.template less more

475	475	theories/MSets/MSetPositive.v
476	476	theories/MSets/MSetToFiniteSet.v
477	477	(theories/MSets/MSets.v)
478		theories/MMaps/MMapAVL.v
479		theories/MMaps/MMapFacts.v
480		theories/MMaps/MMapInterface.v
481		theories/MMaps/MMapList.v
482		theories/MMaps/MMapPositive.v
483		theories/MMaps/MMapWeakList.v
484		(theories/MMaps/MMaps.v)
485	478	</dd>
486	479
487	480	<dt> <b>FSets</b>:

616	609	Compatibility wrappers for previous versions of Coq
617	610	</dt>
618	611	<dd>
	612	theories/Compat/AdmitAxiom.v
619	613	theories/Compat/Coq84.v
620	614	theories/Compat/Coq85.v
621	615	</dd>

+1

-1

grammar/argextend.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

grammar/grammar.mllib less more

15	15	Pp_control
16	16	Flags
17	17	Loc
	18	CList
	19	CString
18	20	Serialize
19	21	Stateid
20	22	Feedback
21	23	Pp
22	24
23		CList
24		CString
25	25	CArray
26	26	CStack
27	27	Util

+1

-1

grammar/q_constr.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

grammar/q_coqast.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

grammar/q_util.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

grammar/q_util.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

grammar/tacextend.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

grammar/vernacextend.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/MacOS/Info.plist.template less more

65	65	<key>CFBundleGetInfoString</key>
66	66	<string>Coq_vVERSION</string>
67	67	<key>NSHumanReadableCopyright</key>
68		<string>Copyright 1999-2015, The Coq Development Team INRIA - CNRS - LIX - LRI - PPS</string>
	68	<string>Copyright 1999-2016, The Coq Development Team INRIA - CNRS - LIX - LRI - PPS</string>
69	69	<key>CFBundleHelpBookFolder</key>
70	70	<string>share/doc/coq/html/</string>
71	71	<key>CFAppleHelpAnchor</key>

+1

-1

ide/config_lexer.mll less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coq.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coq.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coqOps.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coqOps.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coq_commands.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coq_lex.mll less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coqide.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coqide.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/coqide_main.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/fileOps.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/fileOps.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/gtk_parsing.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/ide_slave.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/ideutils.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/ideutils.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/interface.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/nanoPG.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+13

-29

ide/preferences.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

710	710	~f:(fun s -> current.project_file_name <- s)
711	711	current.project_file_name
712	712	in
713		let update_modifiers prefix mds =
714		let change ~path ~key ~modi ~changed =
715		if CString.is_sub prefix path 0 then
716		ignore (GtkData.AccelMap.change_entry ~key ~modi:mds ~replace:true path)
717		in
718		GtkData.AccelMap.foreach change
719		in
720	713	let help_string =
721	714	"restart to apply"
722	715	in
723	716	let the_valid_mod = str_to_mod_list current.modifiers_valid in
724	717	let modifier_for_tactics =
725		let cb l =
726		current.modifier_for_tactics <- mod_list_to_str l;
727		update_modifiers "<Actions>/Tactics/" l
728		in
729	718	modifiers
730	719	~allow:the_valid_mod
731		~f:cb
	720	~f:(fun l -> current.modifier_for_tactics <- mod_list_to_str l)
732	721	~help:help_string
733	722	"Modifiers for Tactics Menu"
734	723	(str_to_mod_list current.modifier_for_tactics)
735	724	in
736	725	let modifier_for_templates =
737		let cb l =
738		current.modifier_for_templates <- mod_list_to_str l;
739		update_modifiers "<Actions>/Templates/" l
740		in
741	726	modifiers
742	727	~allow:the_valid_mod
743		~f:cb
	728	~f:(fun l -> current.modifier_for_templates <- mod_list_to_str l)
744	729	~help:help_string
745	730	"Modifiers for Templates Menu"
746	731	(str_to_mod_list current.modifier_for_templates)
747	732	in
748	733	let modifier_for_navigation =
749		let cb l =
750		current.modifier_for_navigation <- mod_list_to_str l;
751		update_modifiers "<Actions>/Navigation/" l
752		in
753	734	modifiers
754	735	~allow:the_valid_mod
755		~f:cb
	736	~f:(fun l -> current.modifier_for_navigation <- mod_list_to_str l)
756	737	~help:help_string
757	738	"Modifiers for Navigation Menu"
758	739	(str_to_mod_list current.modifier_for_navigation)
759	740	in
760	741	let modifier_for_display =
761		let cb l =
762		current.modifier_for_display <- mod_list_to_str l;
763		update_modifiers "<Actions>/View/" l
764		in
765	742	modifiers
766	743	~allow:the_valid_mod
767		~f:cb
	744	~f:(fun l -> current.modifier_for_display <- mod_list_to_str l)
768	745	~help:help_string
769	746	"Modifiers for View Menu"
770	747	(str_to_mod_list current.modifier_for_display)

775	752	current.modifiers_valid <- mod_list_to_str l)
776	753	"Allowed modifiers"
777	754	the_valid_mod
	755	in
	756	let modifier_notice =
	757	let b = GPack.hbox () in
	758	let _lbl =
	759	GMisc.label ~markup:"You need to <b>restart CoqIDE</b> after changing these settings"
	760	~packing:b#add () in
	761	custom b (fun () -> ()) true
778	762	in
779	763	let cmd_editor =
780	764	let predefined = [ "emacs %s"; "vi %s"; "NOTEPAD %s" ] in

877	861	[automatic_tactics]);
878	862	Section("Shortcuts", Some `PREFERENCES,
879	863	[modifiers_valid; modifier_for_tactics;
880		modifier_for_templates; modifier_for_display; modifier_for_navigation]);
	864	modifier_for_templates; modifier_for_display; modifier_for_navigation; modifier_notice]);
881	865	Section("Misc", Some `ADD,
882	866	misc)]
883	867	in

+1

-1

ide/preferences.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+6

-1

ide/project_file.ml4 less more

27	27	and parse_string2 = parser
28	28	\| [< ''"' >] -> ""
29	29	\| [< 'c; s >] -> (String.make 1 c)^(parse_string2 s)
	30	\| [< >] -> raise Parsing_error
30	31	and parse_skip_comment = parser
31	32	\| [< ''\n'; s >] -> s
32	33	\| [< 'c; s >] -> parse_skip_comment s

46	47	res
47	48
48	49	let rec process_cmd_line orig_dir ((project_file,makefile,install,opt) as opts) l = function
49		\| [] -> opts,List.rev l
	50	\| [] -> opts, l
50	51	\| ("-h"\|"--help") :: _ ->
51	52	raise Parsing_error
52	53	\| ("-no-opt"\|"-byte") :: r ->

126	127	else if (Filename.check_suffix f ".mlpack") then MLPACK f
127	128	else Subdir f) :: l) r
128	129
	130	let process_cmd_line orig_dir opts l args =
	131	let (opts, l) = process_cmd_line orig_dir opts l args in
	132	opts, List.rev l
	133
129	134	let rec post_canonize f =
130	135	if Filename.basename f = Filename.current_dir_name
131	136	then let dir = Filename.dirname f in

+1

-1

ide/sentence.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/sentence.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/session.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/session.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/tags.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/tags.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/utf8_convert.mll less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Command.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Command.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Completion.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Completion.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Detachable.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Detachable.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Find.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Find.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_MessageView.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_MessageView.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Notebook.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Notebook.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_ProofView.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_ProofView.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_ScriptView.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_ScriptView.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Segment.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/wg_Segment.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/xmlprotocol.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

ide/xmlprotocol.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/constrarg.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/constrarg.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/constrexpr_ops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/constrexpr_ops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+13

-4

interp/constrextern.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

146	146	For instance, in the debugger the tables of global references
147	147	may be inaccurate *)
148	148
	149	let safe_shortest_qualid_of_global vars r =
	150	try shortest_qualid_of_global vars r
	151	with Not_found ->
	152	match r with
	153	\| VarRef v -> make_qualid DirPath.empty v
	154	\| ConstRef c -> make_qualid DirPath.empty Names.(Label.to_id (con_label c))
	155	\| IndRef (i,_) \| ConstructRef ((i,_),_) ->
	156	make_qualid DirPath.empty Names.(Label.to_id (mind_label i))
	157
149	158	let default_extern_reference loc vars r =
150		Qualid (loc,shortest_qualid_of_global vars r)
	159	Qualid (loc,safe_shortest_qualid_of_global vars r)
151	160
152	161	let my_extern_reference = ref default_extern_reference
153	162

437	446	\| Some r when not !Flags.in_debugger && not !Flags.raw_print && !print_projections ->
438	447	(try
439	448	let n = Recordops.find_projection_nparams r + 1 in
440		if n <= nargs then None
441		else Some n
	449	if n <= nargs then Some n
	450	else None
442	451	with Not_found -> None)
443	452	\| _ -> None
444	453

+1

-1

interp/constrextern.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

interp/constrintern.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

316	316	let build_impls = function
317	317	\|Implicit -> (function
318	318	\|Name id -> Some (id, Impargs.Manual, (true,true))
319		\|Anonymous -> anomaly (Pp.str "Anonymous implicit argument"))
	319	\|Anonymous -> Some (Id.of_string "_", Impargs.Manual, (true,true)))
320	320	\|Explicit -> fun _ -> None
321	321
322	322	let impls_type_list ?(args = []) =

+1

-1

interp/constrintern.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/coqlib.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/coqlib.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+6

-3

interp/dumpglob.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

138	138	loc1, loc2-1
139	139
140	140	let dump_ref loc filepath modpath ident ty =
141		if !glob_output = Feedback then
	141	match !glob_output with
	142	\| Feedback ->
142	143	Pp.feedback (Feedback.GlobRef (loc, filepath, modpath, ident, ty))
143		else
	144	\| NoGlob -> ()
	145	\| _ when not (Loc.is_ghost loc) ->
144	146	let bl,el = interval loc in
145	147	dump_string (Printf.sprintf "R%d:%d %s %s %s %s\n"
146	148	bl el filepath modpath ident ty)
	149	\| _ -> ()
147	150
148	151	let dump_reference loc modpath ident ty =
149	152	let filepath = Names.DirPath.to_string (Lib.library_dp ()) in

+1

-1

interp/dumpglob.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/genintern.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/genintern.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/implicit_quantifiers.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/implicit_quantifiers.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/interp.mllib less more

2	2	Genintern
3	3	Constrexpr_ops
4	4	Notation_ops
5		Topconstr
6	5	Ppextend
7	6	Notation
8	7	Dumpglob
9	8	Syntax_def
10	9	Smartlocate
	10	Topconstr
11	11	Reserve
12	12	Impargs
13	13	Implicit_quantifiers

+1

-1

interp/modintern.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/modintern.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/notation.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/notation.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/notation_ops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/notation_ops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/ppextend.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/ppextend.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/reserve.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/reserve.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/smartlocate.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/smartlocate.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/stdarg.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/stdarg.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/syntax_def.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

interp/syntax_def.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+21

-25

interp/topconstr.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

37	37	(**********************************************************************)
38	38	(* Functions on constr_expr *)
39	39
40		let ids_of_cases_indtype =
41		let rec vars_of ids = function
42		(* We deal only with the regular cases *)
43		\| (CPatCstr (_,_,l1,l2)\|CPatNotation (_,_,(l1,[]),l2)) ->
44		List.fold_left vars_of (List.fold_left vars_of [] l2) l1
45		(* assume the ntn is applicative and does not instantiate the head !! *)
46		\| CPatDelimiters(_,_,c) -> vars_of ids c
47		\| CPatAtom (_, Some (Libnames.Ident (_, x))) -> x::ids
48		\| _ -> ids in
49		vars_of []
50
51		let ids_of_cases_tomatch tms =
52		List.fold_right
53		(fun (_,(ona,indnal)) l ->
54		Option.fold_right (fun t -> (@) (ids_of_cases_indtype t))
55		indnal (Option.fold_right (Loc.down_located name_cons) ona l))
56		tms []
57
58	40	let is_constructor id =
59		try ignore (Nametab.locate_extended (qualid_of_ident id)); true
60		with Not_found -> true
	41	try Globnames.isConstructRef
	42	(Smartlocate.global_of_extended_global
	43	(Nametab.locate_extended (qualid_of_ident id)))
	44	with Not_found -> false
61	45
62	46	let rec cases_pattern_fold_names f a = function
63	47	\| CPatRecord (_, l) ->

80	64	(Loc.located_fold_left
81	65	(List.fold_left (cases_pattern_fold_names Id.Set.add)))
82	66	Id.Set.empty
	67
	68	let ids_of_cases_indtype p =
	69	Id.Set.elements (cases_pattern_fold_names Id.Set.add Id.Set.empty p)
	70
	71	let ids_of_cases_tomatch tms =
	72	List.fold_right
	73	(fun (_,(ona,indnal)) l ->
	74	Option.fold_right (fun t ids -> cases_pattern_fold_names Id.Set.add ids t)
	75	indnal
	76	(Option.fold_right (Loc.down_located (name_fold Id.Set.add)) ona l))
	77	tms Id.Set.empty
83	78
84	79	let rec fold_constr_expr_binders g f n acc b = function
85	80	\| (nal,bk,t)::l ->

118	113	\| CRecord (loc,_,l) -> List.fold_left (fun acc (id, c) -> f n acc c) acc l
119	114	\| CCases (loc,sty,rtnpo,al,bl) ->
120	115	let ids = ids_of_cases_tomatch al in
121		let acc = Option.fold_left (f (List.fold_right g ids n)) acc rtnpo in
	116	let acc = Option.fold_left (f (Id.Set.fold g ids n)) acc rtnpo in
122	117	let acc = List.fold_left (f n) acc (List.map fst al) in
123	118	List.fold_right (fun (loc,patl,rhs) acc ->
124	119	let ids = ids_of_pattern_list patl in

219	214	\| CPrim _ \| CRef _ as x -> x
220	215	\| CRecord (loc,p,l) -> CRecord (loc,p,List.map (fun (id, c) -> (id, f e c)) l)
221	216	\| CCases (loc,sty,rtnpo,a,bl) ->
222		(* TODO: apply g on the binding variables in pat... *)
223		let bl = List.map (fun (loc,pat,rhs) -> (loc,pat,f e rhs)) bl in
	217	let bl = List.map (fun (loc,patl,rhs) ->
	218	let ids = ids_of_pattern_list patl in
	219	(loc,patl,f (Id.Set.fold g ids e) rhs)) bl in
224	220	let ids = ids_of_cases_tomatch a in
225		let po = Option.map (f (List.fold_right g ids e)) rtnpo in
	221	let po = Option.map (f (Id.Set.fold g ids e)) rtnpo in
226	222	CCases (loc, sty, po, List.map (fun (tm,x) -> (f e tm,x)) a,bl)
227	223	\| CLetTuple (loc,nal,(ona,po),b,c) ->
228	224	let e' = List.fold_right (Loc.down_located (name_fold g)) nal e in

+1

-1

interp/topconstr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/constrexpr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/decl_kinds.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/evar_kinds.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/extend.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/genredexpr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/glob_term.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/locus.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/misctypes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/notation_term.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

intf/pattern.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

intf/tacexpr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

135	135	\| TacIntroMove of Id.t option * 'nam move_location
136	136	\| TacExact of 'trm
137	137	\| TacApply of advanced_flag * evars_flag * 'trm with_bindings_arg list *
138		(clear_flag * 'nam * 'dtrm intro_pattern_expr located option) option
	138	('nam * 'dtrm intro_pattern_expr located option) option
139	139	\| TacElim of evars_flag * 'trm with_bindings_arg * 'trm with_bindings option
140	140	\| TacCase of evars_flag * 'trm with_bindings_arg
141	141	\| TacFix of Id.t option * int

+1

-1

intf/vernacexpr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/cbytecodes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/cbytecodes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

kernel/cbytegen.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

174	174	let push_param n sz r =
175	175	{ r with
176	176	nb_stack = r.nb_stack + n;
177		in_stack = add_param n (sz - r.nb_uni_stack) r.in_stack }
	177	in_stack = add_param n sz r.in_stack }
178	178
179	179	(* [push_local sz r] add a new variable on the stack at position [sz] *)
180	180	let push_local sz r =

+1

-1

kernel/cemitcodes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

kernel/closure.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

770	770	(* we know that n < stack_args_size(argstk) (if well-typed term) *)
771	771	anomaly (Pp.str "ill-typed term: found a match on a partially applied constructor")
772	772
773		(** [eta_expand_ind_stack env ind c s t] computes stacks correspoding
	773	(** [eta_expand_ind_stack env ind c s t] computes stacks corresponding
774	774	to the conversion of the eta expansion of t, considered as an inhabitant
775	775	of ind, and the Constructor c of this inductive type applied to arguments
776	776	s.

+1

-1

kernel/closure.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/constr.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/constr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/context.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/context.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/conv_oracle.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/conv_oracle.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/cooking.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/cooking.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/csymtable.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/csymtable.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+17

-8

kernel/declarations.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

237	237	{ mod_mp : module_path; (** absolute path of the module *)
238	238	mod_expr : module_implementation; (** implementation *)
239	239	mod_type : module_signature; (** expanded type *)
240		(** algebraic type, kept if it's relevant for extraction *)
241		mod_type_alg : module_expression option;
242		(** set of all universes constraints in the module *)
243		mod_constraints : Univ.ContextSet.t;
244		(** quotiented set of equivalent constants and inductive names *)
245		mod_delta : Mod_subst.delta_resolver;
	240	mod_type_alg : module_expression option; (** algebraic type *)
	241	mod_constraints : Univ.ContextSet.t; (**
	242	set of all universes constraints in the module *)
	243	mod_delta : Mod_subst.delta_resolver; (**
	244	quotiented set of equivalent constants and inductive names *)
246	245	mod_retroknowledge : Retroknowledge.action list }
	246
	247	(** For a module, there are five possible situations:
	248	- [Declare Module M : T] then [mod_expr = Abstract; mod_type_alg = Some T]
	249	- [Module M := E] then [mod_expr = Algebraic E; mod_type_alg = None]
	250	- [Module M : T := E] then [mod_expr = Algebraic E; mod_type_alg = Some T]
	251	- [Module M. ... End M] then [mod_expr = FullStruct; mod_type_alg = None]
	252	- [Module M : T. ... End M] then [mod_expr = Struct; mod_type_alg = Some T]
	253	And of course, all these situations may be functors or not. *)
247	254
248	255	(** A [module_type_body] is just a [module_body] with no
249	256	implementation ([mod_expr] always [Abstract]) and also
250		an empty [mod_retroknowledge] *)
	257	an empty [mod_retroknowledge]. Its [mod_type_alg] contains
	258	the algebraic definition of this module type, or [None]
	259	if it has been built interactively. *)
251	260
252	261	and module_type_body = module_body
253	262

+1

-1

kernel/declareops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/declareops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/entries.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/environ.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/environ.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/esubst.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/esubst.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/evar.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/evar.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-4

kernel/fast_typeops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

32	32	if Environ.check_constraints cst env then ()
33	33	else error_unsatisfied_constraints env cst
34	34
35		(* This should be a type (a priori without intension to be an assumption) *)
	35	(* This should be a type (a priori without intention to be an assumption) *)
36	36	let type_judgment env c t =
37	37	match kind_of_term(whd_betadeltaiota env t) with
38	38	\| Sort s -> {utj_val = c; utj_type = s }

51	51	error_assumption env (make_judge t ty)
52	52
53	53	(************************************************)
54		(* Incremental typing rules: builds a typing judgement given the *)
55		(* judgements for the subterms. *)
	54	(* Incremental typing rules: builds a typing judgment given the *)
	55	(* judgments for the subterms. *)
56	56
57	57	(s Type of sorts )
58	58

+1

-1

kernel/fast_typeops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+48

-25

kernel/indtypes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

111	111	\| [] -> (* type without constructors *) true
112	112	\| _ -> false
113	113
114		let infos_and_sort env ctx t =
115		let rec aux env ctx t max =
	114	let infos_and_sort env t =
	115	let rec aux env t max =
116	116	let t = whd_betadeltaiota env t in
117	117	match kind_of_term t with
118	118	\| Prod (name,c1,c2) ->
119	119	let varj = infer_type env c1 in
120	120	let env1 = Environ.push_rel (name,None,varj.utj_val) env in
121	121	let max = Universe.sup max (univ_of_sort varj.utj_type) in
122		aux env1 ctx c2 max
	122	aux env1 c2 max
123	123	\| _ when is_constructor_head t -> max
124	124	\| _ -> (* don't fail if not positive, it is tested later *) max
125		in aux env ctx t Universe.type0m
	125	in aux env t Universe.type0m
126	126
127	127	(* Computing the levels of polymorphic inductive types
128	128

147	147	(* This (re)computes informations relevant to extraction and the sort of an
148	148	arity or type constructor; we do not to recompute universes constraints *)
149	149
150		let infer_constructor_packet env_ar_par ctx params lc =
	150	let infer_constructor_packet env_ar_par params lc =
151	151	(* type-check the constructors *)
152	152	let jlc = List.map (infer_type env_ar_par) lc in
153	153	let jlc = Array.of_list jlc in
154	154	(* generalize the constructor over the parameters *)
155	155	let lc'' = Array.map (fun j -> it_mkProd_or_LetIn j.utj_val params) jlc in
156	156	(* compute the max of the sorts of the products of the constructors types *)
157		let levels = List.map (infos_and_sort env_ar_par ctx) lc in
	157	let levels = List.map (infos_and_sort env_ar_par) lc in
158	158	let isunit = is_unit levels in
159	159	let min = if Array.length jlc > 1 then Universe.type0 else Universe.type0m in
160	160	let level = List.fold_left (fun max l -> Universe.sup max l) min levels in

260	260	List.fold_right2
261	261	(fun ind arity_data inds ->
262	262	let (lc',cstrs_univ) =
263		infer_constructor_packet env_ar_par ContextSet.empty
264		params ind.mind_entry_lc in
	263	infer_constructor_packet env_ar_par params ind.mind_entry_lc in
265	264	let consnames = ind.mind_entry_consnames in
266	265	let ind' = (arity_data,consnames,lc',cstrs_univ) in
267	266	ind'::inds)

336	335	type ill_formed_ind =
337	336	\| LocalNonPos of int
338	337	\| LocalNotEnoughArgs of int
339		\| LocalNotConstructor
	338	\| LocalNotConstructor of rel_context * constr list
340	339	\| LocalNonPar of int * int * int
341	340
342	341	exception IllFormedInd of ill_formed_ind

347	346
348	347	let mind_extract_params = decompose_prod_n_assum
349	348
350		let explain_ind_err id ntyp env nbpar c nargs err =
	349	let explain_ind_err id ntyp env nbpar c err =
351	350	let (lpar,c') = mind_extract_params nbpar c in
352	351	match err with
353	352	\| LocalNonPos kt ->

355	354	\| LocalNotEnoughArgs kt ->
356	355	raise (InductiveError
357	356	(NotEnoughArgs (env,c',mkRel (kt+nbpar))))
358		\| LocalNotConstructor ->
	357	\| LocalNotConstructor (paramsctxt,args)->
	358	let nparams = rel_context_nhyps paramsctxt in
359	359	raise (InductiveError
360		(NotConstructor (env,id,c',mkRel (ntyp+nbpar),nbpar,nargs)))
	360	(NotConstructor (env,id,c',mkRel (ntyp+nbpar),nparams,
	361	List.length args - nparams)))
361	362	\| LocalNonPar (n,i,l) ->
362	363	raise (InductiveError
363	364	(NonPar (env,c',n,mkRel i, mkRel (l+nbpar))))

546	547	begin match hd with
547	548	\| Rel j when Int.equal j (n + ntypes - i - 1) ->
548	549	check_correct_par ienv hyps (ntypes - i) largs
549		\| _ -> raise (IllFormedInd LocalNotConstructor)
	550	\| _ -> raise (IllFormedInd (LocalNotConstructor(hyps,largs)))
550	551	end
551	552	else
552	553	if not (List.for_all (noccur_between n ntypes) largs)

562	563	try
563	564	check_constructors ienv true nmr rawc
564	565	with IllFormedInd err ->
565		explain_ind_err id (ntypes-i) env lparams c nargs err)
	566	explain_ind_err id (ntypes-i) env lparams c err)
566	567	(Array.of_list lcnames) indlc
567	568	in
568	569	let irecargs = Array.map snd irecargs_nmr

651	652	that typechecking projections requires just a substitution and not
652	653	matching with a parameter context. *)
653	654	let indty, paramsletsubst =
654		let subst, inst =
	655	let _, _, subst, inst =
655	656	List.fold_right
656		(fun (na, b, t) (subst, inst) ->
	657	(fun (na, b, t) (i, j, subst, inst) ->
657	658	match b with
658		\| None -> (mkRel 1 :: List.map (lift 1) subst,
659		mkRel 1 :: List.map (lift 1) inst)
660		\| Some b -> (substl subst b) :: subst, List.map (lift 1) inst)
661		paramslet ([], [])
	659	\| None -> (i-1, j-1, mkRel i :: subst, mkRel j :: inst)
	660	\| Some b -> (i, j-1, substl subst b :: subst, inst))
	661	paramslet (nparamargs, List.length paramslet, [], [])
662	662	in
663	663	let subst = (* For the record parameter: *)
664	664	mkRel 1 :: List.map (lift 1) subst

688	688	in
689	689	let projections (na, b, t) (i, j, kns, pbs, subst, letsubst) =
690	690	match b with
691		\| Some c -> (i, j+1, kns, pbs, substl subst c :: subst,
692		substl letsubst c :: subst)
	691	\| Some c ->
	692	(* From [params, field1,..,fieldj \|- c(params,field1,..,fieldj)]
	693	to [params, x:I, field1,..,fieldj \|- c(params,field1,..,fieldj)] *)
	694	let c = liftn 1 j c in
	695	(* From [params, x:I, field1,..,fieldj \|- c(params,field1,..,fieldj)]
	696	to [params, x:I \|- c(params,proj1 x,..,projj x)] *)
	697	let c1 = substl subst c in
	698	(* From [params, x:I \|- subst:field1,..,fieldj]
	699	to [params, x:I \|- subst:field1,..,fieldj+1] where [subst]
	700	is represented with instance of field1 last *)
	701	let subst = c1 :: subst in
	702	(* From [params, x:I, field1,..,fieldj \|- c(params,field1,..,fieldj)]
	703	to [params-wo-let, x:I \|- c(params,proj1 x,..,projj x)] *)
	704	let c2 = substl letsubst c in
	705	(* From [params-wo-let, x:I \|- subst:(params, x:I, field1,..,fieldj)]
	706	to [params-wo-let, x:I \|- subst:(params, x:I, field1,..,fieldj+1)] *)
	707	let letsubst = c2 :: letsubst in
	708	(i, j+1, kns, pbs, subst, letsubst)
693	709	\| None ->
694	710	match na with
695	711	\| Name id ->
696	712	let kn = Constant.make1 (KerName.make mp dp (Label.of_id id)) in
697		let projty = substl letsubst (liftn 1 j t) in
698		let ty = substl subst (liftn 1 j t) in
	713	(* from [params, field1,..,fieldj \|- t(params,field1,..,fieldj)]
	714	to [params, x:I, field1,..,fieldj \|- t(params,field1,..,fieldj] *)
	715	let t = liftn 1 j t in
	716	(* from [params, x:I, field1,..,fieldj \|- t(params,field1,..,fieldj)]
	717	to [params-wo-let, x:I \|- t(params,proj1 x,..,projj x)] *)
	718	let projty = substl letsubst t in
	719	(* from [params, x:I, field1,..,fieldj \|- t(field1,..,fieldj)]
	720	to [params, x:I \|- t(proj1 x,..,projj x)] *)
	721	let ty = substl subst t in
699	722	let term = mkProj (Projection.make kn true, mkRel 1) in
700	723	let fterm = mkProj (Projection.make kn false, mkRel 1) in
701	724	let compat = compat_body ty (j - 1) in

+1

-1

kernel/indtypes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/inductive.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/inductive.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/mod_subst.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/mod_subst.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+78

-64

kernel/mod_typing.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

20	20	open Mod_subst
21	21
22	22	type 'alg translation =
23		module_signature * 'alg option * delta_resolver * Univ.ContextSet.t
	23	module_signature * 'alg * delta_resolver * Univ.ContextSet.t
24	24
25	25	let rec mp_from_mexpr = function
26	26	\| MEident mp -> mp

182	182	begin
183	183	try
184	184	let mtb_old = module_type_of_module old in
185		Univ.ContextSet.add_constraints (Subtyping.check_subtypes env' mtb_mp1 mtb_old) old.mod_constraints
186		with Failure _ -> error_incorrect_with_constraint lab
	185	let chk_cst = Subtyping.check_subtypes env' mtb_mp1 mtb_old in
	186	Univ.ContextSet.add_constraints chk_cst old.mod_constraints
	187	with Failure _ ->
	188	(* TODO: where can a Failure come from ??? *)
	189	error_incorrect_with_constraint lab
187	190	end
188	191	\| Algebraic (NoFunctor (MEident(mp'))) ->
189	192	check_modpath_equiv env' mp1 mp';

237	240	\| Not_found -> error_no_such_label lab
238	241	\| Reduction.NotConvertible -> error_incorrect_with_constraint lab
239	242
240		let mk_alg_with alg wd = Option.map (fun a -> MEwith (a,wd)) alg
241
242	243	let check_with env mp (sign,alg,reso,cst) = function
243	244	\|WithDef(idl,c) ->
244	245	let struc = destr_nofunctor sign in
245	246	let struc',c',cst' = check_with_def env struc (idl,c) mp reso in
246		let alg' = mk_alg_with alg (WithDef (idl,(c',Univ.ContextSet.to_context cst'))) in
247		(NoFunctor struc'),alg',reso, cst+++cst'
	247	let wd' = WithDef (idl,(c',Univ.ContextSet.to_context cst')) in
	248	NoFunctor struc', MEwith (alg,wd'), reso, cst+++cst'
248	249	\|WithMod(idl,mp1) as wd ->
249	250	let struc = destr_nofunctor sign in
250	251	let struc',reso',cst' = check_with_mod env struc (idl,mp1) mp reso in
251		let alg' = mk_alg_with alg wd in
252		(NoFunctor struc'),alg',reso', cst+++cst'
253
254		let mk_alg_app mpo alg arg = match mpo, alg with
255		\| Some _, Some alg -> Some (MEapply (alg,arg))
256		\| _ -> None
257
258		(** Translation of a module struct entry :
259		- We translate to a module when a [module_path] is given,
260		otherwise to a module type.
261		- The first output is the expanded signature
262		- The second output is the algebraic expression, kept for the extraction.
263		It is never None when translating to a module, but for module type
264		it could not be contain [SEBapply] or [SEBfunctor].
265		*)
266
267		let rec translate_mse env mpo inl = function
268		\|MEident mp1 ->
269		let sign,reso = match mpo with
270		\|Some mp ->
271		let mb = strengthen_and_subst_mb (lookup_module mp1 env) mp false in
272		mb.mod_type, mb.mod_delta
273		\|None ->
274		let mtb = lookup_modtype mp1 env in
275		mtb.mod_type, mtb.mod_delta
276		in
277		sign,Some (MEident mp1),reso,Univ.ContextSet.empty
278		\|MEapply (fe,mp1) ->
279		translate_apply env inl (translate_mse env mpo inl fe) mp1 (mk_alg_app mpo)
280		\|MEwith(me, with_decl) ->
281		assert (mpo == None); (* No 'with' syntax for modules *)
282		let mp = mp_from_mexpr me in
283		check_with env mp (translate_mse env None inl me) with_decl
284
285		and translate_apply env inl (sign,alg,reso,cst1) mp1 mkalg =
	252	NoFunctor struc', MEwith (alg,wd), reso', cst+++cst'
	253
	254	let translate_apply env inl (sign,alg,reso,cst1) mp1 mkalg =
286	255	let farg_id, farg_b, fbody_b = destr_functor sign in
287	256	let mtb = module_type_of_module (lookup_module mp1 env) in
288	257	let cst2 = Subtyping.check_subtypes env mtb farg_b in

294	263	let reso' = subst_codom_delta_resolver subst reso in
295	264	body,alg',reso', Univ.ContextSet.add_constraints cst2 cst1
296	265
297		let mk_alg_funct mpo mbid mtb alg = match mpo, alg with
298		\| Some _, Some alg -> Some (MoreFunctor (mbid,mtb,alg))
299		\| _ -> None
300
301		let mk_mod mp e ty ty' cst reso =
	266	(** Translation of a module struct entry :
	267	- We translate to a module when a [module_path] is given,
	268	otherwise to a module type.
	269	- The first output is the expanded signature
	270	- The second output is the algebraic expression, kept for the extraction.
	271	*)
	272
	273	let mk_alg_app alg arg = MEapply (alg,arg)
	274
	275	let rec translate_mse env mpo inl = function
	276	\|MEident mp1 as me ->
	277	let mb = match mpo with
	278	\|Some mp -> strengthen_and_subst_mb (lookup_module mp1 env) mp false
	279	\|None -> lookup_modtype mp1 env
	280	in
	281	mb.mod_type, me, mb.mod_delta, Univ.ContextSet.empty
	282	\|MEapply (fe,mp1) ->
	283	translate_apply env inl (translate_mse env mpo inl fe) mp1 mk_alg_app
	284	\|MEwith(me, with_decl) ->
	285	assert (mpo == None); (* No 'with' syntax for modules *)
	286	let mp = mp_from_mexpr me in
	287	check_with env mp (translate_mse env None inl me) with_decl
	288
	289	let mk_mod mp e ty cst reso =
302	290	{ mod_mp = mp;
303	291	mod_expr = e;
304	292	mod_type = ty;
305		mod_type_alg = ty';
	293	mod_type_alg = None;
306	294	mod_constraints = cst;
307	295	mod_delta = reso;
308	296	mod_retroknowledge = [] }
309	297
310		let mk_modtype mp ty cst reso = mk_mod mp Abstract ty None cst reso
	298	let mk_modtype mp ty cst reso = mk_mod mp Abstract ty cst reso
311	299
312	300	let rec translate_mse_funct env mpo inl mse = function
313	301	\|[] ->
314	302	let sign,alg,reso,cst = translate_mse env mpo inl mse in
315		sign, Option.map (fun a -> NoFunctor a) alg, reso, cst
	303	sign, NoFunctor alg, reso, cst
316	304	\|(mbid, ty) :: params ->
317	305	let mp_id = MPbound mbid in
318	306	let mtb = translate_modtype env mp_id inl ([],ty) in
319	307	let env' = add_module_type mp_id mtb env in
320	308	let sign,alg,reso,cst = translate_mse_funct env' mpo inl mse params in
321		let alg' = mk_alg_funct mpo mbid mtb alg in
	309	let alg' = MoreFunctor (mbid,mtb,alg) in
322	310	MoreFunctor (mbid, mtb, sign), alg',reso, cst +++ mtb.mod_constraints
323	311
324	312	and translate_modtype env mp inl (params,mte) =
325	313	let sign,alg,reso,cst = translate_mse_funct env None inl mte params in
326	314	let mtb = mk_modtype (mp_from_mexpr mte) sign cst reso in
327	315	let mtb' = subst_modtype_and_resolver mtb mp in
328		{ mtb' with mod_type_alg = alg }
	316	{ mtb' with mod_type_alg = Some alg }
329	317
330	318	(** [finalize_module] :
331		from an already-translated (or interactive) implementation
332		and a signature entry, produce a final [module_expr] *)
	319	from an already-translated (or interactive) implementation and
	320	an (optional) signature entry, produces a final [module_body] *)
333	321
334	322	let finalize_module env mp (sign,alg,reso,cst) restype = match restype with
335	323	\|None ->
336	324	let impl = match alg with Some e -> Algebraic e \| None -> FullStruct in
337		mk_mod mp impl sign None cst reso
	325	mk_mod mp impl sign cst reso
338	326	\|Some (params_mte,inl) ->
339	327	let res_mtb = translate_modtype env mp inl params_mte in
340	328	let auto_mtb = mk_modtype mp sign Univ.ContextSet.empty reso in

343	331	{ res_mtb with
344	332	mod_mp = mp;
345	333	mod_expr = impl;
346		(** cst from module body typing, cst' from subtyping,
347		and constraints from module type. *)
348		mod_constraints = Univ.ContextSet.add_constraints cst' (cst +++ res_mtb.mod_constraints) }
	334	(** cst from module body typing,
	335	cst' from subtyping,
	336	constraints from module type. *)
	337	mod_constraints =
	338	Univ.ContextSet.add_constraints cst' (cst +++ res_mtb.mod_constraints) }
349	339
350	340	let translate_module env mp inl = function
351	341	\|MType (params,ty) ->
352	342	let mtb = translate_modtype env mp inl (params,ty) in
353	343	module_body_of_type mp mtb
354	344	\|MExpr (params,mse,oty) ->
355		let t = translate_mse_funct env (Some mp) inl mse params in
	345	let (sg,alg,reso,cst) = translate_mse_funct env (Some mp) inl mse params in
356	346	let restype = Option.map (fun ty -> ((params,ty),inl)) oty in
357		finalize_module env mp t restype
	347	finalize_module env mp (sg,Some alg,reso,cst) restype
	348
	349	(** We now forbid any Include of functors with restricted signatures.
	350	Otherwise, we could end with the creation of undesired axioms
	351	(see #3746). Note that restricted non-functorized modules are ok,
	352	thanks to strengthening. *)
	353
	354	let rec unfunct = function
	355	\|NoFunctor me -> me
	356	\|MoreFunctor(_,_,me) -> unfunct me
	357
	358	let rec forbid_incl_signed_functor env = function
	359	\|MEapply(fe,_) -> forbid_incl_signed_functor env fe
	360	\|MEwith _ -> assert false (* No 'with' syntax for modules *)
	361	\|MEident mp1 ->
	362	let mb = lookup_module mp1 env in
	363	match mb.mod_type, mb.mod_type_alg, mb.mod_expr with
	364	\|MoreFunctor _, Some _, _ ->
	365	(* functor + restricted signature = error *)
	366	error_include_restricted_functor mp1
	367	\|MoreFunctor _, None, Algebraic me ->
	368	(* functor, no signature yet, a definition which may be restricted *)
	369	forbid_incl_signed_functor env (unfunct me)
	370	\|_ -> ()
358	371
359	372	let rec translate_mse_inclmod env mp inl = function
360	373	\|MEident mp1 ->
361	374	let mb = strengthen_and_subst_mb (lookup_module mp1 env) mp true in
362	375	let sign = clean_bounded_mod_expr mb.mod_type in
363		sign,None,mb.mod_delta,Univ.ContextSet.empty
	376	sign,(),mb.mod_delta,Univ.ContextSet.empty
364	377	\|MEapply (fe,arg) ->
365	378	let ftrans = translate_mse_inclmod env mp inl fe in
366		translate_apply env inl ftrans arg (fun _ _ -> None)
	379	translate_apply env inl ftrans arg (fun _ _ -> ())
367	380	\|MEwith _ -> assert false (* No 'with' syntax for modules *)
368	381
369	382	let translate_mse_incl is_mod env mp inl me =
370	383	if is_mod then
	384	let () = forbid_incl_signed_functor env me in
371	385	translate_mse_inclmod env mp inl me
372	386	else
373	387	let mtb = translate_modtype env mp inl ([],me) in
374	388	let sign = clean_bounded_mod_expr mtb.mod_type in
375		sign,None,mtb.mod_delta,mtb.mod_constraints
	389	sign,(),mtb.mod_delta,mtb.mod_constraints

+18

-8

kernel/mod_typing.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

13	13
14	14	(** Main functions for translating module entries *)
15	15
	16	(** [translate_module] produces a [module_body] out of a [module_entry].
	17	In the output fields:
	18	- [mod_expr] is [Abstract] for a [MType] entry, or [Algebraic] for [MExpr].
	19	- [mod_type_alg] is [None] only for a [MExpr] without explicit signature.
	20	*)
	21
16	22	val translate_module :
17	23	env -> module_path -> inline -> module_entry -> module_body
	24
	25	(** [translate_modtype] produces a [module_type_body] whose [mod_type_alg]
	26	cannot be [None] (and of course [mod_expr] is [Abstract]). *)
18	27
19	28	val translate_modtype :
20	29	env -> module_path -> inline -> module_type_entry -> module_type_body

23	32	- We translate to a module when a [module_path] is given,
24	33	otherwise to a module type.
25	34	- The first output is the expanded signature
26		- The second output is the algebraic expression, kept for the extraction.
27		It is never None when translating to a module, but for module type
28		it could not be contain applications or functors.
29		*)
	35	- The second output is the algebraic expression, kept mostly for
	36	the extraction. *)
30	37
31	38	type 'alg translation =
32		module_signature * 'alg option * delta_resolver * Univ.ContextSet.t
	39	module_signature * 'alg * delta_resolver * Univ.ContextSet.t
33	40
34	41	val translate_mse :
35	42	env -> module_path option -> inline -> module_struct_entry ->
36	43	module_alg_expr translation
37	44
	45	(** From an already-translated (or interactive) implementation and
	46	an (optional) signature entry, produces a final [module_body] *)
	47
38	48	val finalize_module :
39		env -> module_path -> module_expression translation ->
	49	env -> module_path -> (module_expression option) translation ->
40	50	(module_type_entry * inline) option ->
41	51	module_body
42	52

45	55
46	56	val translate_mse_incl :
47	57	bool -> env -> module_path -> inline -> module_struct_entry ->
48		module_alg_expr translation
	58	unit translation

+5

-4

kernel/modops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

66	66	\| IncorrectWithConstraint of Label.t
67	67	\| GenerativeModuleExpected of Label.t
68	68	\| LabelMissing of Label.t * string
	69	\| IncludeRestrictedFunctor of module_path
69	70
70	71	exception ModuleTypingError of module_typing_error
71	72
72	73	let error_existing_label l =
73	74	raise (ModuleTypingError (LabelAlreadyDeclared l))
74	75
75		let error_application_to_not_path mexpr =
76		raise (ModuleTypingError (ApplicationToNotPath mexpr))
77
78	76	let error_not_a_functor () =
79	77	raise (ModuleTypingError NotAFunctor)
80	78

110	108
111	109	let error_no_such_label_sub l l1 =
112	110	raise (ModuleTypingError (LabelMissing (l,l1)))
	111
	112	let error_include_restricted_functor mp =
	113	raise (ModuleTypingError (IncludeRestrictedFunctor mp))
113	114
114	115	(** {6 Operations on functors } *)
115	116

+4

-3

kernel/modops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

125	125	\| IncorrectWithConstraint of Label.t
126	126	\| GenerativeModuleExpected of Label.t
127	127	\| LabelMissing of Label.t * string
	128	\| IncludeRestrictedFunctor of module_path
128	129
129	130	exception ModuleTypingError of module_typing_error
130	131
131	132	val error_existing_label : Label.t -> 'a
132
133		val error_application_to_not_path : module_struct_entry -> 'a
134	133
135	134	val error_incompatible_modtypes :
136	135	module_type_body -> module_type_body -> 'a

151	150	val error_generative_module_expected : Label.t -> 'a
152	151
153	152	val error_no_such_label_sub : Label.t->string->'a
	153
	154	val error_include_restricted_functor : module_path -> 'a

+1

-1

kernel/names.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+6

-6

kernel/names.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

394	394
395	395	module Mindset : CSig.SetS with type elt = MutInd.t
396	396	module Mindmap : Map.ExtS with type key = MutInd.t and module Set := Mindset
397		module Mindmap_env : Map.S with type key = MutInd.t
	397	module Mindmap_env : CSig.MapS with type key = MutInd.t
398	398
399	399	(** Beware: first inductive has index 0 *)
400	400	type inductive = MutInd.t * int

402	402	(** Beware: first constructor has index 1 *)
403	403	type constructor = inductive * int
404	404
405		module Indmap : Map.S with type key = inductive
406		module Constrmap : Map.S with type key = constructor
407		module Indmap_env : Map.S with type key = inductive
408		module Constrmap_env : Map.S with type key = constructor
	405	module Indmap : CSig.MapS with type key = inductive
	406	module Constrmap : CSig.MapS with type key = constructor
	407	module Indmap_env : CSig.MapS with type key = inductive
	408	module Constrmap_env : CSig.MapS with type key = constructor
409	409
410	410	val ind_modpath : inductive -> ModPath.t
411	411	val constr_modpath : constructor -> ModPath.t

+1

-1

kernel/nativecode.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativecode.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativeconv.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativeconv.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativeinstr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativelambda.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativelambda.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+12

-2

kernel/nativelib.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

76	76	::include_dirs
77	77	@ ["-impl"; ml_filename] in
78	78	if !Flags.debug then Pp.msg_debug (Pp.str (compiler_name ^ " " ^ (String.concat " " args)));
79		try CUnix.sys_command compiler_name args = Unix.WEXITED 0, link_filename
	79	try
	80	let res = CUnix.sys_command compiler_name args in
	81	let res = match res with
	82	\| Unix.WEXITED 0 -> true
	83	\| Unix.WEXITED n ->
	84	Pp.(msg_warning (str "command exited with status " ++ int n)); false
	85	\| Unix.WSIGNALED n ->
	86	Pp.(msg_warning (str "command killed by signal " ++ int n)); false
	87	\| Unix.WSTOPPED n ->
	88	Pp.(msg_warning (str "command stopped by signal " ++ int n)); false in
	89	res, link_filename
80	90	with Unix.Unix_error (e,_,_) ->
81	91	Pp.(msg_warning (str (Unix.error_message e)));
82	92	false, link_filename

+1

-1

kernel/nativelib.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativelibrary.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativelibrary.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativevalues.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/nativevalues.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/opaqueproof.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-3

kernel/opaqueproof.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

10	10	open Mod_subst
11	11
12	12	(** This module implements the handling of opaque proof terms.
13		Opauqe proof terms are special since:
	13	Opaque proof terms are special since:
14	14	- they can be lazily computed and substituted
15		- they are stoked in an optionally loaded segment of .vo files
	15	- they are stored in an optionally loaded segment of .vo files
16	16	An [opaque] proof terms holds the real data until fully discharged.
17	17	In this case it is called [direct].
18	18	When it is [turn_indirect] the data is relocated to an opaque table

+1

-1

kernel/pre_env.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/pre_env.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/primitives.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/primitives.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

kernel/reduction.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

135	135	if Int.equal n 0 then applist (substl env t, stack) else
136	136	match kind_of_term t, stack with
137	137	Lambda(_,_,c), arg::stacktl -> stacklam (n-1) (arg::env) c stacktl
138		\| LetIn(_,b,_,c), _ -> stacklam (n-1) (b::env) c stack
	138	\| LetIn(_,b,_,c), _ -> stacklam (n-1) (substl env b::env) c stack
139	139	\| _ -> anomaly (Pp.str "Not enough lambda/let's") in
140	140	stacklam n [] c (Array.to_list v)
141	141

+1

-1

kernel/reduction.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/retroknowledge.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/retroknowledge.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

kernel/safe_typing.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

745	745	let add_include me is_module inl senv =
746	746	let open Mod_typing in
747	747	let mp_sup = senv.modpath in
748		let sign,_,resolver,cst =
	748	let sign,(),resolver,cst =
749	749	translate_mse_incl is_module senv.env mp_sup inl me
750	750	in
751	751	let senv = add_constraints (Now (false, cst)) senv in

+1

-1

kernel/safe_typing.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/sorts.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/sorts.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/subtyping.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/subtyping.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/term.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/term.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+10

-5

kernel/term_typing.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

423	423	let trusted = check_signatures mb signatures in
424	424	let push_seff env = function
425	425	\| kn, cb, `Nothing, _ ->
426		Environ.add_constant kn cb env
	426	let env = Environ.add_constant kn cb env in
	427	if not cb.const_polymorphic then
	428	Environ.push_context ~strict:true cb.const_universes env
	429	else env
427	430	\| kn, cb, `Opaque(_, ctx), _ ->
428		let env = Environ.add_constant kn cb env in
429		Environ.push_context_set
430		~strict:(not cb.const_polymorphic) ctx env in
	431	let env = Environ.add_constant kn cb env in
	432	if not cb.const_polymorphic then
	433	let env = Environ.push_context ~strict:true cb.const_universes env in
	434	Environ.push_context_set ~strict:true ctx env
	435	else env in
431	436	let rec translate_seff sl seff acc env =
432	437	match sl, seff with
433	438	\| _, [] -> List.rev acc, ce

+1

-1

kernel/term_typing.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/type_errors.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/type_errors.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/typeops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/typeops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-5

kernel/univ.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

1706	1706	else if Array.length y = 0 then x
1707	1707	else Array.append x y
1708	1708
1709		let of_array a = a
	1709	let of_array a =
	1710	assert(Array.for_all (fun x -> not (Level.is_prop x)) a);
	1711	a
1710	1712
1711	1713	let to_array a = a
1712	1714

1714	1716
1715	1717	let subst_fn fn t =
1716	1718	let t' = CArray.smartmap fn t in
1717		if t' == t then t else t'
	1719	if t' == t then t else of_array t'
1718	1720
1719	1721	let levels x = LSet.of_array x
1720	1722

2029	2031	let dump_arc u = function
2030	2032	\| Canonical {univ=u; lt=lt; le=le} ->
2031	2033	let u_str = Level.to_string u in
2032		List.iter (fun v -> output Lt (Level.to_string v) u_str) lt;
2033		List.iter (fun v -> output Le (Level.to_string v) u_str) le
	2034	List.iter (fun v -> output Lt u_str (Level.to_string v)) lt;
	2035	List.iter (fun v -> output Le u_str (Level.to_string v)) le
2034	2036	\| Equiv v ->
2035	2037	output Eq (Level.to_string u) (Level.to_string v)
2036	2038	in

+1

-1

kernel/univ.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/vars.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

kernel/vars.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

64	64	if two names are identical, the one of least indice is kept *)
65	65	val subst_vars : Id.t list -> constr -> constr
66	66
67		(** [substn_vars n [id1;...;idn] t] substitute [VAR idj] by [Rel j+n-1] in [t]
	67	(** [substn_vars n [id1;...;idk] t] substitute [VAR idj] by [Rel j+n-1] in [t]
68	68	if two names are identical, the one of least indice is kept *)
69	69	val substn_vars : int -> Id.t list -> constr -> constr
70	70

+1

-1

kernel/vconv.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

kernel/vm.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-0

kernel/vm.mli less more

47	47	\| Vatom_stk of atom * stack
48	48	\| Vuniv_level of Univ.universe_level
49	49
	50	(** For debugging purposes only *)
	51
50	52	val pr_atom : atom -> Pp.std_ppcmds
51	53	val pr_whd : whd -> Pp.std_ppcmds
	54	val pr_stack : stack -> Pp.std_ppcmds
52	55
53	56	(** Constructors *)
54	57

+1

-1

lib/aux_file.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/aux_file.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/bigint.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/bigint.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

lib/cMap.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

15	15
16	16	module type ExtS =
17	17	sig
18		include Map.S
	18	include CSig.MapS
19	19	module Set : CSig.SetS with type elt = key
20	20	val update : key -> 'a -> 'a t -> 'a t
21	21	val modify : key -> (key -> 'a -> 'a) -> 'a t -> 'a t

+2

-2

lib/cMap.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

17	17
18	18	module type ExtS =
19	19	sig
20		include Map.S
	20	include CSig.MapS
21	21	(** The underlying Map library *)
22	22
23	23	module Set : CSig.SetS with type elt = key

+1

-1

lib/cSet.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/cSet.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+31

-0

lib/cSig.mli less more

44	44	end
45	45	(** Redeclaration of OCaml set signature, to preserve compatibility. See OCaml
46	46	documentation for more information. *)
	47
	48	module type MapS =
	49	sig
	50	type key
	51	type (+'a) t
	52	val empty: 'a t
	53	val is_empty: 'a t -> bool
	54	val mem: key -> 'a t -> bool
	55	val add: key -> 'a -> 'a t -> 'a t
	56	val singleton: key -> 'a -> 'a t
	57	val remove: key -> 'a t -> 'a t
	58	val merge:
	59	(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
	60	val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
	61	val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
	62	val iter: (key -> 'a -> unit) -> 'a t -> unit
	63	val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
	64	val for_all: (key -> 'a -> bool) -> 'a t -> bool
	65	val exists: (key -> 'a -> bool) -> 'a t -> bool
	66	val filter: (key -> 'a -> bool) -> 'a t -> 'a t
	67	val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
	68	val cardinal: 'a t -> int
	69	val bindings: 'a t -> (key * 'a) list
	70	val min_binding: 'a t -> (key * 'a)
	71	val max_binding: 'a t -> (key * 'a)
	72	val choose: 'a t -> (key * 'a)
	73	val split: key -> 'a t -> 'a t * 'a option * 'a t
	74	val find: key -> 'a t -> 'a
	75	val map: ('a -> 'b) -> 'a t -> 'b t
	76	val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
	77	end

+1

-1

lib/cString.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/cString.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/cThread.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/cThread.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/cUnix.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/cUnix.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/canary.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/canary.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

lib/clib.mllib less more

17	17	Flags
18	18	Control
19	19	Loc
	20	CList
	21	CString
20	22	Serialize
21	23	Deque
22	24	CObj
23		CList
24		CString
25	25	CArray
26	26	CStack
27	27	Util

+1

-1

lib/control.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/control.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/deque.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/deque.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/dyn.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/dyn.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+5

-2

lib/envars.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

38	38	let user_path () =
39	39	path_to_list (Sys.getenv "PATH") (* may raise Not_found *)
40	40
	41	(* Finding a name in path using the equality provided by the file system *)
	42	(* whether it is case-sensitive or case-insensitive *)
41	43	let rec which l f =
42	44	match l with
43	45	\| [] ->

98	100	(** [check_file_else ~dir ~file oth] checks if [file] exists in
99	101	the installation directory [dir] given relatively to [coqroot].
100	102	If this Coq is only locally built, then [file] must be in [coqroot].
101		If the check fails, then [oth ()] is evaluated. *)
	103	If the check fails, then [oth ()] is evaluated.
	104	Using file system equality seems well enough for this heuristic *)
102	105	let check_file_else ~dir ~file oth =
103	106	let path = if Coq_config.local then coqroot else coqroot / dir in
104	107	if Sys.file_exists (path / file) then path else oth ()

+1

-1

lib/envars.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/ephemeron.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/ephemeron.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/explore.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/explore.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/feedback.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/feedback.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-1

lib/flags.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

82	82	let print_emacs = ref false
83	83	let coqtop_ui = ref false
84	84
	85	let xml_export = ref false
	86
85	87	let ide_slave = ref false
86	88	let ideslave_coqtop_flags = ref None
87	89

+3

-1

lib/flags.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

42	42
43	43	val print_emacs : bool ref
44	44	val coqtop_ui : bool ref
	45
	46	val xml_export : bool ref
45	47
46	48	val ide_slave : bool ref
47	49	val ideslave_coqtop_flags : string option ref

+1

-1

lib/future.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/future.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/genarg.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/genarg.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/hMap.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/hMap.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/hashcons.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/hashcons.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/hashset.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/hashset.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/heap.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/heap.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/hook.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/hook.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/iStream.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/iStream.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/int.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/int.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

lib/loc.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

30	30	fname = ""; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
31	31	bp = 0; ep = 0; }
32	32
33		let is_ghost loc = Pervasives.(=) loc ghost (** FIXME *)
	33	let is_ghost loc = loc.ep = 0
34	34
35	35	let merge loc1 loc2 =
36	36	if loc1.bp < loc2.bp then

+1

-1

lib/loc.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/option.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/option.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/pp.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/pp.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/pp_control.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/pp_control.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/ppstyle.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/ppstyle.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+5

-4

lib/predicate.ml less more

8	8	(* under the terms of the GNU Library General Public License. *)
9	9	(* *)
10	10	(************************************************************************)
11
12		(* Sets over ordered types *)
13	11
14	12	module type OrderedType =
15	13	sig

42	40	struct
43	41	module EltSet = Set.Make(Ord)
44	42
45		(* when bool is false, the denoted set is the complement of
46		the given set *)
47	43	type elt = Ord.t
	44
	45	(* (false, s) represents a set which is equal to the set s
	46	(true, s) represents a set which is equal to the complement of set s *)
48	47	type t = bool * EltSet.t
49	48
50	49	let elements (b,s) = (b, EltSet.elements s)

83	82
84	83	let diff s1 s2 = inter s1 (complement s2)
85	84
	85	(* assumes the set is infinite *)
86	86	let subset s1 s2 =
87	87	match (s1,s2) with
88	88	((false,p1),(false,p2)) -> EltSet.subset p1 p2

90	90	\| ((false,p1),(true,n2)) -> EltSet.is_empty (EltSet.inter p1 n2)
91	91	\| ((true,_),(false,_)) -> false
92	92
	93	(* assumes the set is infinite *)
93	94	let equal (b1,s1) (b2,s2) =
94	95	b1=b2 && EltSet.equal s1 s2
95	96

+51

-34

lib/predicate.mli less more

	0	(** Infinite sets over a chosen [OrderedType].
0	1
1		(** Module [Pred]: sets over infinite ordered types with complement. *)
	2	All operations over sets are purely applicative (no side-effects).
	3	*)
2	4
3		(** This module implements the set data structure, given a total ordering
4		function over the set elements. All operations over sets
5		are purely applicative (no side-effects).
6		The implementation uses the Set library. *)
7
	5	(** Input signature of the functor [Make]. *)
8	6	module type OrderedType =
9	7	sig
10	8	type t
11		val compare: t -> t -> int
	9	(** The type of the elements in the set.
	10
	11	The chosen [t] {b must be infinite}. *)
	12
	13	val compare : t -> t -> int
	14	(** A total ordering function over the set elements.
	15	This is a two-argument function [f] such that:
	16	- [f e1 e2] is zero if the elements [e1] and [e2] are equal,
	17	- [f e1 e2] is strictly negative if [e1] is smaller than [e2],
	18	- and [f e1 e2] is strictly positive if [e1] is greater than [e2].
	19	*)
12	20	end
13		(** The input signature of the functor [Pred.Make].
14		[t] is the type of the set elements.
15		[compare] is a total ordering function over the set elements.
16		This is a two-argument function [f] such that
17		[f e1 e2] is zero if the elements [e1] and [e2] are equal,
18		[f e1 e2] is strictly negative if [e1] is smaller than [e2],
19		and [f e1 e2] is strictly positive if [e1] is greater than [e2].
20		Example: a suitable ordering function is
21		the generic structural comparison function [compare]. *)
22	21
23	22	module type S =
24	23	sig
25	24	type elt
26		(** The type of the set elements. *)
	25	(** The type of the elements in the set. *)
	26
27	27	type t
28		(** The type of sets. *)
	28	(** The type of sets. *)
	29
29	30	val empty: t
30		(** The empty set. *)
	31	(** The empty set. *)
	32
31	33	val full: t
32		(** The whole type. *)
	34	(** The set of all elements (of type [elm]). *)
	35
33	36	val is_empty: t -> bool
34		(** Test whether a set is empty or not. *)
	37	(** Test whether a set is empty or not. *)
	38
35	39	val is_full: t -> bool
36		(** Test whether a set contains the whole type or not. *)
	40	(** Test whether a set contains the whole type or not. *)
	41
37	42	val mem: elt -> t -> bool
38		(** [mem x s] tests whether [x] belongs to the set [s]. *)
	43	(** [mem x s] tests whether [x] belongs to the set [s]. *)
	44
39	45	val singleton: elt -> t
40		(** [singleton x] returns the one-element set containing only [x]. *)
	46	(** [singleton x] returns the one-element set containing only [x]. *)
	47
41	48	val add: elt -> t -> t
42		(** [add x s] returns a set containing all elements of [s],
43		plus [x]. If [x] was already in [s], [s] is returned unchanged. *)
	49	(** [add x s] returns a set containing all elements of [s],
	50	plus [x]. If [x] was already in [s], then [s] is returned unchanged. *)
	51
44	52	val remove: elt -> t -> t
45	53	(** [remove x s] returns a set containing all elements of [s],
46		except [x]. If [x] was not in [s], [s] is returned unchanged. *)
	54	except [x]. If [x] was not in [s], then [s] is returned unchanged. *)
	55
47	56	val union: t -> t -> t
	57	(** Set union. *)
	58
48	59	val inter: t -> t -> t
	60	(** Set intersection. *)
	61
49	62	val diff: t -> t -> t
	63	(** Set difference. *)
	64
50	65	val complement: t -> t
51		(** Union, intersection, difference and set complement. *)
	66	(** Set complement. *)
	67
52	68	val equal: t -> t -> bool
53		(** [equal s1 s2] tests whether the sets [s1] and [s2] are
54		equal, that is, contain equal elements. *)
	69	(** [equal s1 s2] tests whether the sets [s1] and [s2] are
	70	equal, that is, contain equal elements. *)
	71
55	72	val subset: t -> t -> bool
56	73	(** [subset s1 s2] tests whether the set [s1] is a subset of
57		the set [s2]. *)
	74	the set [s2]. *)
	75
58	76	val elements: t -> bool * elt list
59	77	(** Gives a finite representation of the predicate: if the
60	78	boolean is false, then the predicate is given in extension.
61	79	if it is true, then the complement is given *)
62	80	end
63	81
64		module Make(Ord: OrderedType): (S with type elt = Ord.t)
65		(** Functor building an implementation of the set structure
66		given a totally ordered type. *)
	82	(** The [Make] functor constructs an implementation for any [OrderedType]. *)
	83	module Make (Ord : OrderedType) : (S with type elt = Ord.t)

+1

-1

lib/profile.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/profile.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/remoteCounter.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/remoteCounter.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/richpp.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/richpp.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/rtree.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/rtree.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/serialize.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/serialize.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-3

lib/spawn.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

174	174	let uid { pid; } = string_of_int pid
175	175	let unixpid { pid; } = pid
176	176
177		let kill ({ pid = unixpid; oob_req; cin; cout; alive; watch } as p) =
	177	let kill ({ pid = unixpid; oob_resp; oob_req; cin; cout; alive; watch } as p) =
178	178	p.alive <- false;
179	179	if not alive then prerr_endline "This process is already dead"
180	180	else begin try

182	182	output_death_sentence (uid p) oob_req;
183	183	close_in_noerr cin;
184	184	close_out_noerr cout;
	185	close_in_noerr oob_resp;
	186	close_out_noerr oob_req;
185	187	if Sys.os_type = "Unix" then Unix.kill unixpid 9;
186	188	p.watch <- None
187	189	with e -> prerr_endline ("kill: "^Printexc.to_string e) end

246	248	let uid { pid; } = string_of_int pid
247	249	let unixpid { pid = pid; } = pid
248	250
249		let kill ({ pid = unixpid; oob_req; cin; cout; alive } as p) =
	251	let kill ({ pid = unixpid; oob_req; oob_resp; cin; cout; alive } as p) =
250	252	p.alive <- false;
251	253	if not alive then prerr_endline "This process is already dead"
252	254	else begin try
253	255	output_death_sentence (uid p) oob_req;
254	256	close_in_noerr cin;
255	257	close_out_noerr cout;
	258	close_in_noerr oob_resp;
	259	close_out_noerr oob_req;
256	260	if Sys.os_type = "Unix" then Unix.kill unixpid 9;
257	261	with e -> prerr_endline ("kill: "^Printexc.to_string e) end
258	262

+1

-1

lib/spawn.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+61

-23

lib/system.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

10	10	open Pp
11	11	open Errors
12	12	open Util
13		open Unix
14	13
15	14	(* All subdirectories, recursively *)
16	15
17	16	let exists_dir dir =
18		try let _ = closedir (opendir dir) in true with Unix_error _ -> false
	17	try Sys.is_directory dir with Sys_error _ -> false
19	18
20	19	let skipped_dirnames = ref ["CVS"; "_darcs"]
21	20

30	29	let l = ref [] in
31	30	let add f rel = l := (f, rel) :: !l in
32	31	let rec traverse dir rel =
33		let dirh = opendir dir in
34		try
35		while true do
36		let f = readdir dirh in
37		if ok_dirname f then
38		let file = Filename.concat dir f in
39		try
40		begin match (stat file).st_kind with
41		\| S_DIR ->
42		let newrel = rel @ [f] in
43		add file newrel;
44		traverse file newrel
45		\| _ -> ()
46		end
47		with Unix_error (e,s1,s2) -> ()
48		done
49		with End_of_file ->
50		closedir dirh
	32	Array.iter (fun f ->
	33	if ok_dirname f then
	34	let file = Filename.concat dir f in
	35	if Sys.is_directory file then begin
	36	let newrel = rel @ [f] in
	37	add file newrel;
	38	traverse file newrel
	39	end)
	40	(Sys.readdir dir)
51	41	in
52	42	if exists_dir root then traverse root [];
53	43	List.rev !l
	44
	45	(* Caching directory contents for efficient syntactic equality of file
	46	names even on case-preserving but case-insensitive file systems *)
	47
	48	module StrMod = struct
	49	type t = string
	50	let compare = compare
	51	end
	52
	53	module StrMap = Map.Make(StrMod)
	54	module StrSet = Set.Make(StrMod)
	55
	56	let dirmap = ref StrMap.empty
	57
	58	let make_dir_table dir =
	59	let filter_dotfiles s f = if f.[0] = '.' then s else StrSet.add f s in
	60	Array.fold_left filter_dotfiles StrSet.empty (Sys.readdir dir)
	61
	62	let exists_in_dir_respecting_case dir bf =
	63	let contents, cached =
	64	try StrMap.find dir !dirmap, true with Not_found ->
	65	let contents = make_dir_table dir in
	66	dirmap := StrMap.add dir contents !dirmap;
	67	contents, false in
	68	StrSet.mem bf contents \|\|
	69	if cached then begin
	70	(* rescan, there is a new file we don't know about *)
	71	let contents = make_dir_table dir in
	72	dirmap := StrMap.add dir contents !dirmap;
	73	StrSet.mem bf contents
	74	end
	75	else
	76	false
	77
	78	let file_exists_respecting_case path f =
	79	(* This function ensures that a file with expected lowercase/uppercase
	80	is the correct one, even on case-insensitive file systems *)
	81	let rec aux f =
	82	let bf = Filename.basename f in
	83	let df = Filename.dirname f in
	84	(String.equal df "." \|\| aux df)
	85	&& exists_in_dir_respecting_case (Filename.concat path df) bf
	86	in Sys.file_exists (Filename.concat path f) && aux f
54	87
55	88	let rec search paths test =
56	89	match paths with

76	109	in
77	110	check_and_warn (search path (fun lpe ->
78	111	let f = Filename.concat lpe filename in
79		if Sys.file_exists f then [lpe,f] else []))
	112	if file_exists_respecting_case lpe filename then [lpe,f] else []))
80	113
81	114	let where_in_path_rex path rex =
82	115	search path (fun lpe ->

92	125
93	126	let find_file_in_path ?(warn=true) paths filename =
94	127	if not (Filename.is_implicit filename) then
	128	(* the name is considered to be a physical name and we use the file
	129	system rules (e.g. possible case-insensitivity) to find it *)
95	130	if Sys.file_exists filename then
96	131	let root = Filename.dirname filename in
97	132	root, filename

99	134	errorlabstrm "System.find_file_in_path"
100	135	(hov 0 (str "Can't find file" ++ spc () ++ str filename))
101	136	else
	137	(* the name is considered to be the transcription as a relative
	138	physical name of a logical name, so we deal with it as a name
	139	to be locate respecting case *)
102	140	try where_in_path ~warn paths filename
103	141	with Not_found ->
104	142	errorlabstrm "System.find_file_in_path"

223	261
224	262	let get_time () =
225	263	let t = Unix.times () in
226		(Unix.gettimeofday(), t.tms_utime, t.tms_stime)
	264	(Unix.gettimeofday(), t.Unix.tms_utime, t.Unix.tms_stime)
227	265
228	266	(* Keep only 3 significant digits *)
229	267	let round f = (floor (f . 1e3)) . 1e-3

+3

-1

lib/system.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

27	27
28	28	val find_file_in_path :
29	29	?warn:bool -> CUnix.load_path -> string -> CUnix.physical_path * string
	30
	31	val file_exists_respecting_case : string -> string -> bool
30	32
31	33	(** {6 I/O functions } *)
32	34	(** Generic input and output functions, parameterized by a magic number

+1

-1

lib/terminal.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/terminal.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/trie.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/trie.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/unicode.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/unionfind.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/unionfind.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/util.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/xml_datatype.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/xml_printer.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

lib/xml_printer.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+18

-5

library/declare.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

31	31	\| InternalTacticRequest (* kernel action, no message is displayed *)
32	32	\| UserIndividualRequest (* user action, a message is displayed *)
33	33
	34	(** XML output hooks *)
	35
	36	let (f_xml_declare_variable, xml_declare_variable) = Hook.make ~default:ignore ()
	37	let (f_xml_declare_constant, xml_declare_constant) = Hook.make ~default:ignore ()
	38	let (f_xml_declare_inductive, xml_declare_inductive) = Hook.make ~default:ignore ()
	39
	40	let if_xml f x = if !Flags.xml_export then f x else ()
	41
34	42	(** Declaration of section variables and local definitions *)
35	43
36	44	type section_variable_entry =

82	90	declare_var_implicits id;
83	91	Notation.declare_ref_arguments_scope (VarRef id);
84	92	Heads.declare_head (EvalVarRef id);
	93	if_xml (Hook.get f_xml_declare_variable) oname;
85	94	oname
86	95
87	96

215	224	let id = Label.to_id (pi3 (Constant.repr3 c)) in
216	225	ignore(add_leaf id o);
217	226	update_tables c;
	227	let () = if_xml (Hook.get f_xml_declare_constant) (InternalTacticRequest, c) in
218	228	match role with
219	229	\| Safe_typing.Subproof -> ()
220	230	\| Safe_typing.Schema (ind, kind) -> !declare_scheme kind [\|ind,c\|])

256	266	cst_was_seff = false;
257	267	} in
258	268	let kn = declare_constant_common id cst in
	269	let () = if_xml (Hook.get f_xml_declare_constant) (internal, kn) in
259	270	kn
260	271
261	272	let declare_definition ?(internal=UserIndividualRequest)

364	375	let kn' = declare_constant id (ProjectionEntry entry,
365	376	IsDefinition StructureComponent)
366	377	in
367		assert(eq_constant kn kn')) kns; true
368		\| Some None \| None -> false
	378	assert(eq_constant kn kn')) kns; true,true
	379	\| Some None -> true,false
	380	\| None -> false,false
369	381
370	382	(* for initial declaration *)
371	383	let declare_mind mie =

374	386	\| [] -> anomaly (Pp.str "cannot declare an empty list of inductives") in
375	387	let (sp,kn as oname) = add_leaf id (inInductive ([],mie)) in
376	388	let mind = Global.mind_of_delta_kn kn in
377		let isprim = declare_projections mind in
	389	let isrecord,isprim = declare_projections mind in
378	390	declare_mib_implicits mind;
379	391	declare_inductive_argument_scopes mind mie;
	392	if_xml (Hook.get f_xml_declare_inductive) (isrecord,oname);
380	393	oname, isprim
381	394
382	395	(* Declaration messages *)

430	443	Univ.ContextSet.add_universe lev ctx))
431	444	(glob, Univ.ContextSet.empty) l
432	445	in
433		Global.push_context_set false ctx;
	446	Global.push_context_set p ctx;
434	447	if p then Lib.add_section_context ctx;
435	448	Universes.set_global_universe_names glob'
436	449

+6

-1

library/declare.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

70	70	the whole block and a boolean indicating if it is a primitive record. *)
71	71	val declare_mind : mutual_inductive_entry -> object_name * bool
72	72
	73	(** Hooks for XML output *)
	74	val xml_declare_variable : (object_name -> unit) Hook.t
	75	val xml_declare_constant : (internal_flag * constant -> unit) Hook.t
	76	val xml_declare_inductive : (bool * object_name -> unit) Hook.t
	77
73	78	(** Declaration messages *)
74	79
75	80	val definition_message : Id.t -> unit

+22

-3

library/declaremods.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

556	556	Summary.ref ([] : module_type_body list) ~name:"MODTYPE-INFO"
557	557
558	558
	559	(** XML output hooks *)
	560
	561	let (f_xml_declare_module, xml_declare_module) = Hook.make ~default:ignore ()
	562	let (f_xml_start_module, xml_start_module) = Hook.make ~default:ignore ()
	563	let (f_xml_end_module, xml_end_module) = Hook.make ~default:ignore ()
	564	let (f_xml_declare_module_type, xml_declare_module_type) = Hook.make ~default:ignore ()
	565	let (f_xml_start_module_type, xml_start_module_type) = Hook.make ~default:ignore ()
	566	let (f_xml_end_module_type, xml_end_module_type) = Hook.make ~default:ignore ()
	567
	568	let if_xml f x = if !Flags.xml_export then f x else ()
	569
559	570	(** {6 Modules : start, end, declare} *)
560	571
561	572	module RawModOps = struct

577	588	openmod_info := { cur_typ = res_entry_o; cur_typs = subtyps };
578	589	let prefix = Lib.start_module export id mp fs in
579	590	Nametab.push_dir (Nametab.Until 1) (fst prefix) (DirOpenModule prefix);
580		Lib.add_frozen_state (); mp
	591	Lib.add_frozen_state ();
	592	if_xml (Hook.get f_xml_start_module) mp;
	593	mp
581	594
582	595	let end_module () =
583	596	let oldoname,oldprefix,fs,lib_stack = Lib.end_module () in

616	629	assert (ModPath.equal (mp_of_kn (snd newoname)) mp);
617	630
618	631	Lib.add_frozen_state () (* to prevent recaching *);
	632	if_xml (Hook.get f_xml_end_module) mp;
619	633	mp
620	634
621	635	let declare_module interp_modast id args res mexpr_o fs =

665	679
666	680	let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in
667	681	ignore (Lib.add_leaf id (in_module sobjs));
	682	if_xml (Hook.get f_xml_declare_module) mp;
668	683	mp
669	684
670	685	end

681	696	openmodtype_info := sub_mty_l;
682	697	let prefix = Lib.start_modtype id mp fs in
683	698	Nametab.push_dir (Nametab.Until 1) (fst prefix) (DirOpenModtype prefix);
684		Lib.add_frozen_state (); mp
	699	Lib.add_frozen_state ();
	700	if_xml (Hook.get f_xml_start_module_type) mp;
	701	mp
685	702
686	703	let end_modtype () =
687	704	let oldoname,prefix,fs,lib_stack = Lib.end_modtype () in

698	715	assert (ModPath.equal (mp_of_kn (snd oname)) mp);
699	716
700	717	Lib.add_frozen_state ()(* to prevent recaching *);
	718	if_xml (Hook.get f_xml_end_module_type) mp;
701	719	mp
702	720
703	721	let declare_modtype interp_modast id args mtys (mty,ann) fs =

728	746	check_subtypes_mt mp sub_mty_l;
729	747
730	748	ignore (Lib.add_leaf id (in_modtype sobjs));
	749	if_xml (Hook.get f_xml_declare_module_type) mp;
731	750	mp
732	751
733	752	end

+8

-1

library/declaremods.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

62	62
63	63	val end_modtype : unit -> module_path
64	64
	65	(** Hooks for XML output *)
	66	val xml_declare_module : (module_path -> unit) Hook.t
	67	val xml_start_module : (module_path -> unit) Hook.t
	68	val xml_end_module : (module_path -> unit) Hook.t
	69	val xml_declare_module_type : (module_path -> unit) Hook.t
	70	val xml_start_module_type : (module_path -> unit) Hook.t
	71	val xml_end_module_type : (module_path -> unit) Hook.t
65	72
66	73	(** {6 Libraries i.e. modules on disk } *)
67	74

+1

-1

library/decls.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/decls.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/dischargedhypsmap.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/dischargedhypsmap.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-3

library/global.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

197	197	\| IndRef ind ->
198	198	let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in
199	199	let univs =
200		if mib.mind_polymorphic then mib.mind_universes
	200	if mib.mind_polymorphic then Univ.instantiate_univ_context mib.mind_universes
201	201	else Univ.UContext.empty
202	202	in Inductive.type_of_inductive env (specif, Univ.UContext.instance univs), univs
203	203	\| ConstructRef cstr ->
204	204	let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
205	205	let univs =
206		if mib.mind_polymorphic then mib.mind_universes
	206	if mib.mind_polymorphic then Univ.instantiate_univ_context mib.mind_universes
207	207	else Univ.UContext.empty
208	208	in
209	209	let inst = Univ.UContext.instance univs in

+1

-1

library/global.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/globnames.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/globnames.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/goptions.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

library/goptions.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

132	132
133	133	(** {6 Special functions supposed to be used only in vernacentries.ml } *)
134	134
135		module OptionMap : Map.S with type key = option_name
	135	module OptionMap : CSig.MapS with type key = option_name
136	136
137	137	val get_string_table :
138	138	option_name ->

+1

-1

library/heads.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/heads.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/impargs.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/impargs.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/keys.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/keys.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/kindops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/kindops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-1

library/lib.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

496	496	(*************)
497	497	(* Sections. *)
498	498
	499	(* XML output hooks *)
	500	let (f_xml_open_section, xml_open_section) = Hook.make ~default:ignore ()
	501	let (f_xml_close_section, xml_close_section) = Hook.make ~default:ignore ()
	502
499	503	let open_section id =
500	504	let olddir,(mp,oldsec) = !path_prefix in
501	505	let dir = add_dirpath_suffix olddir id in

507	511	(Pushed for the lifetime of the section: removed by unfrozing the summary)
508	512	Nametab.push_dir (Nametab.Until 1) dir (DirOpenSection prefix);
509	513	path_prefix := prefix;
	514	if !Flags.xml_export then Hook.get f_xml_open_section id;
510	515	add_section ()
511	516
512	517

535	540	let full_olddir = fst !path_prefix in
536	541	pop_path_prefix ();
537	542	add_entry oname (ClosedSection (List.rev (mark::secdecls)));
	543	if !Flags.xml_export then Hook.get f_xml_close_section (basename (fst oname));
538	544	let newdecls = List.map discharge_item secdecls in
539	545	Summary.unfreeze_summaries fs;
540	546	List.iter (Option.iter (fun (id,o) -> add_discharged_leaf id o)) newdecls;

+5

-1

library/lib.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

156	156
157	157	val init : unit -> unit
158	158
	159	(** XML output hooks *)
	160	val xml_open_section : (Names.Id.t -> unit) Hook.t
	161	val xml_close_section : (Names.Id.t -> unit) Hook.t
	162
159	163	(** {6 Section management for discharge } *)
160	164	type variable_info = Names.Id.t * Decl_kinds.binding_kind *
161	165	Term.constr option * Term.types

+1

-1

library/libnames.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

library/libnames.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

59	59	val string_of_path : full_path -> string
60	60	val pr_path : full_path -> std_ppcmds
61	61
62		module Spmap : Map.S with type key = full_path
	62	module Spmap : CSig.MapS with type key = full_path
63	63
64	64	val restrict_path : int -> full_path -> full_path
65	65

+1

-1

library/libobject.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/libobject.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-1

library/library.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

554	554	(* Require libraries, import them if [export <> None], mark them for export
555	555	if [export = Some true] *)
556	556
	557	let (f_xml_require, xml_require) = Hook.make ~default:ignore ()
	558
557	559	let require_library_from_dirpath modrefl export =
558	560	let needed, contents = List.fold_left rec_intern_library ([], DPMap.empty) modrefl in
559	561	let needed = List.rev_map (fun dir -> DPMap.find dir contents) needed in

567	569	end
568	570	else
569	571	add_anonymous_leaf (in_require (needed,modrefl,export));
	572	if !Flags.xml_export then List.iter (Hook.get f_xml_require) modrefl;
570	573	add_frozen_state ()
571	574
572	575	(* the function called by Vernacentries.vernac_import *)

+4

-1

library/library.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

66	66	(** - Overwrite the filename of all libraries (used when restoring a state) *)
67	67	val overwrite_library_filenames : string -> unit
68	68
	69	(** {6 Hook for the xml exportation of libraries } *)
	70	val xml_require : (DirPath.t -> unit) Hook.t
	71
69	72	(** {6 Locate a library in the load paths } *)
70	73	exception LibUnmappedDir
71	74	exception LibNotFound

+1

-1

library/loadpath.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/loadpath.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/nameops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/nameops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/nametab.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/nametab.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/states.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/states.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/summary.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

library/summary.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+15

-9

library/universes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

204	204	else
205	205	let u1 = Sorts.univ_of_sort s1 and u2 = Sorts.univ_of_sort s2 in
206	206	if Univ.check_leq univs u1 u2 then
207		((if Univ.is_small_univ u1 then
	207	((if Univ.is_type0_univ u1 then
208	208	cstrs := Constraints.add (u1, ULe, u2) !cstrs);
209	209	true)
210	210	else

819	819	let cstrs' = List.fold_left (fun cstrs (d, r) ->
820	820	if d == Univ.Le then
821	821	enforce_leq inst (Universe.make r) cstrs
822		else
	822	else
823	823	try let lev = Option.get (Universe.level inst) in
824	824	Constraint.add (lev, d, r) cstrs
825	825	with Option.IsNone -> failwith "")

853	853	Constraint.fold (fun (l,d,r as cstr) (smallles, noneqs) ->
854	854	if d == Le then
855	855	if Univ.Level.is_small l then
856		if is_set_minimization () then
	856	if is_set_minimization () && LSet.mem r ctx then
857	857	(Constraint.add cstr smallles, noneqs)
858	858	else (smallles, noneqs)
859	859	else if Level.is_small r then

903	903	let noneqs = Constraint.union noneqs smallles in
904	904	let partition = UF.partition uf in
905	905	let flex x = LMap.mem x us in
906		let ctx, subst, eqs = List.fold_left (fun (ctx, subst, cstrs) s ->
	906	let ctx, subst, us, eqs = List.fold_left (fun (ctx, subst, us, cstrs) s ->
907	907	let canon, (global, rigid, flexible) = choose_canonical ctx flex algs s in
908	908	(* Add equalities for globals which can't be merged anymore. *)
909	909	let cstrs = LSet.fold (fun g cst ->
910	910	Constraint.add (canon, Univ.Eq, g) cst) global
911	911	cstrs
912	912	in
	913	(* Also add equalities for rigid variables *)
	914	let cstrs = LSet.fold (fun g cst ->
	915	Constraint.add (canon, Univ.Eq, g) cst) rigid
	916	cstrs
	917	in
913	918	let subst = LSet.fold (fun f -> LMap.add f canon) rigid subst in
914		let subst = LSet.fold (fun f -> LMap.add f canon) flexible subst in
915		(LSet.diff (LSet.diff ctx rigid) flexible, subst, cstrs))
916		(ctx, LMap.empty, Constraint.empty) partition
	919	let subst = LSet.fold (fun f -> LMap.add f canon) flexible subst in
	920	let canonu = Some (Universe.make canon) in
	921	let us = LSet.fold (fun f -> LMap.add f canonu) flexible us in
	922	(LSet.diff ctx flexible, subst, us, cstrs))
	923	(ctx, LMap.empty, us, Constraint.empty) partition
917	924	in
918	925	(* Noneqs is now in canonical form w.r.t. equality constraints,
919	926	and contains only inequality constraints. *)
920	927	let noneqs = subst_univs_level_constraints subst noneqs in
921		let us = LMap.fold (fun u v acc -> LMap.add u (Some (Universe.make v)) acc) subst us in
922	928	(* Compute the left and right set of flexible variables, constraints
923	929	mentionning other variables remain in noneqs. *)
924	930	let noneqs, ucstrsl, ucstrsr =

+1

-1

library/universes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+42

-25

man/coqdep.1 less more

45	45	commands and
46	46	.IR Load \&
47	47	commands. Dependencies relative to modules from the Coq library are not
48		printed.
	48	printed except if
	49	.BR \-boot \&
	50	is given.
49	51
50	52	Dependencies of Caml modules are computed by looking at
51	53	.IR open \&

58	60	.BI \-c
59	61	Prints the dependencies of Caml modules.
60	62	(On Caml modules, the behaviour is exactly the same as ocamldep).
61		.TP
62		.BI \-w
63		Prints a warning if a Coq command
64		.IR Declare \&
65		.IR ML \&
66		.IR Module \&
67		is incorrect. (For instance, you wrote `Declare ML Module "A".',
68		but the module A contains #open "B"). The correct command is printed
69		(see option \-D). The warning is printed on standard error.
70		.TP
71		.BI \-D
72		This commands looks for every command
73		.IR Declare \&
74		.IR ML \&
75		.IR Module \&
76		of each Coq file given as argument and complete (if needed)
77		the list of Caml modules. The new command is printed on
78		the standard output. No dependency is computed with this option.
79		.TP
80		.BI \-I \ directory
81		The files .v .ml .mli of the directory
82		.IR directory \&
83		are taken into account during the calculus of dependencies,
84		but their own dependencies are not printed.
	63	\" THESE OPTIONS ARE BROKEN CURRENTLY
	64	\" .TP
	65	\" .BI \-w
	66	\" Prints a warning if a Coq command
	67	\" .IR Declare \&
	68	\" .IR ML \&
	69	\" .IR Module \&
	70	\" is incorrect. (For instance, you wrote `Declare ML Module "A".',
	71	\" but the module A contains #open "B"). The correct command is printed
	72	\" (see option \-D). The warning is printed on standard error.
	73	\" .TP
	74	\" .BI \-D
	75	\" This commands looks for every command
	76	\" .IR Declare \&
	77	\" .IR ML \&
	78	\" .IR Module \&
	79	\" of each Coq file given as argument and complete (if needed)
	80	\" the list of Caml modules. The new command is printed on
	81	\" the standard output. No dependency is computed with this option.
	82	.TP
	83	.BI \-I/\-Q/\-R \ options
	84	Have the same effects on load path and modules names than for other
	85	coq commands (coqtop, coqc).
85	86	.TP
86	87	.BI \-coqlib \ directory
87	88	Indicates where is the Coq library. The default value has been
88	89	determined at installation time, and therefore this option should not
89	90	be used under normal circumstances.
	91	.TP
	92	.BI \-dumpgraph[box] \ file
	93	Dumps a dot dependency graph in file
	94	.IR file \&.
	95	.TP
	96	.BI \-exclude-dir \ dir
	97	Skips subdirectory
	98	.IR dir \ during
	99	.BR -R/-Q \ search.
	100	.TP
	101	.B \-sort
	102	Output the given file name ordered by dependencies.
	103	.TP
	104	.B \-boot
	105	For coq developpers, prints dependencies over coq library files
	106	(omitted by default).
90	107
91	108
92	109	.SH SEE ALSO

+6

-0

man/coqide.1 less more

122	122	.TP
123	123	.B \-dont\-load\-proofs
124	124	Don't load opaque proofs in memory.
	125	.TP
	126	.B \-xml
	127	Export XML files either to the hierarchy rooted in
	128	the directory
	129	.B COQ_XML_LIBRARY_ROOT
	130	(if set) or to stdout (if unset).
125	131
126	132
127	133	.SH SEE ALSO

+6

-0

man/coqtop.1 less more

152	152	.B \-dont\-load\-proofs
153	153	don't load opaque proofs in memory
154	154
	155	.TP
	156	.B \-xml
	157	export XML files either to the hierarchy rooted in
	158	the directory $COQ_XML_LIBRARY_ROOT (if set) or to
	159	stdout (if unset)
	160
155	161	.SH SEE ALSO
156	162
157	163	.BR coqc (1),

+1

-1

parsing/compat.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

parsing/egramcoq.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

parsing/egramcoq.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

parsing/egramml.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

parsing/egramml.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

parsing/g_constr.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

217	217	CGeneralization (!@loc, Implicit, None, c)
218	218	\| "`("; c = operconstr LEVEL "200"; ")" ->
219	219	CGeneralization (!@loc, Explicit, None, c)
220		\| "$("; tac = Tactic.tactic; ")$" ->
	220	\| "ltac:"; "("; tac = Tactic.tactic_expr; ")" ->
221	221	let arg = Genarg.in_gen (Genarg.rawwit Constrarg.wit_tactic) tac in
222	222	CHole (!@loc, None, IntroAnonymous, Some arg)
223	223	] ]

+3

-3

parsing/g_ltac.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

133	133	;
134	134	(* Tactic arguments *)
135	135	tactic_arg:
136		[ [ IDENT "ltac"; ":"; a = tactic_expr LEVEL "0" -> arg_of_expr a
137		\| IDENT "ltac"; ":"; n = natural -> TacGeneric (genarg_of_int n)
	136	[ [ "ltac:"; a = tactic_expr LEVEL "0" -> arg_of_expr a
	137	\| "ltac:"; n = natural -> TacGeneric (genarg_of_int n)
138	138	\| a = tactic_top_or_arg -> a
139	139	\| r = reference -> Reference r
140	140	\| c = Constr.constr -> ConstrMayEval (ConstrTerm c)

+1

-1

parsing/g_prim.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

parsing/g_proofs.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+27

-5

parsing/g_tactic.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

39	39	\| IDENT _ ->
40	40	(match get_tok (stream_nth 2 strm) with
41	41	\| KEYWORD ":=" -> ()
	42	\| _ -> err ())
	43	\| _ -> err ())
	44	\| _ -> err ())
	45
	46	(* Hack to recognize "(x)" *)
	47	let test_lpar_id_rpar =
	48	Gram.Entry.of_parser "lpar_id_coloneq"
	49	(fun strm ->
	50	match get_tok (stream_nth 0 strm) with
	51	\| KEYWORD "(" ->
	52	(match get_tok (stream_nth 1 strm) with
	53	\| IDENT _ ->
	54	(match get_tok (stream_nth 2 strm) with
	55	\| KEYWORD ")" -> ()
42	56	\| _ -> err ())
43	57	\| _ -> err ())
44	58	\| _ -> err ())

223	237	;
224	238	induction_arg:
225	239	[ [ n = natural -> (None,ElimOnAnonHyp n)
	240	\| test_lpar_id_rpar; c = constr_with_bindings ->
	241	(Some false,induction_arg_of_constr c)
226	242	\| c = constr_with_bindings -> (None,induction_arg_of_constr c)
227		\| "!"; c = constr_with_bindings -> (Some false,induction_arg_of_constr c)
228	243	] ]
229	244	;
230	245	constr_with_bindings_arg:

295	310	\| "**" -> !@loc, IntroForthcoming false ]]
296	311	;
297	312	simple_intropattern:
	313	[ [ pat = simple_intropattern_closed;
	314	l = LIST0 ["%"; c = operconstr LEVEL "0" -> c] ->
	315	let loc0,pat = pat in
	316	let f c pat =
	317	let loc = Loc.merge loc0 (Constrexpr_ops.constr_loc c) in
	318	IntroAction (IntroApplyOn (c,(loc,pat))) in
	319	!@loc, List.fold_right f l pat ] ]
	320	;
	321	simple_intropattern_closed:
298	322	[ [ pat = or_and_intropattern -> !@loc, IntroAction (IntroOrAndPattern pat)
299	323	\| pat = equality_intropattern -> !@loc, IntroAction pat
300	324	\| "_" -> !@loc, IntroAction IntroWildcard
301		\| pat = simple_intropattern; "/"; c = constr ->
302		!@loc, IntroAction (IntroApplyOn (c,pat))
303	325	\| pat = naming_intropattern -> !@loc, IntroNaming pat ] ]
304	326	;
305	327	simple_binding:

398	420	\| -> [] ] ]
399	421	;
400	422	in_hyp_as:
401		[ [ "in"; id = id_or_meta; ipat = as_ipat -> Some (None,id,ipat)
	423	[ [ "in"; id = id_or_meta; ipat = as_ipat -> Some (id,ipat)
402	424	\| -> None ] ]
403	425	;
404	426	orient:

+1

-1

parsing/g_vernac.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-1

parsing/lexer.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

297	297	\| [< 'c; s >] -> string in_comments bp (store len c) s
298	298	\| [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_string
299	299
	300	(* Hook for exporting comment into xml theory files *)
	301	let (f_xml_output_comment, xml_output_comment) = Hook.make ~default:ignore ()
	302
300	303	(* Utilities for comments in beautify *)
301	304	let comment_begin = ref None
302	305	let comm_loc bp = match !comment_begin with

339	342
340	343	let comment_stop ep =
341	344	let current_s = Buffer.contents current in
	345	if !Flags.xml_export && Buffer.length current > 0 &&
	346	(!between_com \|\| not(null_comment current_s)) then
	347	Hook.get f_xml_output_comment current_s;
342	348	(if Flags.do_beautify() && Buffer.length current > 0 &&
343	349	(!between_com \|\| not(null_comment current_s)) then
344	350	let bp = match !comment_begin with

+3

-1

parsing/lexer.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

28	28	val com_state: unit -> com_state
29	29	val restore_com_state: com_state -> unit
30	30
	31	val xml_output_comment : (string -> unit) Hook.t
	32
31	33	val terminal : string -> Tok.t
32	34
33	35	(** The lexer of Coq: *)

+1

-1

parsing/pcoq.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

parsing/pcoq.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-1

parsing/tok.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

20	20	\| EOI
21	21
22	22	let equal t1 t2 = match t1, t2 with
	23	\| IDENT s1, KEYWORD s2 -> CString.equal s1 s2
23	24	\| KEYWORD s1, KEYWORD s2 -> CString.equal s1 s2
24	25	\| METAIDENT s1, METAIDENT s2 -> CString.equal s1 s2
25	26	\| PATTERNIDENT s1, PATTERNIDENT s2 -> CString.equal s1 s2

+1

-1

parsing/tok.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/btauto/g_btauto.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/cc/ccalgo.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-4

plugins/cc/ccalgo.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

19	19	fnargs:int}
20	20
21	21
22		module PafMap : Map.S with type key = pa_fun
23		module PacMap : Map.S with type key = pa_constructor
	22	module PafMap : CSig.MapS with type key = pa_fun
	23	module PacMap : CSig.MapS with type key = pa_constructor
24	24
25	25	type cinfo =
26	26	{ci_constr: pconstructor; (* inductive type *)

184	184	(*type pa_constructor
185	185
186	186
187		module PacMap:Map.S with type key=pa_constructor
	187	module PacMap:CSig.MapS with type key=pa_constructor
188	188
189	189	type term =
190	190	Symb of Term.constr

+1

-1

plugins/cc/ccproof.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/cc/ccproof.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-3

plugins/cc/cctac.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

500	500	let concl = Proofview.Goal.concl gl in
501	501	let cut_eq c1 c2 =
502	502	try (* type_of can raise an exception *)
503		Tacticals.New.tclTHEN
	503	Tacticals.New.tclTHENS
504	504	(mk_eq _eq c1 c2 Tactics.cut)
505		(Tacticals.New.tclTRY ((new_app_global _refl_equal [\|\|]) apply))
	505	[Proofview.tclUNIT ();Tacticals.New.tclTRY ((new_app_global _refl_equal [\|\|]) apply)]
506	506	with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
507	507	in
508	508	Proofview.tclORELSE

+1

-1

plugins/cc/g_congruence.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/decl_expr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/decl_interp.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/decl_interp.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/decl_mode.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/decl_mode.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/decl_proof_instr.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/decl_proof_instr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/g_decl_mode.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/decl_mode/ppdecl_proof.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/derive/derive.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/derive/derive.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/derive/g_derive.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/ExtrOcamlBasic.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/ExtrOcamlBigIntConv.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/ExtrOcamlIntConv.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/ExtrOcamlNatBigInt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/ExtrOcamlNatInt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/ExtrOcamlString.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/ExtrOcamlZBigInt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/ExtrOcamlZInt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/big.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-5

plugins/extraction/common.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

170	170	let ids',avoid' = rename_vars avoid ids in
171	171	ids', (ids' @ db, avoid')
172	172
173		let get_db_name n (db,_) =
174		let id = List.nth db (pred n) in
175		if Id.equal id dummy_name then Id.of_string "__" else id
176
	173	let get_db_name n (db,_) = List.nth db (pred n)
177	174
178	175	(S Renamings of global objects. )
179	176

+1

-1

plugins/extraction/common.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+71

-67

plugins/extraction/extract_env.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

77	77	(* Add reference / ... in the visit lists.
78	78	These functions silently add the mp of their arg in the mp list *)
79	79	val add_ref : global_reference -> unit
	80	val add_kn : kernel_name -> unit
80	81	val add_decl_deps : ml_decl -> unit
81	82	val add_spec_deps : ml_spec -> unit
82	83
83	84	(* Test functions:
84	85	is a particular object a needed dependency for the current extraction ? *)
85	86	val needed_ind : mutual_inductive -> bool
86		val needed_con : constant -> bool
	87	val needed_cst : constant -> bool
87	88	val needed_mp : module_path -> bool
88	89	val needed_mp_all : module_path -> bool
89	90	end
90	91
91	92	module Visit : VISIT = struct
92	93	type must_visit =
93		{ mutable ind : KNset.t; mutable con : KNset.t;
94		mutable mp : MPset.t; mutable mp_all : MPset.t }
	94	{ mutable kn : KNset.t;
	95	mutable mp : MPset.t;
	96	mutable mp_all : MPset.t }
95	97	(* the imperative internal visit lists *)
96		let v = { ind = KNset.empty ; con = KNset.empty ;
97		mp = MPset.empty; mp_all = MPset.empty }
	98	let v = { kn = KNset.empty; mp = MPset.empty; mp_all = MPset.empty }
98	99	(* the accessor functions *)
99	100	let reset () =
100		v.ind <- KNset.empty;
101		v.con <- KNset.empty;
	101	v.kn <- KNset.empty;
102	102	v.mp <- MPset.empty;
103	103	v.mp_all <- MPset.empty
104		let needed_ind i = KNset.mem (user_mind i) v.ind
105		let needed_con c = KNset.mem (user_con c) v.con
	104	let needed_ind i = KNset.mem (user_mind i) v.kn
	105	let needed_cst c = KNset.mem (user_con c) v.kn
106	106	let needed_mp mp = MPset.mem mp v.mp \|\| MPset.mem mp v.mp_all
107	107	let needed_mp_all mp = MPset.mem mp v.mp_all
108	108	let add_mp mp =
109	109	check_loaded_modfile mp; v.mp <- MPset.union (prefixes_mp mp) v.mp
110	110	let add_mp_all mp =
111		check_loaded_modfile mp; v.mp <- MPset.union (prefixes_mp mp) v.mp;
	111	check_loaded_modfile mp;
	112	v.mp <- MPset.union (prefixes_mp mp) v.mp;
112	113	v.mp_all <- MPset.add mp v.mp_all
113		let add_ind i =
114		let kn = user_mind i in
115		v.ind <- KNset.add kn v.ind; add_mp (modpath kn)
116		let add_con c =
117		let kn = user_con c in
118		v.con <- KNset.add kn v.con; add_mp (modpath kn)
	114	let add_kn kn = v.kn <- KNset.add kn v.kn; add_mp (modpath kn)
119	115	let add_ref = function
120		\| ConstRef c -> add_con c
121		\| IndRef (ind,_) \| ConstructRef ((ind,_),_) -> add_ind ind
	116	\| ConstRef c -> add_kn (user_con c)
	117	\| IndRef (ind,_) \| ConstructRef ((ind,_),_) -> add_kn (user_mind ind)
122	118	\| VarRef _ -> assert false
123	119	let add_decl_deps = decl_iter_references add_ref add_ref add_ref
124	120	let add_spec_deps = spec_iter_references add_ref add_ref add_ref
125	121	end
126	122
127	123	let add_field_label mp = function
128		\| (lab, SFBconst _) -> Visit.add_ref (ConstRef (Constant.make2 mp lab))
129		\| (lab, SFBmind _) -> Visit.add_ref (IndRef (MutInd.make2 mp lab, 0))
	124	\| (lab, (SFBconst _\|SFBmind _)) -> Visit.add_kn (KerName.make2 mp lab)
130	125	\| (lab, (SFBmodule _\|SFBmodtype _)) -> Visit.add_mp_all (MPdot (mp,lab))
131	126
132	127	let rec add_labels mp = function

181	176
182	177	let expand_mexpr env mp me =
183	178	let inl = Some (Flags.get_inline_level()) in
184		let sign,_,_,_ = Mod_typing.translate_mse env (Some mp) inl me in
185		sign
	179	Mod_typing.translate_mse env (Some mp) inl me
186	180
187	181	(** Ad-hoc update of environment, inspired by [Mod_type.check_with_aux_def].
188	182	To check with Elie. *)

191	185	\| MEident mp -> mp
192	186	\| MEwith (seb,_) -> mp_of_mexpr seb
193	187	\| _ -> assert false
	188
	189	let no_delta = Mod_subst.empty_delta_resolver
194	190
195	191	let env_for_mtb_with_def env mp me idl =
196	192	let struc = Modops.destr_nofunctor me in
197	193	let l = Label.of_id (List.hd idl) in
198	194	let spot = function (l',SFBconst _) -> Label.equal l l' \| _ -> false in
199	195	let before = fst (List.split_when spot struc) in
200		Modops.add_structure mp before empty_delta_resolver env
	196	Modops.add_structure mp before no_delta env
	197
	198	let make_cst resolver mp l =
	199	Mod_subst.constant_of_delta_kn resolver (KerName.make2 mp l)
	200
	201	let make_mind resolver mp l =
	202	Mod_subst.mind_of_delta_kn resolver (KerName.make2 mp l)
201	203
202	204	(* From a [structure_body] (i.e. a list of [structure_field_body])
203	205	to specifications. *)
204	206
205		let rec extract_structure_spec env mp = function
	207	let rec extract_structure_spec env mp reso = function
206	208	\| [] -> []
207	209	\| (l,SFBconst cb) :: msig ->
208		let kn = Constant.make2 mp l in
209		let s = extract_constant_spec env kn cb in
210		let specs = extract_structure_spec env mp msig in
	210	let c = make_cst reso mp l in
	211	let s = extract_constant_spec env c cb in
	212	let specs = extract_structure_spec env mp reso msig in
211	213	if logical_spec s then specs
212	214	else begin Visit.add_spec_deps s; (l,Spec s) :: specs end
213	215	\| (l,SFBmind _) :: msig ->
214		let mind = MutInd.make2 mp l in
	216	let mind = make_mind reso mp l in
215	217	let s = Sind (mind, extract_inductive env mind) in
216		let specs = extract_structure_spec env mp msig in
	218	let specs = extract_structure_spec env mp reso msig in
217	219	if logical_spec s then specs
218	220	else begin Visit.add_spec_deps s; (l,Spec s) :: specs end
219	221	\| (l,SFBmodule mb) :: msig ->
220		let specs = extract_structure_spec env mp msig in
	222	let specs = extract_structure_spec env mp reso msig in
221	223	let spec = extract_mbody_spec env mb.mod_mp mb in
222	224	(l,Smodule spec) :: specs
223	225	\| (l,SFBmodtype mtb) :: msig ->
224		let specs = extract_structure_spec env mp msig in
	226	let specs = extract_structure_spec env mp reso msig in
225	227	let spec = extract_mbody_spec env mtb.mod_mp mtb in
226	228	(l,Smodtype spec) :: specs
227	229
228	230	(* From [module_expression] to specifications *)
229	231
230		(* Invariant: the [me] given to [extract_mexpr_spec] should either come
231		from a [mod_type] or [type_expr] field, or their [_alg] counterparts.
232		This way, any encountered [MEident] should be a true module type.
233		*)
	232	(* Invariant: the [me_alg] given to [extract_mexpr_spec] and
	233	[extract_mexpression_spec] should come from a [mod_type_alg] field.
	234	This way, any encountered [MEident] should be a true module type. *)
234	235
235	236	and extract_mexpr_spec env mp1 (me_struct,me_alg) = match me_alg with
236	237	\| MEident mp -> Visit.add_mp_all mp; MTident mp

243	244	\| MEwith(me',WithMod(idl,mp))->
244	245	Visit.add_mp_all mp;
245	246	MTwith(extract_mexpr_spec env mp1 (me_struct,me'), ML_With_module(idl,mp))
246		\| MEapply _ -> extract_msignature_spec env mp1 me_struct
	247	\| MEapply _ ->
	248	(* No higher-order module type in OCaml : we use the expanded version *)
	249	extract_msignature_spec env mp1 no_delta (TODO) me_struct
247	250
248	251	and extract_mexpression_spec env mp1 (me_struct,me_alg) = match me_alg with
249	252	\| MoreFunctor (mbid, mtb, me_alg') ->

257	260	extract_mexpression_spec env' mp1 (me_struct',me_alg'))
258	261	\| NoFunctor m -> extract_mexpr_spec env mp1 (me_struct,m)
259	262
260		and extract_msignature_spec env mp1 = function
	263	and extract_msignature_spec env mp1 reso = function
261	264	\| NoFunctor struc ->
262		let env' = Modops.add_structure mp1 struc empty_delta_resolver env in
263		MTsig (mp1, extract_structure_spec env' mp1 struc)
	265	let env' = Modops.add_structure mp1 struc reso env in
	266	MTsig (mp1, extract_structure_spec env' mp1 reso struc)
264	267	\| MoreFunctor (mbid, mtb, me) ->
265	268	let mp = MPbound mbid in
266	269	let env' = Modops.add_module_type mp mtb env in
267	270	MTfunsig (mbid, extract_mbody_spec env mp mtb,
268		extract_msignature_spec env' mp1 me)
	271	extract_msignature_spec env' mp1 reso me)
269	272
270	273	and extract_mbody_spec env mp mb = match mb.mod_type_alg with
271	274	\| Some ty -> extract_mexpression_spec env mp (mb.mod_type,ty)
272		\| None -> extract_msignature_spec env mp mb.mod_type
	275	\| None -> extract_msignature_spec env mp mb.mod_delta mb.mod_type
273	276
274	277	(* From a [structure_body] (i.e. a list of [structure_field_body])
275	278	to implementations.

278	281	important: last to first ensures correct dependencies.
279	282	*)
280	283
281		let rec extract_structure env mp ~all = function
	284	let rec extract_structure env mp reso ~all = function
282	285	\| [] -> []
283	286	\| (l,SFBconst cb) :: struc ->
284	287	(try
285	288	let vl,recd,struc = factor_fix env l cb struc in
286		let vc = Array.map (Constant.make2 mp) vl in
287		let ms = extract_structure env mp ~all struc in
288		let b = Array.exists Visit.needed_con vc in
	289	let vc = Array.map (make_cst reso mp) vl in
	290	let ms = extract_structure env mp reso ~all struc in
	291	let b = Array.exists Visit.needed_cst vc in
289	292	if all \|\| b then
290	293	let d = extract_fixpoint env vc recd in
291	294	if (not b) && (logical_decl d) then ms
292	295	else begin Visit.add_decl_deps d; (l,SEdecl d) :: ms end
293	296	else ms
294	297	with Impossible ->
295		let ms = extract_structure env mp ~all struc in
296		let c = Constant.make2 mp l in
297		let b = Visit.needed_con c in
	298	let ms = extract_structure env mp reso ~all struc in
	299	let c = make_cst reso mp l in
	300	let b = Visit.needed_cst c in
298	301	if all \|\| b then
299	302	let d = extract_constant env c cb in
300	303	if (not b) && (logical_decl d) then ms
301	304	else begin Visit.add_decl_deps d; (l,SEdecl d) :: ms end
302	305	else ms)
303	306	\| (l,SFBmind mib) :: struc ->
304		let ms = extract_structure env mp ~all struc in
305		let mind = MutInd.make2 mp l in
	307	let ms = extract_structure env mp reso ~all struc in
	308	let mind = make_mind reso mp l in
306	309	let b = Visit.needed_ind mind in
307	310	if all \|\| b then
308	311	let d = Dind (mind, extract_inductive env mind) in

310	313	else begin Visit.add_decl_deps d; (l,SEdecl d) :: ms end
311	314	else ms
312	315	\| (l,SFBmodule mb) :: struc ->
313		let ms = extract_structure env mp ~all struc in
	316	let ms = extract_structure env mp reso ~all struc in
314	317	let mp = MPdot (mp,l) in
315	318	let all' = all \|\| Visit.needed_mp_all mp in
316	319	if all' \|\| Visit.needed_mp mp then
317	320	(l,SEmodule (extract_module env mp ~all:all' mb)) :: ms
318	321	else ms
319	322	\| (l,SFBmodtype mtb) :: struc ->
320		let ms = extract_structure env mp ~all struc in
	323	let ms = extract_structure env mp reso ~all struc in
321	324	let mp = MPdot (mp,l) in
322	325	if all \|\| Visit.needed_mp mp then
323	326	(l,SEmodtype (extract_mbody_spec env mp mtb)) :: ms

331	334	(* In Haskell/Scheme, we expand everything.
332	335	For now, we also extract everything, dead code will be removed later
333	336	(see [Modutil.optimize_struct]. *)
334		extract_msignature env mp ~all:true (expand_mexpr env mp me)
	337	let sign,_,delta,_ = expand_mexpr env mp me in
	338	extract_msignature env mp delta ~all:true sign
335	339	\| MEident mp ->
336	340	if is_modfile mp && not (modular ()) then error_MPfile_as_mod mp false;
337	341	Visit.add_mp_all mp; Miniml.MEident mp

349	353	extract_mbody_spec env mp1 mtb,
350	354	extract_mexpression env' mp me)
351	355
352		and extract_msignature env mp ~all = function
	356	and extract_msignature env mp reso ~all = function
353	357	\| NoFunctor struc ->
354		let env' = Modops.add_structure mp struc empty_delta_resolver env in
355		Miniml.MEstruct (mp,extract_structure env' mp ~all struc)
	358	let env' = Modops.add_structure mp struc reso env in
	359	Miniml.MEstruct (mp,extract_structure env' mp reso ~all struc)
356	360	\| MoreFunctor (mbid, mtb, me) ->
357	361	let mp1 = MPbound mbid in
358	362	let env' = Modops.add_module_type mp1 mtb env in
359	363	Miniml.MEfunctor
360	364	(mbid,
361	365	extract_mbody_spec env mp1 mtb,
362		extract_msignature env' mp ~all me)
	366	extract_msignature env' mp reso ~all me)
363	367
364	368	and extract_module env mp ~all mb =
365	369	(* A module has an empty [mod_expr] when :

375	379	(* This module has a signature, otherwise it would be FullStruct.
376	380	We extract just the elements required by this signature. *)
377	381	let () = add_labels mp mb.mod_type in
378		extract_msignature env mp ~all:false sign
379		\| FullStruct -> extract_msignature env mp ~all mb.mod_type
	382	extract_msignature env mp mb.mod_delta ~all:false sign
	383	\| FullStruct -> extract_msignature env mp mb.mod_delta ~all mb.mod_type
380	384	in
381	385	(* Slight optimization: for modules without explicit signatures
382	386	([FullStruct] case), we build the type out of the extracted

398	402	let l = List.rev (environment_until None) in
399	403	List.rev_map
400	404	(fun (mp,struc) ->
401		mp, extract_structure env mp ~all:(Visit.needed_mp_all mp) struc)
	405	mp, extract_structure env mp no_delta ~all:(Visit.needed_mp_all mp) struc)
402	406	l
403	407
404	408	(**************************************)

454	458	push_visible mp [];
455	459	let ans = d.pp_decl decl in
456	460	pop_visible ();
457		ans
	461	v 0 ans
458	462
459	463	(s Extraction of a ml struct to a file. )
460	464

494	498	let d = descr () in
495	499	reset_renaming_tables AllButExternal;
496	500	let unsafe_needs = {
497		mldummy = struct_ast_search ((==) MLdummy) struc;
498		tdummy = struct_type_search Mlutil.isDummy struc;
	501	mldummy = struct_ast_search Mlutil.isMLdummy struc;
	502	tdummy = struct_type_search Mlutil.isTdummy struc;
499	503	tunknown = struct_type_search ((==) Tunknown) struc;
500	504	magic =
501	505	if lang () != Haskell then false

537	541	(if dry then None else si);
538	542	(* Print the buffer content via Coq standard formatter (ok with coqide). *)
539	543	if not (Int.equal (Buffer.length buf) 0) then begin
540		Pp.msg_info (str (Buffer.contents buf));
	544	Pp.msg_notice (str (Buffer.contents buf));
541	545	Buffer.reset buf
542	546	end
543	547

631	635	in
632	636	let ans = flag ++ print_one_decl struc (modpath_of_r r) d in
633	637	reset ();
634		Pp.msg_info ans
	638	Pp.msg_notice ans
635	639	\| _ -> assert false
636	640
637	641

649	653	let l = List.rev (environment_until (Some dir_m)) in
650	654	let select l (mp,struc) =
651	655	if Visit.needed_mp mp
652		then (mp, extract_structure env mp true struc) :: l
	656	then (mp, extract_structure env mp no_delta true struc) :: l
653	657	else l
654	658	in
655	659	let struc = List.fold_left select [] l in

+1

-1

plugins/extraction/extract_env.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+62

-114

plugins/extraction/extraction.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

90	90	let check_default env t =
91	91	match flag_of_type env t with
92	92	\| _,TypeScheme -> raise (NotDefault Ktype)
93		\| Logic,_ -> raise (NotDefault Kother)
	93	\| Logic,_ -> raise (NotDefault Kprop)
94	94	\| _ -> ()
95	95
96	96	let is_info_scheme env t = match flag_of_type env t with

102	102	let rec type_sign env c =
103	103	match kind_of_term (whd_betadeltaiota env none c) with
104	104	\| Prod (n,t,d) ->
105		(if is_info_scheme env t then Keep else Kill Kother)
	105	(if is_info_scheme env t then Keep else Kill Kprop)
106	106	:: (type_sign (push_rel_assum (n,t) env) d)
107	107	\| _ -> []
108	108

136	136	match kind_of_term (whd_betadeltaiota env none c) with
137	137	\| Prod (n,t,d) ->
138	138	let s,vl = type_sign_vl (push_rel_assum (n,t) env) d in
139		if not (is_info_scheme env t) then Kill Kother::s, vl
	139	if not (is_info_scheme env t) then Kill Kprop::s, vl
140	140	else Keep::s, (make_typvar n vl) :: vl
141	141	\| _ -> [],[]
142	142

153	153	let implicits = implicits_of_global r in
154	154	let rec add_impl i = function
155	155	\| [] -> []
156		\| sign::s ->
157		let sign' =
158		if sign == Keep && Int.List.mem i implicits
159		then Kill Kother else sign
160		in sign' :: add_impl (succ i) s
	156	\| Keep::s when Int.Set.mem i implicits ->
	157	Kill (Kimplicit (r,i)) :: add_impl (i+1) s
	158	\| sign::s -> sign :: add_impl (i+1) s
161	159	in
162	160	add_impl (1+nb_params) s
163
164		(* Enriching a exception message *)
165
166		let rec handle_exn r n fn_name = function
167		\| MLexn s ->
168		(try Scanf.sscanf s "UNBOUND %d%!"
169		(fun i ->
170		assert ((0 < i) && (i <= n));
171		MLexn ("IMPLICIT "^ msg_non_implicit r (n+1-i) (fn_name i)))
172		with Scanf.Scan_failure _ \| End_of_file -> MLexn s)
173		\| a -> ast_map (handle_exn r n fn_name) a
174	161
175	162	(S Management of type variable contexts. )
176	163

212	199	\| Rel k -> Int.Map.add (relmax+1-k) j (parse (i+1) (j+1) s)
213	200	\| _ -> parse (i+1) (j+1) s)
214	201	in parse 1 1 si
215
216		let oib_equal o1 o2 =
217		Id.equal o1.mind_typename o2.mind_typename &&
218		List.equal eq_rel_declaration o1.mind_arity_ctxt o2.mind_arity_ctxt &&
219		begin
220		match o1.mind_arity, o2.mind_arity with
221		\| RegularArity {mind_user_arity=c1; mind_sort=s1}, RegularArity {mind_user_arity=c2; mind_sort=s2} ->
222		eq_constr c1 c2 && Sorts.equal s1 s2
223		\| TemplateArity p1, TemplateArity p2 ->
224		let eq o1 o2 = Option.equal Univ.Level.equal o1 o2 in
225		List.equal eq p1.template_param_levels p2.template_param_levels &&
226		Univ.Universe.equal p1.template_level p2.template_level
227		\| _, _ -> false
228		end &&
229		Array.equal Id.equal o1.mind_consnames o2.mind_consnames
230
231		let eq_record x y =
232		Option.equal (Option.equal (fun (_, x, y) (_, x', y') -> Array.for_all2 eq_constant x x')) x y
233
234		let mib_equal m1 m2 =
235		Array.equal oib_equal m1.mind_packets m1.mind_packets &&
236		eq_record m1.mind_record m2.mind_record &&
237		(m1.mind_finite : Decl_kinds.recursivity_kind) == m2.mind_finite &&
238		Int.equal m1.mind_ntypes m2.mind_ntypes &&
239		List.equal eq_named_declaration m1.mind_hyps m2.mind_hyps &&
240		Int.equal m1.mind_nparams m2.mind_nparams &&
241		Int.equal m1.mind_nparams_rec m2.mind_nparams_rec &&
242		List.equal eq_rel_declaration m1.mind_params_ctxt m2.mind_params_ctxt &&
243		(* Univ.UContext.eq ) m1.mind_universes == m2.mind_universes (* FIXME *)
244		(* m1.mind_universes = m2.mind_universes *)
245	202
246	203	(S Extraction of a type. )
247	204

284	241	(match expand env mld with
285	242	\| Tdummy d -> Tdummy d
286	243	\| _ ->
287		let reason = if lvl == TypeScheme then Ktype else Kother in
	244	let reason = if lvl == TypeScheme then Ktype else Kprop in
288	245	Tarr (Tdummy reason, mld)))
289	246	\| Sort _ -> Tdummy Ktype (* The two logical cases. *)
290		\| _ when sort_of env (applist (c, args)) == InProp -> Tdummy Kother
	247	\| _ when sort_of env (applist (c, args)) == InProp -> Tdummy Kprop
291	248	\| Rel n ->
292	249	(match lookup_rel n env with
293	250	\| (_,Some t,_) -> extract_type env db j (lift n t) args

372	329
373	330	and extract_ind env kn = (* kn is supposed to be in long form *)
374	331	let mib = Environ.lookup_mind kn env in
375		try
376		(* For a same kn, we can get various bodies due to module substitutions.
377		We hence check that the mib has not changed from recording
378		time to retrieving time. Ideally we should also check the env. *)
379		let (mib0,ml_ind) = lookup_ind kn in
380		if not (mib_equal mib mib0) then raise Not_found;
381		ml_ind
382		with Not_found ->
	332	match lookup_ind kn mib with
	333	\| Some ml_ind -> ml_ind
	334	\| None ->
383	335	(* First, if this inductive is aliased via a Module,
384	336	we process the original inductive if possible.
385	337	When at toplevel of the monolithic case, we cannot do much

457	409	if p.ip_logical then raise (I Standard);
458	410	if not (Int.equal (Array.length p.ip_types) 1) then raise (I Standard);
459	411	let typ = p.ip_types.(0) in
460		let l = List.filter (fun t -> not (isDummy (expand env t))) typ in
	412	let l = List.filter (fun t -> not (isTdummy (expand env t))) typ in
461	413	if not (keep_singleton ()) &&
462	414	Int.equal (List.length l) 1 && not (type_mem_kn kn (List.hd l))
463	415	then raise (I Singleton);

478	430	let mp = MutInd.modpath kn in
479	431	let rec select_fields l typs = match l,typs with
480	432	\| [],[] -> []
481		\| _::l, typ::typs when isDummy (expand env typ) ->
	433	\| _::l, typ::typs when isTdummy (expand env typ) ->
482	434	select_fields l typs
483	435	\| Anonymous::l, typ::typs ->
484	436	None :: (select_fields l typs)

535	487	(s Recording the ML type abbreviation of a Coq type scheme constant. )
536	488
537	489	and mlt_env env r = match r with
	490	\| IndRef _ \| ConstructRef _ \| VarRef _ -> None
538	491	\| ConstRef kn ->
539		(try
540		if not (visible_con kn) then raise Not_found;
541		match lookup_term kn with
542		\| Dtype (_,vl,mlt) -> Some mlt
	492	let cb = Environ.lookup_constant kn env in
	493	match cb.const_body with
	494	\| Undef _ \| OpaqueDef _ -> None
	495	\| Def l_body ->
	496	match lookup_typedef kn cb with
	497	\| Some _ as o -> o
	498	\| None ->
	499	let typ = Typeops.type_of_constant_type env cb.const_type
	500	(* FIXME not sure if we should instantiate univs here *) in
	501	match flag_of_type env typ with
	502	\| Info,TypeScheme ->
	503	let body = Mod_subst.force_constr l_body in
	504	let s = type_sign env typ in
	505	let db = db_from_sign s in
	506	let t = extract_type_scheme env db body (List.length s)
	507	in add_typedef kn cb t; Some t
543	508	\| _ -> None
544		with Not_found ->
545		let cb = Environ.lookup_constant kn env in
546		let typ = Typeops.type_of_constant_type env cb.const_type
547		(* FIXME not sure if we should instantiate univs here *) in
548		match cb.const_body with
549		\| Undef _ \| OpaqueDef _ -> None
550		\| Def l_body ->
551		(match flag_of_type env typ with
552		\| Info,TypeScheme ->
553		let body = Mod_subst.force_constr l_body in
554		let s,vl = type_sign_vl env typ in
555		let db = db_from_sign s in
556		let t = extract_type_scheme env db body (List.length s)
557		in add_term kn (Dtype (r, vl, t)); Some t
558		\| _ -> None))
559		\| _ -> None
560	509
561	510	and expand env = type_expand (mlt_env env)
562	511	and type2signature env = type_to_signature (mlt_env env)

567	516	(s Extraction of the type of a constant. )
568	517
569	518	let record_constant_type env kn opt_typ =
570		try
571		if not (visible_con kn) then raise Not_found;
572		lookup_type kn
573		with Not_found ->
574		let typ = match opt_typ with
575		\| None -> Typeops.type_of_constant_type env (lookup_constant kn env).const_type
576		\| Some typ -> typ
577		in let mlt = extract_type env [] 1 typ []
578		in let schema = (type_maxvar mlt, mlt)
579		in add_type kn schema; schema
	519	let cb = lookup_constant kn env in
	520	match lookup_cst_type kn cb with
	521	\| Some schema -> schema
	522	\| None ->
	523	let typ = match opt_typ with
	524	\| None -> Typeops.type_of_constant_type env cb.const_type
	525	\| Some typ -> typ
	526	in
	527	let mlt = extract_type env [] 1 typ [] in
	528	let schema = (type_maxvar mlt, mlt) in
	529	let () = add_cst_type kn cb schema in
	530	schema
580	531
581	532	(S Extraction of a term. )
582	533

654	605	try check_default env (type_of env c);
655	606	extract_term env mle mlt c []
656	607	with NotDefault d ->
657		put_magic (mlt, Tdummy d) MLdummy
	608	put_magic (mlt, Tdummy d) (MLdummy d)
658	609
659	610	(s Generic way to deal with an application. )
660	611

722	673	else mla
723	674	with e when Errors.noncritical e -> mla
724	675	in
725		(* For strict languages, purely logical signatures with at least
726		one [Kill Kother] lead to a dummy lam. So a [MLdummy] is left
	676	(* For strict languages, purely logical signatures lead to a dummy lam
	677	(except when [Kill Ktype] everywhere). So a [MLdummy] is left
727	678	accordingly. *)
728	679	let optdummy = match sign_kind s_full with
729		\| UnsafeLogicalSig when lang () != Haskell -> [MLdummy]
	680	\| UnsafeLogicalSig when lang () != Haskell -> [MLdummy Kprop]
730	681	\| _ -> []
731	682	in
732	683	(* Different situations depending of the number of arguments: *)
733	684	if la >= ls
734	685	then
735	686	(* Enough args, cleanup already done in [mla], we only add the
736		additionnal dummy if needed. *)
	687	additional dummy if needed. *)
737	688	put_magic_if (magic2 && not magic1) (mlapp head (optdummy @ mla))
738	689	else
739	690	(* Partially applied function with some logical arg missing.

747	698	(s Extraction of an inductive constructor applied to arguments. )
748	699
749	700	(* \begin{itemize}
750		\item In ML, contructor arguments are uncurryfied.
	701	\item In ML, constructor arguments are uncurryfied.
751	702	\item We managed to suppress logical parts inside inductive definitions,
752	703	but they must appears outside (for partial applications for instance)
753	704	\item We also suppressed all Coq parameters to the inductives, since

825	776	(* Logical singleton case: *)
826	777	(* [match c with C i j k -> t] becomes [t'] *)
827	778	assert (Int.equal br_size 1);
828		let s = iterate (fun l -> Kill Kother :: l) ni.(0) [] in
829		let mlt = iterate (fun t -> Tarr (Tdummy Kother, t)) ni.(0) mlt in
	779	let s = iterate (fun l -> Kill Kprop :: l) ni.(0) [] in
	780	let mlt = iterate (fun t -> Tarr (Tdummy Kprop, t)) ni.(0) mlt in
830	781	let e = extract_maybe_term env mle mlt br.(0) in
831	782	snd (case_expunge s e)
832	783	end

850	801	let e = extract_maybe_term env mle (type_recomp (l,mlt)) br.(i) in
851	802	(* We suppress dummy arguments according to signature. *)
852	803	let ids,e = case_expunge s e in
853		let e' = handle_exn r (List.length s) (fun _ -> Anonymous) e in
854		(List.rev ids, Pusual r, e')
	804	(List.rev ids, Pusual r, e)
855	805	in
856	806	if mi.ind_kind == Singleton then
857	807	begin

959	909	let e = extract_term env mle t' c [] in
960	910	(* Expunging term and type from dummy lambdas. *)
961	911	let trm = term_expunge s (ids,e) in
962		let trm = handle_exn (ConstRef kn) n (fun i -> fst (List.nth rels (i-1))) trm
963		in
964	912	trm, type_expunge_from_sign env s t
965	913
966	914	(* Extracts the type of an axiom, honors the Extraction Implicit declaration. *)

978	926
979	927	let extract_fixpoint env vkn (fi,ti,ci) =
980	928	let n = Array.length vkn in
981		let types = Array.make n (Tdummy Kother)
982		and terms = Array.make n MLdummy in
	929	let types = Array.make n (Tdummy Kprop)
	930	and terms = Array.make n (MLdummy Kprop) in
983	931	let kns = Array.to_list vkn in
984	932	current_fixpoints := kns;
985	933	(* for replacing recursive calls [Rel ..] by the corresponding [Const]: *)

1021	969	in
1022	970	match flag_of_type env typ with
1023	971	\| (Logic,TypeScheme) -> warn_log (); Dtype (r, [], Tdummy Ktype)
1024		\| (Logic,Default) -> warn_log (); Dterm (r, MLdummy, Tdummy Kother)
	972	\| (Logic,Default) -> warn_log (); Dterm (r, MLdummy Kprop, Tdummy Kprop)
1025	973	\| (Info,TypeScheme) ->
1026	974	(match cb.const_body with
1027	975	\| Undef _ -> warn_info (); mk_typ_ax ()

1046	994	let typ = Typeops.type_of_constant_type env cb.const_type in
1047	995	match flag_of_type env typ with
1048	996	\| (Logic, TypeScheme) -> Stype (r, [], Some (Tdummy Ktype))
1049		\| (Logic, Default) -> Sval (r, Tdummy Kother)
	997	\| (Logic, Default) -> Sval (r, Tdummy Kprop)
1050	998	\| (Info, TypeScheme) ->
1051	999	let s,vl = type_sign_vl env typ in
1052	1000	(match cb.const_body with

1074	1022	reset_meta_count ();
1075	1023	let typ = type_of env c in
1076	1024	match flag_of_type env typ with
1077		\| (_,TypeScheme) -> MLdummy, Tdummy Ktype
1078		\| (Logic,_) -> MLdummy, Tdummy Kother
	1025	\| (_,TypeScheme) -> MLdummy Ktype, Tdummy Ktype
	1026	\| (Logic,_) -> MLdummy Kprop, Tdummy Kprop
1079	1027	\| (Info,Default) ->
1080	1028	let mlt = extract_type env [] 1 typ [] in
1081	1029	extract_term env Mlenv.empty mlt c [], mlt

1089	1037	\| [] -> []
1090	1038	\| t::l ->
1091	1039	let l' = filter (succ i) l in
1092		if isDummy (expand env t) \|\| Int.List.mem i implicits then l'
	1040	if isTdummy (expand env t) \|\| Int.Set.mem i implicits then l'
1093	1041	else t::l'
1094	1042	in filter (1+ind.ind_nparams) l
1095	1043	in

1101	1049	(s Is a [ml_decl] logical ? )
1102	1050
1103	1051	let logical_decl = function
1104		\| Dterm (_,MLdummy,Tdummy _) -> true
	1052	\| Dterm (_,MLdummy _,Tdummy _) -> true
1105	1053	\| Dtype (_,[],Tdummy _) -> true
1106	1054	\| Dfix (_,av,tv) ->
1107		(Array.for_all ((==) MLdummy) av) &&
1108		(Array.for_all isDummy tv)
	1055	(Array.for_all isMLdummy av) &&
	1056	(Array.for_all isTdummy tv)
1109	1057	\| Dind (_,i) -> Array.for_all (fun ip -> ip.ip_logical) i.ind_packets
1110	1058	\| _ -> false
1111	1059

+1

-1

plugins/extraction/extraction.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/g_extraction.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+50

-39

plugins/extraction/haskell.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

34	34	let pp_comment s = str "-- " ++ s ++ fnl ()
35	35	let pp_bracket_comment s = str"{- " ++ hov 0 s ++ str" -}"
36	36
	37	(* Note: do not shorten [str "foo" ++ fnl ()] into [str "foo\n"],
	38	the '\n' character interacts badly with the Format boxing mechanism *)
	39
37	40	let preamble mod_name comment used_modules usf =
38		let pp_import mp = str ("import qualified "^ string_of_modfile mp ^"\n")
	41	let pp_import mp = str ("import qualified "^ string_of_modfile mp) ++ fnl ()
39	42	in
40	43	(if not (usf.magic \|\| usf.tunknown) then mt ()
41	44	else
42	45	str "{-# OPTIONS_GHC -cpp -XMagicHash #-}" ++ fnl () ++
43		str "{- For Hugs, use the option -F\"cpp -P -traditional\" -}")
44		++ fnl () ++ fnl ()
	46	str "{- For Hugs, use the option -F\"cpp -P -traditional\" -}" ++ fnl2 ())
45	47	++
46	48	(match comment with
47	49	\| None -> mt ()
48		\| Some com -> pp_bracket_comment com ++ fnl () ++ fnl ())
	50	\| Some com -> pp_bracket_comment com ++ fnl2 ())
49	51	++
50	52	str "module " ++ pr_upper_id mod_name ++ str " where" ++ fnl2 () ++
51	53	str "import qualified Prelude" ++ fnl () ++
52		prlist pp_import used_modules ++ fnl () ++
53		(if List.is_empty used_modules then mt () else fnl ()) ++
	54	prlist pp_import used_modules ++ fnl ()
	55	++
54	56	(if not (usf.magic \|\| usf.tunknown) then mt ()
55		else str "\
56		\n#ifdef __GLASGOW_HASKELL__\
57		\nimport qualified GHC.Base\
58		\nimport qualified GHC.Prim\
59		\n#else\
60		\n-- HUGS\
61		\nimport qualified IOExts\
62		\n#endif" ++ fnl2 ())
	57	else
	58	str "#ifdef __GLASGOW_HASKELL__" ++ fnl () ++
	59	str "import qualified GHC.Base" ++ fnl () ++
	60	str "import qualified GHC.Prim" ++ fnl () ++
	61	str "#else" ++ fnl () ++
	62	str "-- HUGS" ++ fnl () ++
	63	str "import qualified IOExts" ++ fnl () ++
	64	str "#endif" ++ fnl2 ())
63	65	++
64	66	(if not usf.magic then mt ()
65		else str "\
66		\n#ifdef __GLASGOW_HASKELL__\
67		\nunsafeCoerce :: a -> b\
68		\nunsafeCoerce = GHC.Base.unsafeCoerce#\
69		\n#else\
70		\n-- HUGS\
71		\nunsafeCoerce :: a -> b\
72		\nunsafeCoerce = IOExts.unsafeCoerce\
73		\n#endif" ++ fnl2 ())
	67	else
	68	str "#ifdef __GLASGOW_HASKELL__" ++ fnl () ++
	69	str "unsafeCoerce :: a -> b" ++ fnl () ++
	70	str "unsafeCoerce = GHC.Base.unsafeCoerce#" ++ fnl () ++
	71	str "#else" ++ fnl () ++
	72	str "-- HUGS" ++ fnl () ++
	73	str "unsafeCoerce :: a -> b" ++ fnl () ++
	74	str "unsafeCoerce = IOExts.unsafeCoerce" ++ fnl () ++
	75	str "#endif" ++ fnl2 ())
74	76	++
75	77	(if not usf.tunknown then mt ()
76		else str "\
77		\n#ifdef __GLASGOW_HASKELL__\
78		\ntype Any = GHC.Prim.Any\
79		\n#else\
80		\n-- HUGS\
81		\ntype Any = ()\
82		\n#endif" ++ fnl2 ())
	78	else
	79	str "#ifdef __GLASGOW_HASKELL__" ++ fnl () ++
	80	str "type Any = GHC.Prim.Any" ++ fnl () ++
	81	str "#else" ++ fnl () ++
	82	str "-- HUGS" ++ fnl () ++
	83	str "type Any = ()" ++ fnl () ++
	84	str "#endif" ++ fnl2 ())
83	85	++
84	86	(if not usf.mldummy then mt ()
85		else str "__ :: any" ++ fnl () ++
86		str "__ = Prelude.error \"Logical or arity value used\"" ++ fnl2 ())
	87	else
	88	str "__ :: any" ++ fnl () ++
	89	str "__ = Prelude.error \"Logical or arity value used\"" ++ fnl2 ())
87	90
88	91	let pp_abst = function
89	92	\| [] -> (mt ())

119	122	(pp_rec true t1 ++ spc () ++ str "->" ++ spc () ++ pp_rec false t2)
120	123	\| Tdummy _ -> str "()"
121	124	\| Tunknown -> str "Any"
122		\| Taxiom -> str "() -- AXIOM TO BE REALIZED\n"
	125	\| Taxiom -> str "() -- AXIOM TO BE REALIZED" ++ fnl ()
123	126	in
124	127	hov 0 (pp_rec par t)
125	128

139	142	and apply2 st = pp_apply2 st par args in
140	143	function
141	144	\| MLrel n ->
142		let id = get_db_name n env in apply (pr_id id)
	145	let id = get_db_name n env in
	146	(* Try to survive to the occurrence of a Dummy rel.
	147	TODO: we should get rid of this hack (cf. #592) *)
	148	let id = if Id.equal id dummy_name then Id.of_string "__" else id in
	149	apply (pr_id id)
143	150	\| MLapp (f,args') ->
144	151	let stl = List.map (pp_expr true env []) args' in
145	152	pp_expr par env (stl @ args) f

199	206	\| MLexn s ->
200	207	(* An [MLexn] may be applied, but I don't really care. *)
201	208	pp_par par (str "Prelude.error" ++ spc () ++ qs s)
202		\| MLdummy ->
203		str "__" (* An [MLdummy] may be applied, but I don't really care. *)
	209	\| MLdummy k ->
	210	(* An [MLdummy] may be applied, but I don't really care. *)
	211	(match msg_of_implicit k with
	212	\| "" -> str "__"
	213	\| s -> str "__" ++ spc () ++ pp_bracket_comment (str s))
204	214	\| MLmagic a ->
205	215	pp_apply (str "unsafeCoerce") par (pp_expr true env [] a :: args)
206	216	\| MLaxiom -> pp_par par (str "Prelude.error \"AXIOM TO BE REALIZED\"")

319	329	prlist (fun id -> str (id^" ")) ids ++ str "=" ++ spc () ++ str s
320	330	with Not_found ->
321	331	prlist (fun id -> pr_id id ++ str " ") l ++
322		if t == Taxiom then str "= () -- AXIOM TO BE REALIZED\n"
	332	if t == Taxiom then str "= () -- AXIOM TO BE REALIZED" ++ fnl ()
323	333	else str "=" ++ spc () ++ pp_type false l t
324	334	in
325	335	hov 2 (str "type " ++ pp_global Type r ++ spc () ++ st) ++ fnl2 ()

330	340	prvecti
331	341	(fun i r ->
332	342	let void = is_inline_custom r \|\|
333		(not (is_custom r) && match defs.(i) with MLexn "UNUSED" -> true \| _ -> false)
	343	(not (is_custom r) &&
	344	match defs.(i) with MLexn "UNUSED" -> true \| _ -> false)
334	345	in
335	346	if void then mt ()
336	347	else

+1

-1

plugins/extraction/haskell.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/extraction/json.ml less more

152	152	("what", json_str "expr:exception");
153	153	("msg", json_str s)
154	154	]
155		\| MLdummy -> json_dict [("what", json_str "expr:dummy")]
	155	\| MLdummy _ -> json_dict [("what", json_str "expr:dummy")]
156	156	\| MLmagic a -> json_dict [
157	157	("what", json_str "expr:coerce");
158	158	("value", json_expr env a)

+12

-7

plugins/extraction/miniml.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

15	15	object expects, and what these arguments will become in the ML
16	16	object. *)
17	17
18		(* We eliminate from terms: 1) types 2) logical parts.
19		[Kother] stands both for logical or other reasons
20		(for instance user-declared implicit arguments w.r.t. extraction). *)
21
22		type kill_reason = Ktype \| Kother
	18	(* We eliminate from terms:
	19	1) types
	20	2) logical parts
	21	3) user-declared implicit arguments of a constant of constructor
	22	*)
	23
	24	type kill_reason =
	25	\| Ktype
	26	\| Kprop
	27	\| Kimplicit of global_reference * int (* n-th arg of a cst or construct *)
23	28
24	29	type sign = Keep \| Kill of kill_reason
25	30

117	122	\| MLcase of ml_type * ml_ast * ml_branch array
118	123	\| MLfix of int * Id.t array * ml_ast array
119	124	\| MLexn of string
120		\| MLdummy
	125	\| MLdummy of kill_reason
121	126	\| MLaxiom
122	127	\| MLmagic of ml_ast
123	128

+176

-69

plugins/extraction/mlutil.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

298	298
299	299	let isKill = function Kill _ -> true \| _ -> false
300	300
301		let isDummy = function Tdummy _ -> true \| _ -> false
	301	let isTdummy = function Tdummy _ -> true \| _ -> false
	302
	303	let isMLdummy = function MLdummy _ -> true \| _ -> false
302	304
303	305	let sign_of_id = function
304		\| Dummy -> Kill Kother
	306	\| Dummy -> Kill Kprop
305	307	\| _ -> Keep
306	308
307	309	(* Classification of signatures *)

309	311	type sign_kind =
310	312	\| EmptySig
311	313	\| NonLogicalSig (* at least a [Keep] *)
312		\| UnsafeLogicalSig (* No [Keep], at least a [Kill Kother] *)
313	314	\| SafeLogicalSig (* only [Kill Ktype] *)
	315	\| UnsafeLogicalSig (* No [Keep], not all [Kill Ktype] *)
314	316
315	317	let rec sign_kind = function
316	318	\| [] -> EmptySig
317	319	\| Keep :: _ -> NonLogicalSig
318	320	\| Kill k :: s ->
319		match sign_kind s with
320		\| NonLogicalSig -> NonLogicalSig
321		\| UnsafeLogicalSig -> UnsafeLogicalSig
322		\| SafeLogicalSig \| EmptySig ->
323		if k == Kother then UnsafeLogicalSig else SafeLogicalSig
	321	match k, sign_kind s with
	322	\| _, NonLogicalSig -> NonLogicalSig
	323	\| Ktype, (SafeLogicalSig \| EmptySig) -> SafeLogicalSig
	324	\| _, _ -> UnsafeLogicalSig
324	325
325	326	(* Removing the final [Keep] in a signature *)
326	327
327	328	let rec sign_no_final_keeps = function
328	329	\| [] -> []
329	330	\| k :: s ->
330		let s' = k :: sign_no_final_keeps s in
331		match s' with [Keep] -> [] \| _ -> s'
	331	match k, sign_no_final_keeps s with
	332	\| Keep, [] -> []
	333	\| k, l -> k::l
332	334
333	335	(s Removing [Tdummy] from the top level of a ML type. )
334	336
335	337	let type_expunge_from_sign env s t =
336		let rec expunge s t =
337		if List.is_empty s then t else match t with
338		\| Tmeta {contents = Some t} -> expunge s t
339		\| Tarr (a,b) ->
340		let t = expunge (List.tl s) b in
341		if List.hd s == Keep then Tarr (a, t) else t
342		\| Tglob (r,l) ->
343		(match env r with
344		\| Some mlt -> expunge s (type_subst_list l mlt)
345		\| None -> assert false)
346		\| _ -> assert false
	338	let rec expunge s t = match s, t with
	339	\| [], _ -> t
	340	\| Keep :: s, Tarr(a,b) -> Tarr (a, expunge s b)
	341	\| Kill _ :: s, Tarr(a,b) -> expunge s b
	342	\| _, Tmeta {contents = Some t} -> expunge s t
	343	\| _, Tglob (r,l) ->
	344	(match env r with
	345	\| Some mlt -> expunge s (type_subst_list l mlt)
	346	\| None -> assert false)
	347	\| _ -> assert false
347	348	in
348	349	let t = expunge (sign_no_final_keeps s) t in
349	350	if lang () != Haskell && sign_kind s == UnsafeLogicalSig then
350		Tarr (Tdummy Kother, t)
	351	Tarr (Tdummy Kprop, t)
351	352	else t
352	353
353	354	let type_expunge env t =

384	385	\| MLfix (i1, id1, t1), MLfix (i2, id2, t2) ->
385	386	Int.equal i1 i2 && Array.equal Id.equal id1 id2 && Array.equal eq_ml_ast t1 t2
386	387	\| MLexn e1, MLexn e2 -> String.equal e1 e2
387		\| MLdummy, MLdummy -> true
	388	\| MLdummy k1, MLdummy k2 -> k1 == k2
388	389	\| MLaxiom, MLaxiom -> true
389	390	\| MLmagic t1, MLmagic t2 -> eq_ml_ast t1 t2
390	391	\| _ -> false

419	420	\| MLapp (a,l) -> iter n a; List.iter (iter n) l
420	421	\| MLcons (_,_,l) \| MLtuple l -> List.iter (iter n) l
421	422	\| MLmagic a -> iter n a
422		\| MLglob _ \| MLexn _ \| MLdummy \| MLaxiom -> ()
	423	\| MLglob _ \| MLexn _ \| MLdummy _ \| MLaxiom -> ()
423	424	in iter 0
424	425
425	426	(s Map over asts. )

438	439	\| MLcons (typ,c,l) -> MLcons (typ,c, List.map f l)
439	440	\| MLtuple l -> MLtuple (List.map f l)
440	441	\| MLmagic a -> MLmagic (f a)
441		\| MLrel _ \| MLglob _ \| MLexn _ \| MLdummy \| MLaxiom as a -> a
	442	\| MLrel _ \| MLglob _ \| MLexn _ \| MLdummy _ \| MLaxiom as a -> a
442	443
443	444	(s Map over asts, with binding depth as parameter. )
444	445

456	457	\| MLcons (typ,c,l) -> MLcons (typ,c, List.map (f n) l)
457	458	\| MLtuple l -> MLtuple (List.map (f n) l)
458	459	\| MLmagic a -> MLmagic (f n a)
459		\| MLrel _ \| MLglob _ \| MLexn _ \| MLdummy \| MLaxiom as a -> a
	460	\| MLrel _ \| MLglob _ \| MLexn _ \| MLdummy _ \| MLaxiom as a -> a
460	461
461	462	(s Iter over asts. )
462	463

470	471	\| MLapp (a,l) -> f a; List.iter f l
471	472	\| MLcons (_,_,l) \| MLtuple l -> List.iter f l
472	473	\| MLmagic a -> f a
473		\| MLrel _ \| MLglob _ \| MLexn _ \| MLdummy \| MLaxiom -> ()
	474	\| MLrel _ \| MLglob _ \| MLexn _ \| MLdummy _ \| MLaxiom -> ()
474	475
475	476	(S Operations concerning De Bruijn indices. )
476	477

506	507	\| MLapp (a,l) -> List.fold_left (fun r a -> r+(nb k a)) (nb k a) l
507	508	\| MLcons (_,_,l) \| MLtuple l -> List.fold_left (fun r a -> r+(nb k a)) 0 l
508	509	\| MLmagic a -> nb k a
509		\| MLglob _ \| MLexn _ \| MLdummy \| MLaxiom -> 0
	510	\| MLglob _ \| MLexn _ \| MLdummy _ \| MLaxiom -> 0
510	511	in nb 1
	512
	513	(* Replace unused variables by _ *)
	514
	515	let dump_unused_vars a =
	516	let rec ren env a = match a with
	517	\| MLrel i ->
	518	let () = (List.nth env (i-1)) := true in a
	519
	520	\| MLlam (id,b) ->
	521	let occ_id = ref false in
	522	let b' = ren (occ_id::env) b in
	523	if !occ_id then if b' == b then a else MLlam(id,b')
	524	else MLlam(Dummy,b')
	525
	526	\| MLletin (id,b,c) ->
	527	let occ_id = ref false in
	528	let b' = ren env b in
	529	let c' = ren (occ_id::env) c in
	530	if !occ_id then
	531	if b' == b && c' == c then a else MLletin(id,b',c')
	532	else
	533	(* 'let' without occurrence: shouldn't happen after simpl *)
	534	MLletin(Dummy,b',c')
	535
	536	\| MLcase (t,e,br) ->
	537	let e' = ren env e in
	538	let br' = Array.smartmap (ren_branch env) br in
	539	if e' == e && br' == br then a else MLcase (t,e',br')
	540
	541	\| MLfix (i,ids,v) ->
	542	let env' = List.init (Array.length ids) (fun _ -> ref false) @ env in
	543	let v' = Array.smartmap (ren env') v in
	544	if v' == v then a else MLfix (i,ids,v')
	545
	546	\| MLapp (b,l) ->
	547	let b' = ren env b and l' = List.smartmap (ren env) l in
	548	if b' == b && l' == l then a else MLapp (b',l')
	549
	550	\| MLcons(t,r,l) ->
	551	let l' = List.smartmap (ren env) l in
	552	if l' == l then a else MLcons (t,r,l')
	553
	554	\| MLtuple l ->
	555	let l' = List.smartmap (ren env) l in
	556	if l' == l then a else MLtuple l'
	557
	558	\| MLmagic b ->
	559	let b' = ren env b in
	560	if b' == b then a else MLmagic b'
	561
	562	\| MLglob _ \| MLexn _ \| MLdummy _ \| MLaxiom -> a
	563
	564	and ren_branch env ((ids,p,b) as tr) =
	565	let occs = List.map (fun _ -> ref false) ids in
	566	let b' = ren (List.rev_append occs env) b in
	567	let ids' =
	568	List.map2
	569	(fun id occ -> if !occ then id else Dummy)
	570	ids occs
	571	in
	572	if b' == b && List.equal eq_ml_ident ids ids' then tr
	573	else (ids',p,b')
	574	in
	575	ren [] a
511	576
512	577	(*s Lifting on terms.
513	578	[ast_lift k t] lifts the binding depth of [t] across [k] bindings. *)

558	623	if i' < 1 then a
559	624	else if i' <= Array.length v then
560	625	match v.(i'-1) with
561		\| None -> MLexn ("UNBOUND " ^ string_of_int i')
	626	\| None -> assert false
562	627	\| Some u -> ast_lift n u
563	628	else MLrel (i+d)
564	629	\| a -> ast_map_lift subst n a

812	877	try h := add k i !h
813	878	with Not_found -> h := (k, Int.Set.singleton i) :: !h
814	879	in
815		let maxf k =
816		let len = ref 0 and lst = ref Int.Set.empty and elm = ref k in
	880	let maxf () =
	881	let len = ref 0 and lst = ref Int.Set.empty and elm = ref MLaxiom in
817	882	List.iter
818	883	(fun (e, s) ->
819	884	let n = Int.Set.cardinal s in

842	907	if o.opt_case_cst then
843	908	(try census_add (branch_as_cst br.(i)) i with Impossible -> ());
844	909	done;
845		let br_factor, br_set = census_max MLdummy in
	910	let br_factor, br_set = census_max () in
846	911	census_clean ();
847	912	let n = Int.Set.cardinal br_set in
848	913	if Int.equal n 0 then None

925	990	in iota 0 hd
926	991
927	992	let is_atomic = function
928		\| MLrel _ \| MLglob _ \| MLexn _ \| MLdummy -> true
	993	\| MLrel _ \| MLglob _ \| MLexn _ \| MLdummy _ -> true
929	994	\| _ -> false
930	995
931	996	let is_imm_apply = function MLapp (MLrel 1, _) -> true \| _ -> false

947	1012
948	1013	(* Some beta-iota reductions + simplifications. *)
949	1014
	1015	let rec unmagic = function MLmagic e -> unmagic e \| e -> e
	1016	let is_magic = function MLmagic _ -> true \| _ -> false
	1017	let magic_hd a = match a with
	1018	\| MLmagic _ :: _ -> a
	1019	\| e :: a -> MLmagic e :: a
	1020	\| [] -> assert false
	1021
950	1022	let rec simpl o = function
951	1023	\| MLapp (f, []) -> simpl o f
952		\| MLapp (f, a) -> simpl_app o (List.map (simpl o) a) (simpl o f)
	1024	\| MLapp (MLapp(f,a),a') -> simpl o (MLapp(f,a@a'))
	1025	\| MLapp (f, a) ->
	1026	(* When the head of the application is magic, no need for magic on args *)
	1027	let a = if is_magic f then List.map unmagic a else a in
	1028	simpl_app o (List.map (simpl o) a) (simpl o f)
953	1029	\| MLcase (typ,e,br) ->
954	1030	let br = Array.map (fun (l,p,t) -> (l,p,simpl o t)) br in
955	1031	simpl_case o typ br (simpl o e)

969	1045	if ast_occurs_itvl 1 n c.(i) then
970	1046	MLfix (i, ids, Array.map (simpl o) c)
971	1047	else simpl o (ast_lift (-n) c.(i)) (* Dummy fixpoint *)
	1048	\| MLmagic(MLmagic _ as e) -> simpl o e
	1049	\| MLmagic(MLapp (f,l)) -> simpl o (MLapp (MLmagic f, l))
	1050	\| MLmagic(MLletin(id,c,e)) -> simpl o (MLletin(id,c,MLmagic e))
	1051	\| MLmagic(MLcase(typ,e,br)) ->
	1052	let br' = Array.map (fun (ids,p,c) -> (ids,p,MLmagic c)) br in
	1053	simpl o (MLcase(typ,e,br'))
	1054	\| MLmagic(MLexn _ as e) -> e
972	1055	\| a -> ast_map (simpl o) a
973	1056
974	1057	(* invariant : list [a] of arguments is non-empty *)
975	1058
976	1059	and simpl_app o a = function
977		\| MLapp (f',a') -> simpl_app o (a'@a) f'
978	1060	\| MLlam (Dummy,t) ->
979	1061	simpl o (MLapp (ast_pop t, List.tl a))
980	1062	\| MLlam (id,t) -> (* Beta redex *)

985	1067	\| _ ->
986	1068	let a' = List.map (ast_lift 1) (List.tl a) in
987	1069	simpl o (MLletin (id, List.hd a, MLapp (t, a'))))
	1070	\| MLmagic (MLlam (id,t)) ->
	1071	(* When we've at least one argument, we permute the magic
	1072	and the lambda, to simplify things a bit (see #2795).
	1073	Alas, the 1st argument must also be magic then. *)
	1074	simpl_app o (magic_hd a) (MLlam (id,MLmagic t))
988	1075	\| MLletin (id,e1,e2) when o.opt_let_app ->
989	1076	(* Application of a letin: we push arguments inside *)
990	1077	MLletin (id, e1, simpl o (MLapp (e2, List.map (ast_lift 1) a)))

997	1084	let a' = List.map (ast_lift k) a in
998	1085	(l, p, simpl o (MLapp (t,a')))) br
999	1086	in simpl o (MLcase (typ,e,br'))
1000		\| (MLdummy \| MLexn _) as e -> e
	1087	\| (MLdummy _ \| MLexn _) as e -> e
1001	1088	(* We just discard arguments in those cases. *)
1002	1089	\| f -> MLapp (f,a)
1003	1090

1048	1135	(*s [kill_some_lams] removes some head lambdas according to the signature [bl].
1049	1136	This list is build on the identifier list model: outermost lambda
1050	1137	is on the right.
1051		[Rels] corresponding to removed lambdas are supposed not to occur, and
	1138	[Rels] corresponding to removed lambdas are not supposed to occur
	1139	(except maybe in the case of Kimplicit), and
1052	1140	the other [Rels] are made correct via a [gen_subst].
1053	1141	Output is not directly a [ml_ast], compose with [named_lams] if needed. *)
	1142
	1143	let is_impl_kill = function Kill (Kimplicit _) -> true \| _ -> false
1054	1144
1055	1145	let kill_some_lams bl (ids,c) =
1056	1146	let n = List.length bl in
1057	1147	let n' = List.fold_left (fun n b -> if b == Keep then (n+1) else n) 0 bl in
1058	1148	if Int.equal n n' then ids,c
1059		else if Int.equal n' 0 then [],ast_lift (-n) c
	1149	else if Int.equal n' 0 && not (List.exists is_impl_kill bl)
	1150	then [],ast_lift (-n) c
1060	1151	else begin
1061	1152	let v = Array.make n None in
1062	1153	let rec parse_ids i j = function
1063	1154	\| [] -> ()
1064	1155	\| Keep :: l -> v.(i) <- Some (MLrel j); parse_ids (i+1) (j+1) l
	1156	\| Kill (Kimplicit _ as k) :: l ->
	1157	v.(i) <- Some (MLdummy k); parse_ids (i+1) j l
1065	1158	\| Kill _ :: l -> parse_ids (i+1) j l
1066	1159	in parse_ids 0 1 bl;
1067	1160	select_via_bl bl ids, gen_subst v (n'-n) c

1069	1162
1070	1163	(*s [kill_dummy_lams] uses the last function to kill the lambdas corresponding
1071	1164	to a [dummy_name]. It can raise [Impossible] if there is nothing to do, or
1072		if there is no lambda left at all. *)
1073
1074		let kill_dummy_lams c =
	1165	if there is no lambda left at all. In addition, it now accepts a signature
	1166	that may mention some implicits. *)
	1167
	1168	let rec merge_implicits ids s = match ids, s with
	1169	\| [],_ -> []
	1170	\| _,[] -> List.map sign_of_id ids
	1171	\| Dummy::ids, _::s -> Kill Kprop :: merge_implicits ids s
	1172	\| _::ids, (Kill (Kimplicit _) as k)::s -> k :: merge_implicits ids s
	1173	\| _::ids, _::s -> Keep :: merge_implicits ids s
	1174
	1175	let kill_dummy_lams sign c =
1075	1176	let ids,c = collect_lams c in
1076		let bl = List.map sign_of_id ids in
	1177	let bl = merge_implicits ids (List.rev sign) in
1077	1178	if not (List.memq Keep bl) then raise Impossible;
1078	1179	let rec fst_kill n = function
1079	1180	\| [] -> raise Impossible

1085	1186	let _, bl = List.chop skip bl in
1086	1187	let c = named_lams ids_skip c in
1087	1188	let ids',c = kill_some_lams bl (ids,c) in
1088		ids, named_lams ids' c
	1189	(ids,bl), named_lams ids' c
1089	1190
1090	1191	(*s [eta_expansion_sign] takes a function [fun idn ... id1 -> c]
1091	1192	and a signature [s] and builds a eta-long version. *)

1099	1200	let a = List.rev_map (function MLrel x -> MLrel (i-x) \| a -> a) rels
1100	1201	in ids, MLapp (ast_lift (i-1) c, a)
1101	1202	\| Keep :: l -> abs (anonymous :: ids) (MLrel i :: rels) (i+1) l
1102		\| Kill _ :: l -> abs (Dummy :: ids) (MLdummy :: rels) (i+1) l
	1203	\| Kill k :: l -> abs (Dummy :: ids) (MLdummy k :: rels) (i+1) l
1103	1204	in abs ids [] 1 s
1104	1205
1105	1206	(*s If [s = [b1; ... ; bn]] then [case_expunge] decomposes [e]
1106	1207	in [n] lambdas (with eta-expansion if needed) and removes all dummy lambdas
1107		corresponding to [Del] in [s]. *)
	1208	corresponding to [Kill _] in [s]. *)
1108	1209
1109	1210	let case_expunge s e =
1110	1211	let m = List.length s in

1122	1223	if List.is_empty s then c
1123	1224	else
1124	1225	let ids,c = kill_some_lams (List.rev s) (ids,c) in
1125		if List.is_empty ids && lang () != Haskell && List.mem (Kill Kother) s then
1126		MLlam (Dummy, ast_lift 1 c)
	1226	if List.is_empty ids && lang () != Haskell &&
	1227	sign_kind s == UnsafeLogicalSig
	1228	then MLlam (Dummy, ast_lift 1 c)
1127	1229	else named_lams ids c
1128	1230
1129		(*s [kill_dummy_args ids r t] looks for occurrences of [MLrel r] in [t] and
1130		purge the args of [MLrel r] corresponding to a [dummy_name].
	1231	(*s [kill_dummy_args (ids,bl) r t] looks for occurrences of [MLrel r] in [t]
	1232	and purge the args of [MLrel r] corresponding to a [Kill] in [bl].
1131	1233	It makes eta-expansion if needed. *)
1132	1234
1133		let kill_dummy_args ids r t =
	1235	let kill_dummy_args (ids,bl) r t =
1134	1236	let m = List.length ids in
1135		let bl = List.rev_map sign_of_id ids in
	1237	let sign = List.rev bl in
1136	1238	let rec found n = function
1137	1239	\| MLrel r' when Int.equal r' (r + n) -> true
1138	1240	\| MLmagic e -> found n e

1143	1245	let k = max 0 (m - (List.length a)) in
1144	1246	let a = List.map (killrec n) a in
1145	1247	let a = List.map (ast_lift k) a in
1146		let a = select_via_bl bl (a @ (eta_args k)) in
	1248	let a = select_via_bl sign (a @ (eta_args k)) in
1147	1249	named_lams (List.firstn k ids) (MLapp (ast_lift k e, a))
1148	1250	\| e when found n e ->
1149		let a = select_via_bl bl (eta_args m) in
	1251	let a = select_via_bl sign (eta_args m) in
1150	1252	named_lams ids (MLapp (ast_lift m e, a))
1151	1253	\| e -> ast_map_lift killrec n e
1152	1254	in killrec 0 t
1153	1255
1154	1256	(s The main function for local [dummy] elimination. )
1155	1257
	1258	let sign_of_args a =
	1259	List.map (function MLdummy k -> Kill k \| _ -> Keep) a
	1260
1156	1261	let rec kill_dummy = function
1157	1262	\| MLfix(i,fi,c) ->
1158	1263	(try
1159		let ids,c = kill_dummy_fix i c in
1160		ast_subst (MLfix (i,fi,c)) (kill_dummy_args ids 1 (MLrel 1))
	1264	let k,c = kill_dummy_fix i c [] in
	1265	ast_subst (MLfix (i,fi,c)) (kill_dummy_args k 1 (MLrel 1))
1161	1266	with Impossible -> MLfix (i,fi,Array.map kill_dummy c))
1162	1267	\| MLapp (MLfix (i,fi,c),a) ->
1163	1268	let a = List.map kill_dummy a in
	1269	(* Heuristics: if some arguments are implicit args, we try to
	1270	eliminate the corresponding arguments of the fixpoint *)
1164	1271	(try
1165		let ids,c = kill_dummy_fix i c in
	1272	let k,c = kill_dummy_fix i c (sign_of_args a) in
1166	1273	let fake = MLapp (MLrel 1, List.map (ast_lift 1) a) in
1167		let fake' = kill_dummy_args ids 1 fake in
	1274	let fake' = kill_dummy_args k 1 fake in
1168	1275	ast_subst (MLfix (i,fi,c)) fake'
1169	1276	with Impossible -> MLapp(MLfix(i,fi,Array.map kill_dummy c),a))
1170	1277	\| MLletin(id, MLfix (i,fi,c),e) ->
1171	1278	(try
1172		let ids,c = kill_dummy_fix i c in
1173		let e = kill_dummy (kill_dummy_args ids 1 e) in
	1279	let k,c = kill_dummy_fix i c [] in
	1280	let e = kill_dummy (kill_dummy_args k 1 e) in
1174	1281	MLletin(id, MLfix(i,fi,c),e)
1175	1282	with Impossible ->
1176	1283	MLletin(id, MLfix(i,fi,Array.map kill_dummy c),kill_dummy e))
1177	1284	\| MLletin(id,c,e) ->
1178	1285	(try
1179		let ids,c = kill_dummy_lams (kill_dummy_hd c) in
1180		let e = kill_dummy (kill_dummy_args ids 1 e) in
	1286	let k,c = kill_dummy_lams [] (kill_dummy_hd c) in
	1287	let e = kill_dummy (kill_dummy_args k 1 e) in
1181	1288	let c = kill_dummy c in
1182	1289	if is_atomic c then ast_subst c e else MLletin (id, c, e)
1183	1290	with Impossible -> MLletin(id,kill_dummy c,kill_dummy e))

1189	1296	\| MLlam(id,e) -> MLlam(id, kill_dummy_hd e)
1190	1297	\| MLletin(id,c,e) ->
1191	1298	(try
1192		let ids,c = kill_dummy_lams (kill_dummy_hd c) in
1193		let e = kill_dummy_hd (kill_dummy_args ids 1 e) in
	1299	let k,c = kill_dummy_lams [] (kill_dummy_hd c) in
	1300	let e = kill_dummy_hd (kill_dummy_args k 1 e) in
1194	1301	let c = kill_dummy c in
1195	1302	if is_atomic c then ast_subst c e else MLletin (id, c, e)
1196	1303	with Impossible -> MLletin(id,kill_dummy c,kill_dummy_hd e))
1197	1304	\| a -> a
1198	1305
1199		and kill_dummy_fix i c =
	1306	and kill_dummy_fix i c s =
1200	1307	let n = Array.length c in
1201		let ids,ci = kill_dummy_lams (kill_dummy_hd c.(i)) in
	1308	let k,ci = kill_dummy_lams s (kill_dummy_hd c.(i)) in
1202	1309	let c = Array.copy c in c.(i) <- ci;
1203	1310	for j = 0 to (n-1) do
1204		c.(j) <- kill_dummy (kill_dummy_args ids (n-i) c.(j))
	1311	c.(j) <- kill_dummy (kill_dummy_args k (n-i) c.(j))
1205	1312	done;
1206		ids,c
	1313	k,c
1207	1314
1208	1315	(s Putting things together. )
1209	1316

1266	1373	\| MLfix(_,_,f) -> ml_size_array f
1267	1374	\| MLletin (_,_,t) -> ml_size t
1268	1375	\| MLmagic t -> ml_size t
1269		\| MLglob _ \| MLrel _ \| MLexn _ \| MLdummy \| MLaxiom -> 0
	1376	\| MLglob _ \| MLrel _ \| MLexn _ \| MLdummy _ \| MLaxiom -> 0
1270	1377
1271	1378	and ml_size_list l = List.fold_left (fun a t -> a + ml_size t) 0 l
1272	1379

+6

-3

plugins/extraction/mlutil.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

66	66	val type_expunge_from_sign : abbrev_map -> signature -> ml_type -> ml_type
67	67
68	68	val eq_ml_type : ml_type -> ml_type -> bool
69		val isDummy : ml_type -> bool
	69	val isTdummy : ml_type -> bool
	70	val isMLdummy : ml_ast -> bool
70	71	val isKill : sign -> bool
71	72
72	73	val case_expunge : signature -> ml_ast -> ml_ident list * ml_ast

109	110
110	111	val ast_glob_subst : ml_ast Refmap'.t -> ml_ast -> ml_ast
111	112
	113	val dump_unused_vars : ml_ast -> ml_ast
	114
112	115	val normalize : ml_ast -> ml_ast
113	116	val optimize_fix : ml_ast -> ml_ast
114	117	val inline : global_reference -> ml_ast -> bool

124	127	type sign_kind =
125	128	\| EmptySig
126	129	\| NonLogicalSig (* at least a [Keep] *)
127		\| UnsafeLogicalSig (* No [Keep], at least a [Kill Kother] *)
128	130	\| SafeLogicalSig (* only [Kill Ktype] *)
	131	\| UnsafeLogicalSig (* No [Keep], not all [Kill Ktype] *)
129	132
130	133	val sign_kind : signature -> sign_kind
131	134

+27

-23

plugins/extraction/modutil.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

99	99	Array.iter (fun (_,p,_) -> patt_iter_references do_cons p) v
100	100
101	101	\| MLrel _ \| MLlam _ \| MLapp _ \| MLletin _ \| MLtuple _ \| MLfix _ \| MLexn _
102		\| MLdummy \| MLaxiom \| MLmagic _ -> ()
	102	\| MLdummy _ \| MLaxiom \| MLmagic _ -> ()
103	103	in iter a
104	104
105	105	let ind_iter_references do_term do_cons do_type kn ind =

268	268	let a = normalize (ast_glob_subst !s a) in
269	269	let i = inline r a in
270	270	if i then s := Refmap'.add r a !s;
271		let d = match optimize_fix a with
	271	let d = match dump_unused_vars (optimize_fix a) with
272	272	\| MLfix (0, _, [\|c\|]) ->
273	273	Dfix ([\|r\|], [\|ast_subst (MLglob r) c\|], [\|t\|])
274	274	\| a -> Dterm (r, a, t)

282	282	if inline rv.(i) fake_body
283	283	then s := Refmap'.add rv.(i) (dfix_to_mlfix rv av i) !s
284	284	done;
285		(l,SEdecl (Dfix (rv, av, tv))) :: (optim_se top to_appear s lse)
	285	let av' = Array.map dump_unused_vars av in
	286	(l,SEdecl (Dfix (rv, av', tv))) :: (optim_se top to_appear s lse)
286	287	\| (l,SEmodule m) :: lse ->
287	288	let m = { m with ml_mod_expr = optim_me to_appear s m.ml_mod_expr}
288	289	in (l,SEmodule m) :: (optim_se top to_appear s lse)

386	387	in
387	388	is_prefix_aux 0
388	389
389		let check_implicits = function
390		\| MLexn s ->
391		if String.length s > 8 && (s.[0] == 'U' \|\| s.[0] == 'I') then
392		begin
393		if is_prefix "UNBOUND" s then assert false;
394		if is_prefix "IMPLICIT" s then
395		error_non_implicit (String.sub s 9 (String.length s - 9));
396		end;
397		false
398		\| _ -> false
	390	exception RemainingImplicit of kill_reason
	391
	392	let check_for_remaining_implicits struc =
	393	let check = function
	394	\| MLdummy (Kimplicit _ as k) -> raise (RemainingImplicit k)
	395	\| _ -> false
	396	in
	397	try ignore (struct_ast_search check struc)
	398	with RemainingImplicit k -> err_or_warn_remaining_implicit k
399	399
400	400	let optimize_struct to_appear struc =
401	401	let subst = ref (Refmap'.empty : ml_ast Refmap'.t) in

403	403	List.map (fun (mp,lse) -> (mp, optim_se true (fst to_appear) subst lse))
404	404	struc
405	405	in
406		ignore (struct_ast_search check_implicits opt_struc);
407		if library () then
408		List.filter (fun (_,lse) -> not (List.is_empty lse)) opt_struc
409		else begin
410		reset_needed ();
411		List.iter add_needed (fst to_appear);
412		List.iter add_needed_mp (snd to_appear);
413		depcheck_struct opt_struc
414		end
	406	let mini_struc =
	407	if library () then
	408	List.filter (fun (_,lse) -> not (List.is_empty lse)) opt_struc
	409	else
	410	begin
	411	reset_needed ();
	412	List.iter add_needed (fst to_appear);
	413	List.iter add_needed_mp (snd to_appear);
	414	depcheck_struct opt_struc
	415	end
	416	in
	417	let () = check_for_remaining_implicits mini_struc in
	418	mini_struc

+1

-1

plugins/extraction/modutil.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+93

-78

plugins/extraction/ocaml.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

54	54	"land"; "lor"; "lxor"; "lsl"; "lsr"; "asr" ; "unit" ; "_" ; "__" ]
55	55	Id.Set.empty
56	56
57		let pp_open mp = str ("open "^ string_of_modfile mp ^"\n")
	57	(* Note: do not shorten [str "foo" ++ fnl ()] into [str "foo\n"],
	58	the '\n' character interacts badly with the Format boxing mechanism *)
	59
	60	let pp_open mp = str ("open "^ string_of_modfile mp) ++ fnl ()
58	61
59	62	let pp_comment s = str "(* " ++ hov 0 s ++ str " *)"
60	63
61	64	let pp_header_comment = function
62	65	\| None -> mt ()
63		\| Some com -> pp_comment com ++ fnl () ++ fnl ()
	66	\| Some com -> pp_comment com ++ fnl2 ()
	67
	68	let then_nl pp = if Pp.is_empty pp then mt () else pp ++ fnl ()
	69
	70	let pp_tdummy usf =
	71	if usf.tdummy \|\| usf.tunknown then str "type __ = Obj.t" ++ fnl () else mt ()
	72
	73	let pp_mldummy usf =
	74	if usf.mldummy then
	75	str "let __ = let rec f _ = Obj.repr f in Obj.repr f" ++ fnl ()
	76	else mt ()
64	77
65	78	let preamble _ comment used_modules usf =
66	79	pp_header_comment comment ++
67		prlist pp_open used_modules ++
68		(if List.is_empty used_modules then mt () else fnl ()) ++
69		(if usf.tdummy \|\| usf.tunknown then str "type __ = Obj.t\n" else mt()) ++
70		(if usf.mldummy then
71		str "let __ = let rec f _ = Obj.repr f in Obj.repr f\n"
72		else mt ()) ++
73		(if usf.tdummy \|\| usf.tunknown \|\| usf.mldummy then fnl () else mt ())
	80	then_nl (prlist pp_open used_modules) ++
	81	then_nl (pp_tdummy usf ++ pp_mldummy usf)
74	82
75	83	let sig_preamble _ comment used_modules usf =
76		pp_header_comment comment ++ fnl () ++ fnl () ++
77		prlist pp_open used_modules ++
78		(if List.is_empty used_modules then mt () else fnl ()) ++
79		(if usf.tdummy \|\| usf.tunknown then str "type __ = Obj.t\n\n" else mt())
	84	pp_header_comment comment ++
	85	then_nl (prlist pp_open used_modules) ++
	86	then_nl (pp_tdummy usf)
80	87
81	88	(s The pretty-printer for Ocaml syntax)
82	89

170	177	and apply2 st = pp_apply2 st par args in
171	178	function
172	179	\| MLrel n ->
173		let id = get_db_name n env in apply (pr_id id)
	180	let id = get_db_name n env in
	181	(* Try to survive to the occurrence of a Dummy rel.
	182	TODO: we should get rid of this hack (cf. #592) *)
	183	let id = if Id.equal id dummy_name then Id.of_string "__" else id in
	184	apply (pr_id id)
174	185	\| MLapp (f,args') ->
175	186	let stl = List.map (pp_expr true env []) args' in
176	187	pp_expr par env (stl @ args) f

198	209	\| MLexn s ->
199	210	(* An [MLexn] may be applied, but I don't really care. *)
200	211	pp_par par (str "assert false" ++ spc () ++ str ("(* "^s^" *)"))
201		\| MLdummy ->
202		str "__" (* An [MLdummy] may be applied, but I don't really care. *)
	212	\| MLdummy k ->
	213	(* An [MLdummy] may be applied, but I don't really care. *)
	214	(match msg_of_implicit k with
	215	\| "" -> str "__"
	216	\| s -> str "__" ++ spc () ++ str ("(* "^s^" *)"))
203	217	\| MLmagic a ->
204	218	pp_apply (str "Obj.magic") par (pp_expr true env [] a :: args)
205	219	\| MLaxiom ->

351	365	\| MLcase(Tglob(r,_),MLrel 1,pv) when
352	366	not (is_coinductive r) && List.is_empty (get_record_fields r) &&
353	367	not (is_custom_match pv) ->
354		if not (ast_occurs 1 (MLcase(Tunknown,MLdummy,pv))) then
	368	if not (ast_occurs 1 (MLcase(Tunknown,MLaxiom,pv))) then
355	369	pr_binding (List.rev (List.tl bl)) ++
356	370	str " = function" ++ fnl () ++
357	371	v 0 (pp_pat env' pv)

377	391	fnl () ++
378	392	hov 2 (str "in " ++ pp_apply (pr_id ids.(i)) false args)))
379	393
	394	(* Ad-hoc double-newline in v boxes, with enough negative whitespace
	395	to avoid indenting the intermediate blank line *)
	396
	397	let cut2 () = brk (0,-100000) ++ brk (0,0)
	398
380	399	let pp_val e typ =
381	400	hov 4 (str "(** val " ++ e ++ str " :" ++ spc () ++ pp_type false [] typ ++
382		str " **)") ++ fnl2 ()
	401	str " **)") ++ cut2 ()
383	402
384	403	(s Pretty-printing of [Dfix] )
385	404

388	407	(fun r -> if is_inline_custom r then mt () else pp_global Term r) rv
389	408	in
390	409	let rec pp init i =
391		if i >= Array.length rv then
392		(if init then failwith "empty phrase" else mt ())
	410	if i >= Array.length rv then mt ()
393	411	else
394	412	let void = is_inline_custom rv.(i) \|\|
395		(not (is_custom rv.(i)) && match c.(i) with MLexn "UNUSED" -> true \| _ -> false)
	413	(not (is_custom rv.(i)) &&
	414	match c.(i) with MLexn "UNUSED" -> true \| _ -> false)
396	415	in
397	416	if void then pp init (i+1)
398	417	else

400	419	if is_custom rv.(i) then str " = " ++ str (find_custom rv.(i))
401	420	else pp_function (empty_env ()) c.(i)
402	421	in
403		(if init then mt () else fnl2 ()) ++
	422	(if init then mt () else cut2 ()) ++
404	423	pp_val names.(i) t.(i) ++
405	424	str (if init then "let rec " else "and ") ++ names.(i) ++ def ++
406	425	pp false (i+1)

465	484
466	485	let pp_ind co kn ind =
467	486	let prefix = if co then "__" else "" in
468		let some = ref false in
469		let init= ref (str "type ") in
	487	let initkwd = str "type " in
	488	let nextkwd = fnl () ++ str "and " in
470	489	let names =
471	490	Array.mapi (fun i p -> if p.ip_logical then mt () else
472	491	pp_global Type (IndRef (kn,i)))

479	498	p.ip_types)
480	499	ind.ind_packets
481	500	in
482		let rec pp i =
	501	let rec pp i kwd =
483	502	if i >= Array.length ind.ind_packets then mt ()
484	503	else
485	504	let ip = (kn,i) in
486	505	let ip_equiv = ind.ind_equiv, i in
487	506	let p = ind.ind_packets.(i) in
488		if is_custom (IndRef ip) then pp (i+1)
489		else begin
490		some := true;
491		if p.ip_logical then pp_logical_ind p ++ pp (i+1)
492		else
493		let s = !init in
494		begin
495		init := (fnl () ++ str "and ");
496		s ++
497		(if co then pp_coind p.ip_vars names.(i) else mt ()) ++
498		pp_one_ind
499		prefix ip_equiv p.ip_vars names.(i) cnames.(i) p.ip_types ++
500		pp (i+1)
501		end
502		end
503		in
504		let st = pp 0 in if !some then st else failwith "empty phrase"
	507	if is_custom (IndRef ip) then pp (i+1) kwd
	508	else if p.ip_logical then pp_logical_ind p ++ pp (i+1) kwd
	509	else
	510	kwd ++ (if co then pp_coind p.ip_vars names.(i) else mt ()) ++
	511	pp_one_ind prefix ip_equiv p.ip_vars names.(i) cnames.(i) p.ip_types ++
	512	pp (i+1) nextkwd
	513	in
	514	pp 0 initkwd
505	515
506	516
507	517	(s Pretty-printing of a declaration. )

514	524	\| Standard -> pp_ind false kn i
515	525
516	526	let pp_decl = function
517		\| Dtype (r,_,_) when is_inline_custom r -> failwith "empty phrase"
518		\| Dterm (r,_,_) when is_inline_custom r -> failwith "empty phrase"
	527	\| Dtype (r,_,_) when is_inline_custom r -> mt ()
	528	\| Dterm (r,_,_) when is_inline_custom r -> mt ()
519	529	\| Dind (kn,i) -> pp_mind kn i
520	530	\| Dtype (r, l, t) ->
521	531	let name = pp_global Type r in

523	533	let ids, def =
524	534	try
525	535	let ids,s = find_type_custom r in
526		pp_string_parameters ids, str "=" ++ spc () ++ str s
	536	pp_string_parameters ids, str " =" ++ spc () ++ str s
527	537	with Not_found ->
528	538	pp_parameters l,
529		if t == Taxiom then str "(* AXIOM TO BE REALIZED *)"
530		else str "=" ++ spc () ++ pp_type false l t
	539	if t == Taxiom then str " (* AXIOM TO BE REALIZED *)"
	540	else str " =" ++ spc () ++ pp_type false l t
531	541	in
532		hov 2 (str "type " ++ ids ++ name ++ spc () ++ def)
	542	hov 2 (str "type " ++ ids ++ name ++ def)
533	543	\| Dterm (r, a, t) ->
534	544	let def =
535	545	if is_custom r then str (" = " ^ find_custom r)

563	573	rv
564	574
565	575	let pp_spec = function
566		\| Sval (r,_) when is_inline_custom r -> failwith "empty phrase"
567		\| Stype (r,_,_) when is_inline_custom r -> failwith "empty phrase"
	576	\| Sval (r,_) when is_inline_custom r -> mt ()
	577	\| Stype (r,_,_) when is_inline_custom r -> mt ()
568	578	\| Sind (kn,i) -> pp_mind kn i
569	579	\| Sval (r,t) ->
570	580	let def = pp_type false [] t in

576	586	let ids, def =
577	587	try
578	588	let ids, s = find_type_custom r in
579		pp_string_parameters ids, str "= " ++ str s
	589	pp_string_parameters ids, str " =" ++ spc () ++ str s
580	590	with Not_found ->
581	591	let ids = pp_parameters l in
582	592	match ot with
583	593	\| None -> ids, mt ()
584		\| Some Taxiom -> ids, str "(* AXIOM TO BE REALIZED *)"
585		\| Some t -> ids, str "=" ++ spc () ++ pp_type false l t
	594	\| Some Taxiom -> ids, str " (* AXIOM TO BE REALIZED *)"
	595	\| Some t -> ids, str " =" ++ spc () ++ pp_type false l t
586	596	in
587		hov 2 (str "type " ++ ids ++ name ++ spc () ++ def)
	597	hov 2 (str "type " ++ ids ++ name ++ def)
588	598
589	599	let pp_alias_spec ren = function
590	600	\| Sind (kn,i) -> pp_mind kn { i with ind_equiv = RenEquiv ren }

601	611	\| (l,Spec s) ->
602	612	(try
603	613	let ren = Common.check_duplicate (top_visible_mp ()) l in
604		hov 1 (str ("module "^ren^" : sig ") ++ fnl () ++ pp_spec s) ++
	614	hov 1 (str ("module "^ren^" : sig") ++ fnl () ++ pp_spec s) ++
605	615	fnl () ++ str "end" ++ fnl () ++
606	616	pp_alias_spec ren s
607	617	with Not_found -> pp_spec s)

609	619	let def = pp_module_type [] mt in
610	620	let def' = pp_module_type [] mt in
611	621	let name = pp_modname (MPdot (top_visible_mp (), l)) in
612		hov 1 (str "module " ++ name ++ str " : " ++ fnl () ++ def) ++
	622	hov 1 (str "module " ++ name ++ str " :" ++ fnl () ++ def) ++
613	623	(try
614	624	let ren = Common.check_duplicate (top_visible_mp ()) l in
615		fnl () ++ hov 1 (str ("module "^ren^" : ") ++ fnl () ++ def')
	625	fnl () ++ hov 1 (str ("module "^ren^" :") ++ fnl () ++ def')
616	626	with Not_found -> Pp.mt ())
617	627	\| (l,Smodtype mt) ->
618	628	let def = pp_module_type [] mt in
619	629	let name = pp_modname (MPdot (top_visible_mp (), l)) in
620		hov 1 (str "module type " ++ name ++ str " = " ++ fnl () ++ def) ++
	630	hov 1 (str "module type " ++ name ++ str " =" ++ fnl () ++ def) ++
621	631	(try
622	632	let ren = Common.check_duplicate (top_visible_mp ()) l in
623	633	fnl () ++ str ("module type "^ren^" = ") ++ name

634	644	\| MTsig (mp, sign) ->
635	645	push_visible mp params;
636	646	let try_pp_specif l x =
637		try pp_specif x :: l with Failure "empty phrase" -> l
	647	let px = pp_specif x in
	648	if Pp.is_empty px then l else px::l
638	649	in
639	650	(* We cannot use fold_right here due to side effects in pp_specif *)
640	651	let l = List.fold_left try_pp_specif [] sign in
641	652	let l = List.rev l in
642	653	pop_visible ();
643		str "sig " ++ fnl () ++
644		v 1 (str " " ++ prlist_with_sep fnl2 identity l) ++
	654	str "sig" ++ fnl () ++
	655	v 1 (str " " ++ prlist_with_sep cut2 identity l) ++
645	656	fnl () ++ str "end"
646	657	\| MTwith(mt,ML_With_type(idl,vl,typ)) ->
647	658	let ids = pp_parameters (rename_tvars keywords vl) in

671	682	\| (l,SEdecl d) ->
672	683	(try
673	684	let ren = Common.check_duplicate (top_visible_mp ()) l in
674		hov 1 (str ("module "^ren^" = struct ") ++ fnl () ++ pp_decl d) ++
	685	hov 1 (str ("module "^ren^" = struct") ++ fnl () ++ pp_decl d) ++
675	686	fnl () ++ str "end" ++ fnl () ++
676	687	pp_alias_decl ren d
677	688	with Not_found -> pp_decl d)

685	696	let def = pp_module_expr [] m.ml_mod_expr in
686	697	let name = pp_modname (MPdot (top_visible_mp (), l)) in
687	698	hov 1
688		(str "module " ++ name ++ typ ++ str " = " ++
689		(if (is_short m.ml_mod_expr) then mt () else fnl ()) ++ def) ++
	699	(str "module " ++ name ++ typ ++ str " =" ++
	700	(if is_short m.ml_mod_expr then spc () else fnl ()) ++ def) ++
690	701	(try
691	702	let ren = Common.check_duplicate (top_visible_mp ()) l in
692	703	fnl () ++ str ("module "^ren^" = ") ++ name

694	705	\| (l,SEmodtype m) ->
695	706	let def = pp_module_type [] m in
696	707	let name = pp_modname (MPdot (top_visible_mp (), l)) in
697		hov 1 (str "module type " ++ name ++ str " = " ++ fnl () ++ def) ++
	708	hov 1 (str "module type " ++ name ++ str " =" ++ fnl () ++ def) ++
698	709	(try
699	710	let ren = Common.check_duplicate (top_visible_mp ()) l in
700	711	fnl () ++ str ("module type "^ren^" = ") ++ name

712	723	\| MEstruct (mp, sel) ->
713	724	push_visible mp params;
714	725	let try_pp_structure_elem l x =
715		try pp_structure_elem x :: l with Failure "empty phrase" -> l
	726	let px = pp_structure_elem x in
	727	if Pp.is_empty px then l else px::l
716	728	in
717	729	(* We cannot use fold_right here due to side effects in pp_structure_elem *)
718	730	let l = List.fold_left try_pp_structure_elem [] sel in
719	731	let l = List.rev l in
720	732	pop_visible ();
721		str "struct " ++ fnl () ++
722		v 1 (str " " ++ prlist_with_sep fnl2 identity l) ++
	733	str "struct" ++ fnl () ++
	734	v 1 (str " " ++ prlist_with_sep cut2 identity l) ++
723	735	fnl () ++ str "end"
724	736
	737	let rec prlist_sep_nonempty sep f = function
	738	\| [] -> mt ()
	739	\| [h] -> f h
	740	\| h::t ->
	741	let e = f h in
	742	let r = prlist_sep_nonempty sep f t in
	743	if Pp.is_empty e then r
	744	else e ++ sep () ++ r
	745
725	746	let do_struct f s =
726		let pp s = try f s ++ fnl2 () with Failure "empty phrase" -> mt ()
727		in
728	747	let ppl (mp,sel) =
729	748	push_visible mp [];
730		let p = prlist_strict pp sel in
	749	let p = prlist_sep_nonempty cut2 f sel in
731	750	(* for monolithic extraction, we try to simulate the unavailability
732	751	of [MPfile] in names by artificially nesting these [MPfile] *)
733	752	(if modular () then pop_visible ()); p
734	753	in
735		let p = prlist_strict ppl s in
	754	let p = prlist_sep_nonempty cut2 ppl s in
736	755	(if not (modular ()) then repeat (List.length s) pop_visible ());
737		p
	756	v 0 p ++ fnl ()
738	757
739	758	let pp_struct s = do_struct pp_structure_elem s
740	759
741	760	let pp_signature s = do_struct pp_specif s
742
743		let pp_decl d = try pp_decl d with Failure "empty phrase" -> mt ()
744	761
745	762	let ocaml_descr = {
746	763	keywords = keywords;

753	770	pp_sig = pp_signature;
754	771	pp_decl = pp_decl;
755	772	}
756
757

+1

-1

plugins/extraction/ocaml.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-3

plugins/extraction/scheme.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

125	125	\| MLexn s ->
126	126	(* An [MLexn] may be applied, but I don't really care. *)
127	127	paren (str "error" ++ spc () ++ qs s)
128		\| MLdummy ->
	128	\| MLdummy _ ->
129	129	str "__" (* An [MLdummy] may be applied, but I don't really care. *)
130	130	\| MLmagic a ->
131	131	pp_expr env args a

182	182	prvecti
183	183	(fun i r ->
184	184	let void = is_inline_custom r \|\|
185		(not (is_custom r) && match defs.(i) with MLexn "UNUSED" -> true \| _ -> false)
	185	(not (is_custom r) &&
	186	match defs.(i) with MLexn "UNUSED" -> true \| _ -> false)
186	187	in
187	188	if void then mt ()
188	189	else

+1

-1

plugins/extraction/scheme.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+82

-39

plugins/extraction/table.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

71	71	\| _ -> 1
72	72	in len mp
73	73
74		let visible_con kn = at_toplevel (base_mp (con_modpath kn))
75
76	74	let rec prefixes_mp mp = match mp with
77	75	\| MPdot (mp',_) -> MPset.add mp (prefixes_mp mp')
78	76	\| _ -> MPset.singleton mp

104	102	(* Theses tables are not registered within coq save/undo mechanism
105	103	since we reset their contents at each run of Extraction *)
106	104
	105	(* We use [constant_body] (resp. [mutual_inductive_body]) as checksum
	106	to ensure that the table contents aren't outdated. *)
	107
107	108	(s Constants tables. )
108	109
109		let terms = ref (Cmap_env.empty : ml_decl Cmap_env.t)
110		let init_terms () = terms := Cmap_env.empty
111		let add_term kn d = terms := Cmap_env.add kn d !terms
112		let lookup_term kn = Cmap_env.find kn !terms
113
114		let types = ref (Cmap_env.empty : ml_schema Cmap_env.t)
115		let init_types () = types := Cmap_env.empty
116		let add_type kn s = types := Cmap_env.add kn s !types
117		let lookup_type kn = Cmap_env.find kn !types
	110	let typedefs = ref (Cmap_env.empty : (constant_body * ml_type) Cmap_env.t)
	111	let init_typedefs () = typedefs := Cmap_env.empty
	112	let add_typedef kn cb t =
	113	typedefs := Cmap_env.add kn (cb,t) !typedefs
	114	let lookup_typedef kn cb =
	115	try
	116	let (cb0,t) = Cmap_env.find kn !typedefs in
	117	if cb0 == cb then Some t else None
	118	with Not_found -> None
	119
	120	let cst_types =
	121	ref (Cmap_env.empty : (constant_body * ml_schema) Cmap_env.t)
	122	let init_cst_types () = cst_types := Cmap_env.empty
	123	let add_cst_type kn cb s = cst_types := Cmap_env.add kn (cb,s) !cst_types
	124	let lookup_cst_type kn cb =
	125	try
	126	let (cb0,s) = Cmap_env.find kn !cst_types in
	127	if cb0 == cb then Some s else None
	128	with Not_found -> None
118	129
119	130	(s Inductives table. )
120	131

123	134	let init_inductives () = inductives := Mindmap_env.empty
124	135	let add_ind kn mib ml_ind =
125	136	inductives := Mindmap_env.add kn (mib,ml_ind) !inductives
126		let lookup_ind kn = Mindmap_env.find kn !inductives
	137	let lookup_ind kn mib =
	138	try
	139	let (mib0,ml_ind) = Mindmap_env.find kn !inductives in
	140	if mib == mib0 then Some ml_ind
	141	else None
	142	with Not_found -> None
	143
	144	let unsafe_lookup_ind kn = snd (Mindmap_env.find kn !inductives)
127	145
128	146	let inductive_kinds =
129	147	ref (Mindmap_env.empty : inductive_kind Mindmap_env.t)

243	261	\| ConstRef kn -> Label.to_id (con_label kn)
244	262	\| IndRef (kn,0) -> Label.to_id (mind_label kn)
245	263	\| IndRef (kn,i) ->
246		(try (snd (lookup_ind kn)).ind_packets.(i).ip_typename
	264	(try (unsafe_lookup_ind kn).ind_packets.(i).ip_typename
247	265	with Not_found -> last_chance r)
248	266	\| ConstructRef ((kn,i),j) ->
249		(try (snd (lookup_ind kn)).ind_packets.(i).ip_consnames.(j-1)
	267	(try (unsafe_lookup_ind kn).ind_packets.(i).ip_consnames.(j-1)
250	268	with Not_found -> last_chance r)
251	269	\| VarRef _ -> assert false
252	270

400	418	"Monolithic Extraction cannot deal with this situation.\n"^
401	419	"Please "^s2^"use (Recursive) Extraction Library instead.\n"))
402	420
403		let msg_non_implicit r n id =
404		let name = match id with
405		\| Anonymous -> ""
406		\| Name id -> "(" ^ Id.to_string id ^ ") "
407		in
408		"The " ^ (String.ordinal n) ^ " argument " ^ name ^ "of " ^ (string_of_global r)
409
410		let error_non_implicit msg =
411		err (str (msg ^ " still occurs after extraction.") ++
412		fnl () ++ str "Please check the Extraction Implicit declarations.")
	421	let argnames_of_global r =
	422	let typ = Global.type_of_global_unsafe r in
	423	let rels,_ =
	424	decompose_prod (Reduction.whd_betadeltaiota (Global.env ()) typ) in
	425	List.rev_map fst rels
	426
	427	let msg_of_implicit = function
	428	\| Kimplicit (r,i) ->
	429	let name = match List.nth (argnames_of_global r) (i-1) with
	430	\| Anonymous -> ""
	431	\| Name id -> "(" ^ Id.to_string id ^ ") "
	432	in
	433	(String.ordinal i)^" argument "^name^"of "^(string_of_global r)
	434	\| Ktype \| Kprop -> ""
	435
	436	let error_remaining_implicit k =
	437	let s = msg_of_implicit k in
	438	err (str ("An implicit occurs after extraction : "^s^".") ++ fnl () ++
	439	str "Please check your Extraction Implicit declarations." ++ fnl() ++
	440	str "You might also try Unset Extraction SafeImplicits to force" ++
	441	fnl() ++ str "the extraction of unsafe code and review it manually.")
	442
	443	let warning_remaining_implicit k =
	444	let s = msg_of_implicit k in
	445	msg_warning
	446	(str ("At least an implicit occurs after extraction : "^s^".") ++ fnl () ++
	447	str "Extraction SafeImplicits is unset, extracting nonetheless," ++ fnl ()
	448	++ str "but this code is potentially unsafe, please review it manually.")
413	449
414	450	let check_loaded_modfile mp = match base_mp mp with
415	451	\| MPfile dp ->

634	670
635	671	(s Extraction Implicit )
636	672
	673	let safe_implicit = my_bool_option "SafeImplicits" true
	674
	675	let err_or_warn_remaining_implicit k =
	676	if safe_implicit () then
	677	error_remaining_implicit k
	678	else
	679	warning_remaining_implicit k
	680
637	681	type int_or_id = ArgInt of int \| ArgId of Id.t
638	682
639	683	let implicits_table = Summary.ref Refmap'.empty ~name:"ExtrImplicit"
640	684
641	685	let implicits_of_global r =
642		try Refmap'.find r !implicits_table with Not_found -> []
	686	try Refmap'.find r !implicits_table with Not_found -> Int.Set.empty
643	687
644	688	let add_implicits r l =
645		let typ = Global.type_of_global_unsafe r in
646		let rels,_ =
647		decompose_prod (Reduction.whd_betadeltaiota (Global.env ()) typ) in
648		let names = List.rev_map fst rels in
	689	let names = argnames_of_global r in
649	690	let n = List.length names in
650		let check = function
	691	let add_arg s = function
651	692	\| ArgInt i ->
652		if 1 <= i && i <= n then i
	693	if 1 <= i && i <= n then Int.Set.add i s
653	694	else err (int i ++ str " is not a valid argument number for " ++
654	695	safe_pr_global r)
655	696	\| ArgId id ->
656		(try List.index Name.equal (Name id) names
657		with Not_found ->
658		err (str "No argument " ++ pr_id id ++ str " for " ++
659		safe_pr_global r))
	697	try
	698	let i = List.index Name.equal (Name id) names in
	699	Int.Set.add i s
	700	with Not_found ->
	701	err (str "No argument " ++ pr_id id ++ str " for " ++
	702	safe_pr_global r)
660	703	in
661		let l' = List.map check l in
662		implicits_table := Refmap'.add r l' !implicits_table
	704	let ints = List.fold_left add_arg Int.Set.empty l in
	705	implicits_table := Refmap'.add r ints !implicits_table
663	706
664	707	(* Registration of operations for rollback. *)
665	708

850	893	(s Tables synchronization. )
851	894
852	895	let reset_tables () =
853		init_terms (); init_types (); init_inductives ();
	896	init_typedefs (); init_cst_types (); init_inductives ();
854	897	init_inductive_kinds (); init_recursors ();
855	898	init_projs (); init_axioms (); init_opaques (); reset_modfile ()

+19

-12

plugins/extraction/table.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

12	12	open Declarations
13	13
14	14	module Refset' : CSig.SetS with type elt = global_reference
15		module Refmap' : Map.S with type key = global_reference
	15	module Refmap' : CSig.MapS with type key = global_reference
16	16
17	17	val safe_basename_of_global : global_reference -> Id.t
18	18

37	37	val check_inside_module : unit -> unit
38	38	val check_inside_section : unit -> unit
39	39	val check_loaded_modfile : module_path -> unit
40		val msg_non_implicit : global_reference -> int -> Name.t -> string
41		val error_non_implicit : string -> 'a
	40	val msg_of_implicit : kill_reason -> string
	41	val err_or_warn_remaining_implicit : kill_reason -> unit
42	42
43	43	val info_file : string -> unit
44	44

54	54	val file_of_modfile : module_path -> string
55	55	val is_toplevel : module_path -> bool
56	56	val at_toplevel : module_path -> bool
57		val visible_con : constant -> bool
58	57	val mp_length : module_path -> int
59	58	val prefixes_mp : module_path -> MPset.t
60	59	val common_prefix_from_list :

64	63
65	64	(s Some table-related operations )
66	65
67		val add_term : constant -> ml_decl -> unit
68		val lookup_term : constant -> ml_decl
69
70		val add_type : constant -> ml_schema -> unit
71		val lookup_type : constant -> ml_schema
	66	(* For avoiding repeated extraction of the same constant or inductive,
	67	we use cache functions below. Indexing by constant name isn't enough,
	68	due to modules we could have a same constant name but different
	69	content. So we check that the [constant_body] hasn't changed from
	70	recording time to retrieving time. Same for inductive : we store
	71	[mutual_inductive_body] as checksum. In both case, we should ideally
	72	also check the env *)
	73
	74	val add_typedef : constant -> constant_body -> ml_type -> unit
	75	val lookup_typedef : constant -> constant_body -> ml_type option
	76
	77	val add_cst_type : constant -> constant_body -> ml_schema -> unit
	78	val lookup_cst_type : constant -> constant_body -> ml_schema option
72	79
73	80	val add_ind : mutual_inductive -> mutual_inductive_body -> ml_ind -> unit
74		val lookup_ind : mutual_inductive -> mutual_inductive_body * ml_ind
	81	val lookup_ind : mutual_inductive -> mutual_inductive_body -> ml_ind option
75	82
76	83	val add_inductive_kind : mutual_inductive -> inductive_kind -> unit
77	84	val is_coinductive : global_reference -> bool

165	172
166	173	(s Table for implicits arguments )
167	174
168		val implicits_of_global : global_reference -> int list
	175	val implicits_of_global : global_reference -> Int.Set.t
169	176
170	177	(s Table for user-given custom ML extractions. )
171	178

+1

-1

plugins/firstorder/formula.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/formula.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/g_ground.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/ground.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/ground.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/instances.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/instances.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/rules.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/rules.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/sequent.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

plugins/firstorder/sequent.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

12	12
13	13	module OrderedConstr: Set.OrderedType with type t=constr
14	14
15		module CM: Map.S with type key=constr
	15	module CM: CSig.MapS with type key=constr
16	16
17	17	type h_item = global_reference * (int*constr) option
18	18

+1

-1

plugins/firstorder/unify.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/firstorder/unify.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/fourier/Fourier.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/fourier/Fourier_util.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/fourier/fourier.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/fourier/fourierR.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/fourier/g_fourier.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/funind/Recdef.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/funind/functional_principles_proofs.mli less more

7	7
8	8
9	9	val prove_principle_for_gen :
10		constantconstantconstant -> (* name of the function, the fonctionnal and the fixpoint equation *)
	10	constantconstantconstant -> (* name of the function, the functional and the fixpoint equation *)
11	11	constr option ref -> (* a pointer to the obligation proofs lemma *)
12	12	bool -> (* is that function uses measure *)
13	13	int -> (* the number of recursive argument *)

+1

-1

plugins/funind/functional_principles_types.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/funind/g_indfun.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/funind/glob_term_to_relation.ml less more

680	680	let case_resl =
681	681	List.fold_right
682	682	(fun (case_arg,_) ctxt_argsl ->
683		let arg_res = build_entry_lc env funname avoid case_arg in
	683	let arg_res = build_entry_lc env funname ctxt_argsl.to_avoid case_arg in
684	684	combine_results combine_args arg_res ctxt_argsl
685	685	)
686	686	el

+1

-1

plugins/funind/invfun.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/funind/merge.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-7

plugins/funind/recdef.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

202	202
203	203
204	204
205		(* Debuging mechanism *)
	205	(* Debugging mechanism *)
206	206	let debug_queue = Stack.create ()
207	207
208	208	let rec print_debug_queue b e =

290	290
291	291
292	292
293		(* Travelling term.
	293	(* Traveling term.
294	294	Both definitions of [f_terminate] and [f_equation] use the same generic
295		travelling mechanism.
	295	traveling mechanism.
296	296	*)
297	297
298	298	(* [check_not_nested forbidden e] checks that [e] does not contains any variable

326	326	with UserError(_,p) ->
327	327	errorlabstrm "_" (str "on expr : " ++ Printer.pr_lconstr e ++ str " " ++ p)
328	328
329		(* ['a info] contains the local information for travelling *)
	329	(* ['a info] contains the local information for traveling *)
330	330	type 'a infos =
331	331	{ nb_arg : int; (* function number of arguments *)
332	332	concl_tac : tactic; (* final tactic to finish proofs *)

336	336	f_id : Id.t; (* function name *)
337	337	f_constr : constr; (* function term *)
338	338	f_terminate : constr; (* termination proof term *)
339		func : global_reference; (* functionnal reference *)
	339	func : global_reference; (* functional reference *)
340	340	info : 'a;
341	341	is_main_branch : bool; (* on the main branch or on a matched expression *)
342	342	is_final : bool; (* final first order term or not *)

356	356	'b infos -> (* argument of the tactic *)
357	357	tactic
358	358
359		(* journey_info : specifies the actions to do on the different term constructors during the travelling of the term
	359	(* journey_info : specifies the actions to do on the different term constructors during the traveling of the term
360	360	*)
361	361	type journey_info =
362	362	{ letiN : ((Name.tconstrtypes*constr),constr) journey_info_tac;

+1

-1

plugins/micromega/Env.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/EnvRing.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/Lia.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/MExtraction.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/OrderedRing.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/Psatz.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/QMicromega.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/RMicromega.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/Refl.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/RingMicromega.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/Tauto.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/VarMap.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/ZCoeff.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/ZMicromega.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/certificate.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/coq_micromega.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/csdpcert.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/g_micromega.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/mutils.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/persistent_cache.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/polynomial.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/sos.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/micromega/sos_types.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/nsatz/Nsatz.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/nsatz/ideal.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/nsatz/nsatz.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/nsatz/polynom.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/nsatz/polynom.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/omega/Omega.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/omega/OmegaPlugin.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/omega/OmegaTactic.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/omega/PreOmega.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/omega/coq_omega.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/omega/g_omega.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/omega/omega.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/quote/Quote.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/quote/g_quote.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-3

plugins/quote/quote.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

210	210	let i = destRel (Array.last args) in
211	211	PMeta (Some (coerce_meta_in i))
212	212	\| App (f,args) ->
213		PApp (pi3 (pattern_of_constr (Global.env()) Evd.empty f), Array.map aux args)
	213	PApp (pattern_of_constr (Global.env()) Evd.empty f, Array.map aux args)
214	214	\| Cast (c,_,_) -> aux c
215		\| _ -> pi3 (pattern_of_constr (Global.env())(FIXME) Evd.empty c)
	215	\| _ -> pattern_of_constr (Global.env())(FIXME) Evd.empty c
216	216	in
217	217	aux bodyi
218	218

+4

-4

plugins/romega/refl_omega.ml less more

45	45	d'une liste de pas à partir de la racine de l'hypothèse *)
46	46	type occurrence = {o_hyp : Names.Id.t; o_path : occ_path}
47	47
48		(* \subsection{refiable formulas} *)
	48	(* \subsection{reifiable formulas} *)
49	49	type oformula =
50	50	(* integer *)
51	51	\| Oint of Bigint.bigint

54	54	\| Omult of oformula * oformula
55	55	\| Ominus of oformula * oformula
56	56	\| Oopp of oformula
57		(* an atome in the environment *)
	57	(* an atom in the environment *)
58	58	\| Oatom of int
59	59	(* weird expression that cannot be translated *)
60	60	\| Oufo of oformula

74	74	\| Pimp of int * oproposition * oproposition
75	75	\| Pprop of Term.constr
76	76
77		(* Les équations ou proposiitions atomiques utiles du calcul *)
	77	(* Les équations ou propositions atomiques utiles du calcul *)
78	78	and oequation = {
79	79	e_comp: comparaison; (* comparaison *)
80	80	e_left: oformula; (* formule brute gauche *)

1265	1265	\| (O_right :: l) -> app coq_p_right [\| loop l \|] in
1266	1266	let correct_index =
1267	1267	let i = List.index0 Names.Id.equal e.e_origin.o_hyp l_hyps in
1268		(* PL: it seems that additionnally introduced hyps are in the way during
	1268	(* PL: it seems that additionally introduced hyps are in the way during
1269	1269	normalization, hence this index shifting... *)
1270	1270	if Int.equal i 0 then 0 else Pervasives.(+) i (List.length to_introduce)
1271	1271	in

+1

-1

plugins/rtauto/Bintree.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/rtauto/Rtauto.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/rtauto/g_rtauto.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/rtauto/proof_search.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/rtauto/proof_search.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/rtauto/refl_tauto.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/rtauto/refl_tauto.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/ArithRing.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/BinList.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Cring.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Field.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Field_tac.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Field_theory.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-4

plugins/setoid_ring/InitialRing.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

154	154	Ltac norm := gen_srewrite Rsth Reqe ARth.
155	155	Ltac add_push := gen_add_push radd Rsth Reqe ARth.
156	156
157		(morphisms are extensionaly equal)
	157	(morphisms are extensionally equal)
158	158	Lemma same_genZ : forall x, [x] == gen_phiZ1 x.
159	159	Proof.
160	160	destruct x;simpl; try rewrite (same_gen ARth);rrefl.

245	245	Lemma Neqb_ok : forall x y, N.eqb x y = true -> x = y.
246	246	Proof. exact (fun x y => proj1 (N.eqb_eq x y)). Qed.
247	247
248		(*Same as above : definition of two,extensionaly equal, generic morphisms )
	248	(*Same as above : definition of two, extensionally equal, generic morphisms )
249	249	(*from N to any semi-ring)
250	250	Section NMORPHISM.
251	251	Variable R : Type.

670	670	end.
671	671
672	672	(* A simple tactic recognizing only 0 and 1. The inv_gen_phiX above
673		are only optimisations that directly returns the reifid constant
	673	are only optimisations that directly returns the reified constant
674	674	instead of resorting to the constant propagation of the simplification
675	675	algorithm. *)
676	676	Ltac inv_gen_phi rO rI cO cI t :=

+1

-1

plugins/setoid_ring/NArithRing.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Ncring.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-3

plugins/setoid_ring/Ncring_initial.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

41	41
42	42	(Instance ZEquality: @Equality Z:= (@eq Z).)
43	43
44		(** Two generic morphisms from Z to (abrbitrary) rings, *)
	44	(** Two generic morphisms from Z to (arbitrary) rings, *)
45	45	(*second one is more convenient for proofs but they are ext. equal)
46	46	Section ZMORPHISM.
47	47	Context {R:Type}`{Ring R}.

129	129	Qed.
130	130
131	131
132		(morphisms are extensionaly equal)
	132	(morphisms are extensionally equal)
133	133	Lemma same_genZ : forall x, [x] == gen_phiZ1 x.
134	134	Proof.
135	135	destruct x;rsimpl; try rewrite same_gen; reflexivity.

+1

-1

plugins/setoid_ring/Ncring_polynom.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Ncring_tac.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Ring.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Ring_base.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Ring_polynom.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/Ring_theory.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/ZArithRing.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/setoid_ring/newring.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/syntax/nat_syntax.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/syntax/numbers_syntax.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/syntax/r_syntax.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

plugins/syntax/z_syntax.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-15

plugins/xml/README less more

0		The xml export plugin for Coq has been discontinued for lack of users:
1		it was most certainly broken while imposing a non-negligible cost on
2		Coq development. Its purpose was to give export Coq's kernel objects
3		in xml form for treatment by external tools.
4
5		If you are looking for such a tool, you may want to look at commit
6		7cfe0a70eda671ada6a46cd779ef9308f7e0fdb9 responsible for the deletion
7		of this plugin (for instance, git checkout
8		7cfe0a70eda671ada6a46cd779ef9308f7e0fdb9^ including the "^", will lead
9		you to the last commit before the xml plugin was deleted).
10
11		Bear in mind, however, that the plugin was not working properly at the
12		time. You may want instead to write to the original author of the
13		plugin, Claudio Sacerdoti-Coen at sacerdot@cs.unibo.it. He has a
14		stable version of the plugin for an old version of Coq.
	0	The xml export plugin for Coq has been removed from the sources.
	1	A backward compatible plug-in will be provided as a third-party plugin.
	2	For more informations, contact
	3	Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>.

+1

-1

pretyping/arguments_renaming.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/arguments_renaming.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/cases.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/cases.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/cbv.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/cbv.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/classops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/classops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

pretyping/coercion.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

342	342
343	343	let saturate_evd env evd =
344	344	Typeclasses.resolve_typeclasses
345		~filter:Typeclasses.no_goals ~split:false ~fail:false env evd
	345	~filter:Typeclasses.no_goals ~split:true ~fail:false env evd
346	346
347	347	(* Apply coercion path from p to hj; raise NoCoercion if not applicable *)
348	348	let apply_coercion env sigma p hj typ_cl =

+1

-1

pretyping/coercion.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/constr_matching.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/constr_matching.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+14

-2

pretyping/detyping.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

165	165	optread = print_primproj_params;
166	166	optwrite = (:=) print_primproj_params_value }
167	167
	168	let print_primproj_compatibility_value = ref true
	169	let print_primproj_compatibility () = !print_primproj_compatibility_value
	170
	171	let _ = declare_bool_option
	172	{ optsync = true;
	173	optdepr = false;
	174	optname = "backwards-compatible printing of primitive projections";
	175	optkey = ["Printing";"Primitive";"Projection";"Compatibility"];
	176	optread = print_primproj_compatibility;
	177	optwrite = (:=) print_primproj_compatibility_value }
	178
	179
168	180	(* Auxiliary function for MutCase printing *)
169	181	(* [computable] tries to tell if the predicate typing the result is inferable*)
170	182

475	487	GApp (dl, GRef (dl, ConstRef (Projection.constant p), None),
476	488	[detype flags avoid env sigma c])
477	489	else
478		if Projection.unfolded p then
	490	if print_primproj_compatibility () && Projection.unfolded p then
479	491	(** Print the compatibility match version *)
480	492	let c' =
481	493	try

+1

-1

pretyping/detyping.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/evarconv.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/evarconv.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+15

-7

pretyping/evarsolve.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

46	46	\| None -> true
47	47	\| Some l -> not (Evd.is_flexible_level evd l)
48	48
49		let refresh_universes ?(inferred=false) ?(onlyalg=false) pbty env evd t =
	49	let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) pbty env evd t =
50	50	let evdref = ref evd in
51	51	let modified = ref false in
52	52	let rec refresh status dir t =

97	97	if isArity t then
98	98	(match pbty with
99	99	\| None -> t
100		\| Some dir -> refresh univ_rigid dir t)
	100	\| Some dir -> refresh status dir t)
101	101	else (refresh_term_evars false true t; t)
102	102	in
103	103	if !modified then !evdref, t' else !evdref, t

608	608	let id = next_name_away na avoid in
609	609	let evd,t_in_sign =
610	610	let s = Retyping.get_sort_of env evd t_in_env in
611		let evd,ty_t_in_sign = refresh_universes ~inferred:true (Some false) env evd (mkSort s) in
	611	let evd,ty_t_in_sign = refresh_universes
	612	~status:univ_flexible (Some false) env evd (mkSort s) in
612	613	define_evar_from_virtual_equation define_fun env evd src t_in_env
613	614	ty_t_in_sign sign filter inst_in_env in
614	615	let evd,b_in_sign = match b with

626	627	in
627	628	let evd,ev2ty_in_sign =
628	629	let s = Retyping.get_sort_of env evd ty_in_env in
629		let evd,ty_t_in_sign = refresh_universes ~inferred:true (Some false) env evd (mkSort s) in
	630	let evd,ty_t_in_sign = refresh_universes
	631	~status:univ_flexible (Some false) env evd (mkSort s) in
630	632	define_evar_from_virtual_equation define_fun env evd src ty_in_env
631	633	ty_t_in_sign sign2 filter2 inst2_in_env in
632	634	let evd,ev2_in_sign =

1283	1285	\| l -> evd
1284	1286
1285	1287	let occur_evar_upto_types sigma n c =
	1288	let seen = ref Evar.Set.empty in
1286	1289	let rec occur_rec c = match kind_of_term c with
1287	1290	\| Evar (sp,_) when Evar.equal sp n -> raise Occur
1288		\| Evar e -> Option.iter occur_rec (existential_opt_value sigma e);
1289		occur_rec (existential_type sigma e)
	1291	\| Evar (sp,args as e) ->
	1292	if Evar.Set.mem sp !seen then
	1293	Array.iter occur_rec args
	1294	else (
	1295	seen := Evar.Set.add sp !seen;
	1296	Option.iter occur_rec (existential_opt_value sigma e);
	1297	occur_rec (existential_type sigma e))
1290	1298	\| _ -> iter_constr occur_rec c
1291	1299	in
1292	1300	try occur_rec c; false with Occur -> true

+3

-2

pretyping/evarsolve.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

33	33	val evar_define : conv_fun -> ?choose:bool -> env -> evar_map ->
34	34	bool option -> existential -> constr -> evar_map
35	35
36		val refresh_universes : ?inferred:bool -> ?onlyalg:bool (* Only algebraic universes *) ->
	36	val refresh_universes : ?status:Evd.rigid ->
	37	?onlyalg:bool (* Only algebraic universes *) ->
37	38	bool option (* direction: true for levels lower than the existing levels *) ->
38	39	env -> evar_map -> types -> evar_map * types
39	40

+1

-1

pretyping/evarutil.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/evarutil.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+12

-4

pretyping/evd.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

657	657	let remove d e =
658	658	let undf_evars = EvMap.remove e d.undf_evars in
659	659	let defn_evars = EvMap.remove e d.defn_evars in
660		{ d with undf_evars; defn_evars; }
	660	let principal_future_goal = match d.principal_future_goal with
	661	\| None -> None
	662	\| Some e' -> if Evar.equal e e' then None else d.principal_future_goal
	663	in
	664	let future_goals = List.filter (fun e' -> not (Evar.equal e e')) d.future_goals in
	665	{ d with undf_evars; defn_evars; principal_future_goal; future_goals }
661	666
662	667	let find d e =
663	668	try EvMap.find e d.undf_evars

1549	1554
1550	1555	let clear_metas evd = {evd with metas = Metamap.empty}
1551	1556
1552		let meta_merge evd1 evd2 =
	1557	let meta_merge ?(with_univs = true) evd1 evd2 =
1553	1558	let metas = Metamap.fold Metamap.add evd1.metas evd2.metas in
1554		let universes = union_evar_universe_context evd2.universes evd1.universes in
	1559	let universes =
	1560	if with_univs then union_evar_universe_context evd2.universes evd1.universes
	1561	else evd2.universes
	1562	in
1555	1563	{evd2 with universes; metas; }
1556	1564
1557	1565	type metabinding = metavariable * constr * instance_status

+2

-2

pretyping/evd.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

450	450	val clear_metas : evar_map -> evar_map
451	451
452	452	(** [meta_merge evd1 evd2] returns [evd2] extended with the metas of [evd1] *)
453		val meta_merge : evar_map -> evar_map -> evar_map
	453	val meta_merge : ?with_univs:bool -> evar_map -> evar_map -> evar_map
454	454
455	455	val undefined_metas : evar_map -> metavariable list
456	456	val map_metas_fvalue : (constr -> constr) -> evar_map -> evar_map

+1

-1

pretyping/find_subterm.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/find_subterm.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/glob_ops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/glob_ops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/indrec.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/indrec.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/inductiveops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/inductiveops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/locusops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/locusops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/miscops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/miscops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/namegen.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/namegen.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/nativenorm.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/nativenorm.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+8

-23

pretyping/patternops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

121	121	\| _ -> anomaly (Pp.str "Not a rigid reference")
122	122
123	123	let pattern_of_constr env sigma t =
124		let ctx = ref [] in
125		let keep = ref Evar.Set.empty in
126		let remove = ref Evar.Set.empty in
127	124	let rec pattern_of_constr env t =
128	125	match kind_of_term t with
129	126	\| Rel n -> PRel n

142	139	\| App (f,a) ->
143	140	(match
144	141	match kind_of_term f with
145		\| Evar (evk,args as ev) ->
	142	\| Evar (evk,args) ->
146	143	(match snd (Evd.evar_source evk sigma) with
147		Evar_kinds.MatchingVar (true,id) ->
148		let ty = Evarutil.nf_evar sigma (existential_type sigma ev) in
149		ctx := (id,None,ty)::!ctx;
150		keep := Evar.Set.union (evars_of_term ty) !keep;
151		remove := Evar.Set.add evk !remove;
152		Some id
	144	Evar_kinds.MatchingVar (true,id) -> Some id
153	145	\| _ -> None)
154	146	\| _ -> None
155	147	with

161	153	\| Proj (p, c) ->
162	154	pattern_of_constr env (Retyping.expand_projection env sigma p c [])
163	155	\| Evar (evk,ctxt as ev) ->
164		remove := Evar.Set.add evk !remove;
165	156	(match snd (Evd.evar_source evk sigma) with
166	157	\| Evar_kinds.MatchingVar (b,id) ->
167	158	let ty = Evarutil.nf_evar sigma (existential_type sigma ev) in
168		ctx := (id,None,ty)::!ctx;
169		let () = ignore (pattern_of_constr env ty) in
170		assert (not b); PMeta (Some id)
	159	let () = ignore (pattern_of_constr env ty) in
	160	assert (not b); PMeta (Some id)
171	161	\| Evar_kinds.GoalEvar ->
172	162	PEvar (evk,Array.map (pattern_of_constr env) ctxt)
173	163	\| _ ->

188	178	Array.to_list (Array.mapi branch_of_constr br))
189	179	\| Fix f -> PFix f
190	180	\| CoFix f -> PCoFix f in
191		let p = pattern_of_constr env t in
192		let remove = Evar.Set.diff !remove !keep in
193		let sigma = Evar.Set.fold (fun ev acc -> Evd.remove acc ev) remove sigma in
194		(* side-effect *)
195		(* Warning: the order of dependencies in ctx is not ensured *)
196		(sigma,!ctx,p)
	181	pattern_of_constr env t
197	182
198	183	(* To process patterns, we need a translation without typing at all. *)
199	184

233	218	ctx
234	219	in
235	220	let c = substl inst c in
236		pi3 (pattern_of_constr env sigma c)
	221	pattern_of_constr env sigma c
237	222	with Not_found (* List.index failed *) ->
238	223	let vars =
239	224	List.map_filter (function Name id -> Some id \| _ -> None) vars in

258	243	\| PRef ref ->
259	244	let ref',t = subst_global subst ref in
260	245	if ref' == ref then pat else
261		pi3 (pattern_of_constr (Global.env()) Evd.empty t)
	246	pattern_of_constr (Global.env()) Evd.empty t
262	247	\| PVar _
263	248	\| PEvar _
264	249	\| PRel _ -> pat

+2

-3

pretyping/patternops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

38	38	a pattern; currently, no destructor (Cases, Fix, Cofix) and no
39	39	existential variable are allowed in [c] *)
40	40
41		val pattern_of_constr : Environ.env -> Evd.evar_map -> constr ->
42		Evd.evar_map * named_context * constr_pattern
	41	val pattern_of_constr : Environ.env -> Evd.evar_map -> constr -> constr_pattern
43	42
44	43	(** [pattern_of_glob_constr l c] translates a term [c] with metavariables into
45	44	a pattern; variables bound in [l] are replaced by the pattern to which they

+1

-1

pretyping/pretype_errors.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/pretype_errors.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+40

-26

pretyping/pretyping.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

182	182	expand_evars : bool
183	183	}
184	184
	185	let frozen_holes (sigma, sigma') =
	186	let fold evk _ accu = Evar.Set.add evk accu in
	187	Evd.fold_undefined fold sigma Evar.Set.empty
	188
185	189	let pending_holes (sigma, sigma') =
186	190	let fold evk _ accu =
187	191	if not (Evd.mem sigma evk) then Evar.Set.add evk accu else accu
188	192	in
189	193	Evd.fold_undefined fold sigma' Evar.Set.empty
190	194
191		let apply_typeclasses env evdref pending fail_evar =
192		let filter_pending evk = Evar.Set.mem evk pending in
	195	let apply_typeclasses env evdref frozen fail_evar =
	196	let filter_frozen evk = Evar.Set.mem evk frozen in
193	197	evdref := Typeclasses.resolve_typeclasses
194	198	~filter:(if Flags.is_program_mode ()
195		then (fun evk evi -> Typeclasses.no_goals_or_obligations evk evi && filter_pending evk)
196		else (fun evk evi -> Typeclasses.no_goals evk evi && filter_pending evk))
	199	then (fun evk evi -> Typeclasses.no_goals_or_obligations evk evi && not (filter_frozen evk))
	200	else (fun evk evi -> Typeclasses.no_goals evk evi && not (filter_frozen evk)))
197	201	~split:true ~fail:fail_evar env !evdref;
198	202	if Flags.is_program_mode () then (* Try optionally solving the obligations *)
199	203	evdref := Typeclasses.resolve_typeclasses
200		~filter:(fun evk evi -> Typeclasses.all_evars evk evi && filter_pending evk) ~split:true ~fail:false env !evdref
	204	~filter:(fun evk evi -> Typeclasses.all_evars evk evi && not (filter_frozen evk)) ~split:true ~fail:false env !evdref
201	205
202	206	let apply_inference_hook hook evdref pending =
203	207	evdref := Evar.Set.fold (fun evk sigma ->

218	222	with e when Errors.noncritical e ->
219	223	let e = Errors.push e in if fail_evar then iraise e
220	224
221		let check_typeclasses_instances_are_solved env current_sigma pending =
	225	let check_typeclasses_instances_are_solved env current_sigma frozen =
222	226	(* Naive way, call resolution again with failure flag *)
223		apply_typeclasses env (ref current_sigma) pending true
	227	apply_typeclasses env (ref current_sigma) frozen true
224	228
225	229	let check_extra_evars_are_solved env current_sigma pending =
226	230	Evar.Set.iter

232	236	\| _ ->
233	237	error_unsolvable_implicit loc env current_sigma evk None) pending
234	238
235		let check_evars_are_solved env current_sigma pending =
236		check_typeclasses_instances_are_solved env current_sigma pending;
	239	let check_evars_are_solved env current_sigma frozen pending =
	240	check_typeclasses_instances_are_solved env current_sigma frozen;
237	241	check_problems_are_solved env current_sigma;
238	242	check_extra_evars_are_solved env current_sigma pending
239	243
240	244	(* Try typeclasses, hooks, unification heuristics ... *)
241	245
242	246	let solve_remaining_evars flags env current_sigma pending =
	247	let frozen = frozen_holes pending in
243	248	let pending = pending_holes pending in
244	249	let evdref = ref current_sigma in
245		if flags.use_typeclasses then apply_typeclasses env evdref pending false;
	250	if flags.use_typeclasses then apply_typeclasses env evdref frozen false;
246	251	if Option.has_some flags.use_hook then
247	252	apply_inference_hook (Option.get flags.use_hook env) evdref pending;
248	253	if flags.use_unif_heuristics then apply_heuristics env evdref false;
249		if flags.fail_evar then check_evars_are_solved env !evdref pending;
	254	if flags.fail_evar then check_evars_are_solved env !evdref frozen pending;
250	255	!evdref
251	256
252	257	let check_evars_are_solved env current_sigma pending =
	258	let frozen = frozen_holes pending in
253	259	let pending = pending_holes pending in
254		check_evars_are_solved env current_sigma pending
	260	check_evars_are_solved env current_sigma frozen pending
255	261
256	262	let process_inference_flags flags env initial_sigma (sigma,c) =
257	263	let sigma = solve_remaining_evars flags env sigma (initial_sigma, sigma) in

393	399	match us with
394	400	\| None -> evd, None
395	401	\| Some l ->
396		let _, ctx = Universes.unsafe_constr_of_global gr in
397		let arr = Univ.Instance.to_array (Univ.UContext.instance ctx) in
398		let len = Array.length arr in
399		if len != List.length l then
400		user_err_loc (loc, "pretype",
401		str "Universe instance should have length " ++ int len)
402		else
403		let evd, l' = List.fold_left (fun (evd, univs) l ->
	402	let _, ctx = Universes.unsafe_constr_of_global gr in
	403	let arr = Univ.Instance.to_array (Univ.UContext.instance ctx) in
	404	let len = Array.length arr in
	405	if len != List.length l then
	406	user_err_loc (loc, "pretype",
	407	str "Universe instance should have length " ++ int len)
	408	else
	409	let evd, l' = List.fold_left (fun (evd, univs) l ->
404	410	let evd, l = interp_universe_level_name evd l in
405	411	(evd, l :: univs)) (evd, []) l
406		in
407		evd, Some (Univ.Instance.of_array (Array.of_list (List.rev l')))
	412	in
	413	if List.exists (fun l -> Univ.Level.is_prop l) l' then
	414	user_err_loc (loc, "pretype",
	415	str "Universe instances cannot contain Prop, polymorphic" ++
	416	str " universe instances must be greater or equal to Set.");
	417	evd, Some (Univ.Instance.of_array (Array.of_list (List.rev l')))
408	418	in
409	419	Evd.fresh_global ~rigid ?names:instance env evd gr
410	420

439	449
440	450	let new_type_evar env evdref loc =
441	451	let e, s =
442		evd_comb0 (fun evd -> Evarutil.new_type_evar env evd univ_flexible_alg ~src:(loc,Evar_kinds.InternalHole)) evdref
	452	evd_comb0 (fun evd -> Evarutil.new_type_evar env evd
	453	univ_flexible_alg ~src:(loc,Evar_kinds.InternalHole)) evdref
443	454	in e
444	455
445	456	let get_projection env cst =
446	457	let cb = lookup_constant cst env in
447	458	match cb.Declarations.const_proj with
448		\| Some {Declarations.proj_ind = mind; proj_npars = n; proj_arg = m; proj_type = ty} ->
	459	\| Some {Declarations.proj_ind = mind; proj_npars = n;
	460	proj_arg = m; proj_type = ty} ->
449	461	(cst,mind,n,m,ty)
450	462	\| None -> raise Not_found
451	463

738	750	pretype (mk_tycon tj.utj_val) env evdref lvar c
739	751	\| _ -> pretype empty_tycon env evdref lvar c1
740	752	in
741		let t = j.uj_type in
	753	let t = evd_comb1 (Evarsolve.refresh_universes
	754	~onlyalg:true ~status:Evd.univ_flexible (Some false) env)
	755	evdref j.uj_type in
742	756	(* The name specified by ltac is used also to create bindings. So
743	757	the substitution must also be applied on variables before they are
744	758	looked up in the rel context. *)

+1

-1

pretyping/pretyping.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/program.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/program.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/recordops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/recordops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/redops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/redops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+10

-5

pretyping/reductionops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

1250	1250	\| Reduction.CUMUL -> Reduction.CONV
1251	1251	\| Reduction.CONV -> Reduction.CONV
1252	1252
	1253	let report_anomaly _ =
	1254	let e = UserError ("", Pp.str "Conversion test raised an anomaly") in
	1255	let e = Errors.push e in
	1256	iraise e
	1257
1253	1258	let test_trans_conversion (f: ?l2r:bool-> ?evars:'a->'b) reds env sigma x y =
1254	1259	try
1255	1260	let evars ev = safe_evar_value sigma ev in
1256	1261	let _ = f ~evars reds env (Evd.universes sigma) x y in
1257	1262	true
1258	1263	with Reduction.NotConvertible -> false
1259		\| e when is_anomaly e -> error "Conversion test raised an anomaly"
	1264	\| e when is_anomaly e -> report_anomaly e
1260	1265
1261	1266	let is_trans_conv reds env sigma = test_trans_conversion Reduction.trans_conv_universes reds env sigma
1262	1267	let is_trans_conv_leq reds env sigma = test_trans_conversion Reduction.trans_conv_leq_universes reds env sigma

1274	1279	try f ~evars:(safe_evar_value sigma) ts env (Evd.universes sigma) x y; true
1275	1280	with Reduction.NotConvertible -> false
1276	1281	\| Univ.UniverseInconsistency _ -> false
1277		\| e when is_anomaly e -> error "Conversion test raised an anomaly"
	1282	\| e when is_anomaly e -> report_anomaly e
1278	1283
1279	1284	let sigma_compare_sorts env pb s0 s1 sigma =
1280	1285	match pb with

1315	1320	with
1316	1321	\| Reduction.NotConvertible -> sigma, false
1317	1322	\| Univ.UniverseInconsistency _ when catch_incon -> sigma, false
1318		\| e when is_anomaly e -> error "Conversion test raised an anomaly"
	1323	\| e when is_anomaly e -> report_anomaly e
1319	1324
1320	1325	let infer_conv = infer_conv_gen (fun pb ~l2r sigma ->
1321	1326	Reduction.generic_conv pb ~l2r (safe_evar_value sigma))

1645	1650	if Int.equal n 0 then applist (substl env t, stack) else
1646	1651	match kind_of_term t, stack with
1647	1652	\| Lambda(_,_,c), arg::stacktl -> stacklam (n-1) (arg::env) c stacktl
1648		\| LetIn(_,b,_,c), _ -> stacklam (n-1) (b::env) c stack
	1653	\| LetIn(_,b,_,c), _ -> stacklam (n-1) (substl env b::env) c stack
1649	1654	\| Evar ev, _ ->
1650	1655	(match safe_evar_value sigma ev with
1651	1656	\| Some body -> stacklam n env body stack

+1

-1

pretyping/reductionops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/retyping.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/retyping.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/tacred.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/tacred.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

pretyping/termops.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

929	929	match sign, l with
930	930	\| (_,None,_)::sign', a::args' -> aux (a::subst) sign' args'
931	931	\| (_,Some c,_)::sign', args' ->
932		aux (substl (List.rev subst) c :: subst) sign' args'
	932	aux (substl subst c :: subst) sign' args'
933	933	\| [], [] -> List.rev subst
934	934	\| _ -> anomaly (Pp.str "Instance and signature do not match")
935	935	in aux [] (List.rev sign) l

+1

-1

pretyping/termops.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/typeclasses.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/typeclasses.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/typeclasses_errors.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

pretyping/typeclasses_errors.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+16

-4

pretyping/typing.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

143	143	{ uj_val = mkCast (cj.uj_val, k, expected_type);
144	144	uj_type = expected_type }
145	145
146		(* The typing machine without information, without universes but with
147		existential variables. *)
	146	let enrich_env env evdref =
	147	let penv = Environ.pre_env env in
	148	let penv' = Pre_env.({ penv with env_stratification =
	149	{ penv.env_stratification with env_universes = Evd.universes !evdref } }) in
	150	Environ.env_of_pre_env penv'
	151
	152	(* The typing machine with universes and existential variables. *)
148	153
149	154	(* cstr must be in n.f. w.r.t. evars and execute returns a judgement
150	155	where both the term and type are in n.f. *)

263	268	and execute_array env evdref = Array.map (execute env evdref)
264	269
265	270	let check env evdref c t =
	271	let env = enrich_env env evdref in
266	272	let j = execute env evdref c in
267	273	if not (Evarconv.e_cumul env evdref j.uj_type t) then
268	274	error_actual_type env j (nf_evar !evdref t)

270	276	(* Type of a constr *)
271	277
272	278	let unsafe_type_of env evd c =
273		let j = execute env (ref evd) c in
	279	let evdref = ref evd in
	280	let env = enrich_env env evdref in
	281	let j = execute env evdref c in
274	282	j.uj_type
275	283
276	284	(* Sort of a type *)
277	285
278	286	let sort_of env evdref c =
	287	let env = enrich_env env evdref in
279	288	let j = execute env evdref c in
280	289	let a = e_type_judgment env evdref j in
281	290	a.utj_type

284	293
285	294	let type_of ?(refresh=false) env evd c =
286	295	let evdref = ref evd in
	296	let env = enrich_env env evdref in
287	297	let j = execute env evdref c in
288	298	(* side-effect on evdref *)
289	299	if refresh then

291	301	else !evdref, j.uj_type
292	302
293	303	let e_type_of ?(refresh=false) env evdref c =
	304	let env = enrich_env env evdref in
294	305	let j = execute env evdref c in
295	306	(* side-effect on evdref *)
296	307	if refresh then

300	311	else j.uj_type
301	312
302	313	let solve_evars env evdref c =
	314	let env = enrich_env env evdref in
303	315	let c = (execute env evdref c).uj_val in
304	316	(* side-effect on evdref *)
305	317	nf_evar !evdref c

+1

-1

pretyping/typing.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+22

-5

pretyping/unification.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

35	35	Goptions.optread = (fun () -> !keyed_unification);
36	36	Goptions.optwrite = (fun a -> keyed_unification:=a);
37	37	}
	38
	39	let is_keyed_unification () = !keyed_unification
38	40
39	41	let debug_unification = ref (false)
40	42	let _ = Goptions.declare_bool_option {

903	905	match subst_defined_metas_evars subst cN with
904	906	\| None -> (* some undefined Metas in cN *) None
905	907	\| Some n1 ->
906		(* No subterm restriction there, too much incompatibilities *)
907		let sigma, b = infer_conv ~pb ~ts:convflags curenv sigma m1 n1 in
	908	(* No subterm restriction there, too much incompatibilities *)
	909	let sigma =
	910	if opt.with_types then
	911	try (* Ensure we call conversion on terms of the same type *)
	912	let tyM = get_type_of curenv ~lax:true sigma m1 in
	913	let tyN = get_type_of curenv ~lax:true sigma n1 in
	914	check_compatibility curenv CUMUL flags substn tyM tyN
	915	with RetypeError _ ->
	916	(* Renounce, maybe metas/evars prevents typing *) sigma
	917	else sigma
	918	in
	919	let sigma, b = infer_conv ~pb ~ts:convflags curenv sigma m1 n1 in
908	920	if b then Some (sigma, metasubst, evarsubst)
909	921	else
910	922	if is_ground_term sigma m1 && is_ground_term sigma n1 then

1636	1648	let cl = strip_outer_cast cl in
1637	1649	(try
1638	1650	if closed0 cl && not (isEvar cl) && keyed_unify env evd kop cl then
1639		(try w_typed_unify env evd CONV flags op cl,cl
1640		with ex when Pretype_errors.unsatisfiable_exception ex ->
	1651	(try
	1652	if !keyed_unification then
	1653	let f1, l1 = decompose_app_vect op in
	1654	let f2, l2 = decompose_app_vect cl in
	1655	w_typed_unify_array env evd flags f1 l1 f2 l2,cl
	1656	else w_typed_unify env evd CONV flags op cl,cl
	1657	with ex when Pretype_errors.unsatisfiable_exception ex ->
1641	1658	bestexn := Some ex; error "Unsat")
1642	1659	else error "Bound 1"
1643	1660	with ex when precatchable_exception ex ->

+3

-1

pretyping/unification.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

40	40
41	41	val elim_flags : unit -> unify_flags
42	42	val elim_no_delta_flags : unit -> unify_flags
	43
	44	val is_keyed_unification : unit -> bool
43	45
44	46	(** The "unique" unification fonction *)
45	47	val w_unify :

+6

-5

pretyping/vnorm.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

58	58	let s = ind_subst mind mib u in
59	59	let ctyp = substl s typ in
60	60	let ctyp = subst_instance_constr u ctyp in
61		let nparams = Array.length params in
62		if Int.equal nparams 0 then ctyp
	61	let ndecls = Context.rel_context_length mib.mind_params_ctxt in
	62	if Int.equal ndecls 0 then ctyp
63	63	else
64		let _,ctyp = decompose_prod_n nparams ctyp in
65		substl (Array.rev_to_list params) ctyp
	64	let _,ctyp = decompose_prod_n_assum ndecls ctyp in
	65	substl (List.rev (Termops.adjust_subst_to_rel_context mib.mind_params_ctxt (Array.to_list params)))
	66	ctyp
66	67
67	68
68	69

+1

-1

pretyping/vnorm.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/genprint.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/genprint.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/miscprint.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/miscprint.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/ppannotation.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/ppannotation.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+6

-6

printing/ppconstr.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

637	637	\| CLetTuple (_,nal,(na,po),c,b) ->
638	638	return (
639	639	hv 0 (
640		keyword "let" ++ spc () ++
641		hov 0 (str "(" ++
	640	hov 2 (keyword "let" ++ spc () ++
	641	hov 1 (str "(" ++
642	642	prlist_with_sep sep_v pr_lname nal ++
643	643	str ")" ++
644		pr_simple_return_type (pr mt) na po ++ str " :=" ++
645		pr spc ltop c ++ spc ()
646		++ keyword "in") ++
	644	pr_simple_return_type (pr mt) na po ++ str " :=") ++
	645	pr spc ltop c
	646	++ keyword " in") ++
647	647	pr spc ltop b),
648	648	lletin
649	649	)

+1

-1

printing/ppconstr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/ppconstrsig.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-3

printing/pptactic.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

580	580
581	581	let pr_in_hyp_as prc pr_id = function
582	582	\| None -> mt ()
583		\| Some (clear,id,ipat) ->
584		pr_in (spc () ++ pr_clear_flag clear pr_id id) ++ pr_as_ipat prc ipat
	583	\| Some (id,ipat) -> pr_in (spc () ++ pr_id id) ++ pr_as_ipat prc ipat
585	584
586	585	let pr_clauses default_is_concl pr_id = function
587	586	\| { onhyps=Some []; concl_occs=occs }

+1

-1

printing/pptactic.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/pptacticsig.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/pputils.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/pputils.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/ppvernac.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/ppvernac.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/ppvernacsig.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/prettyp.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/prettyp.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/printer.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/printer.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/printmod.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/printmod.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/printmodsig.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

printing/richprinter.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-3

proofs/clenv.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

378	378	{ (default_unify_flags ()) with
379	379	allow_K_in_toplevel_higher_order_unification = true }
380	380
381		let clenv_fchain ?(flags=fchain_flags ()) mv clenv nextclenv =
	381	let clenv_fchain ?with_univs ?(flags=fchain_flags ()) mv clenv nextclenv =
382	382	(* Add the metavars of [nextclenv] to [clenv], with their name-environment *)
383	383	let clenv' =
384	384	{ templval = clenv.templval;
385	385	templtyp = clenv.templtyp;
386		evd = meta_merge nextclenv.evd clenv.evd;
	386	evd = meta_merge ?with_univs nextclenv.evd clenv.evd;
387	387	env = nextclenv.env } in
388	388	(* unify the type of the template of [nextclenv] with the type of [mv] *)
389	389	let clenv'' =

+2

-2

proofs/clenv.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

50	50
51	51	val connect_clenv : Goal.goal sigma -> clausenv -> clausenv
52	52	val clenv_fchain :
53		?flags:unify_flags -> metavariable -> clausenv -> clausenv -> clausenv
	53	?with_univs:bool -> ?flags:unify_flags -> metavariable -> clausenv -> clausenv -> clausenv
54	54
55	55	(** {6 Unification with clenvs } *)
56	56

+1

-1

proofs/clenvtac.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/clenvtac.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/evar_refiner.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/evar_refiner.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/goal.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/goal.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/logic.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/logic.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/logic_monad.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/logic_monad.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+8

-4

proofs/pfedit.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

19	19	let get_all_proof_names = Proof_global.get_all_proof_names
20	20
21	21	type lemma_possible_guards = Proof_global.lemma_possible_guards
	22	type universe_binders = Proof_global.universe_binders
22	23
23	24	let delete_proof = Proof_global.discard
24	25	let delete_current_proof = Proof_global.discard_current
25	26	let delete_all_proofs = Proof_global.discard_all
26	27
27		let start_proof (id : Id.t) str sigma hyps c ?init_tac terminator =
	28	let start_proof (id : Id.t) ?pl str sigma hyps c ?init_tac terminator =
28	29	let goals = [ (Global.env_of_context hyps , c) ] in
29		Proof_global.start_proof sigma id str goals terminator;
	30	Proof_global.start_proof sigma id ?pl str goals terminator;
30	31	let env = Global.env () in
31	32	ignore (Proof_global.with_current_proof (fun _ p ->
32	33	match init_tac with

52	53	Proof_global.set_used_variables l
53	54	let get_used_variables () =
54	55	Proof_global.get_used_variables ()
	56
	57	let get_universe_binders () =
	58	Proof_global.get_universe_binders ()
55	59
56	60	exception NoSuchGoal
57	61	let _ = Errors.register_handler begin function

138	142	let status = by tac in
139	143	let _,(const,univs,_) = cook_proof () in
140	144	delete_current_proof ();
141		const, status, univs
	145	const, status, fst univs
142	146	with reraise ->
143	147	let reraise = Errors.push reraise in
144	148	delete_current_proof ();

+7

-2

proofs/pfedit.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

54	54
55	55	type lemma_possible_guards = Proof_global.lemma_possible_guards
56	56
	57	type universe_binders = Id.t Loc.located list
	58
57	59	val start_proof :
58		Id.t -> goal_kind -> Evd.evar_map -> named_context_val -> constr ->
	60	Id.t -> ?pl:universe_binders -> goal_kind -> Evd.evar_map -> named_context_val -> constr ->
59	61	?init_tac:unit Proofview.tactic ->
60	62	Proof_global.proof_terminator -> unit
61	63

120	122	Id.t list -> Context.section_context * (Loc.t * Names.Id.t) list
121	123	val get_used_variables : unit -> Context.section_context option
122	124
	125	(** {6 Universe binders } *)
	126	val get_universe_binders : unit -> universe_binders option
	127
123	128	(** {6 ... } *)
124	129	(** [solve (SelectNth n) tac] applies tactic [tac] to the [n]th
125	130	subgoal of the current focused proof or raises a [UserError] if no

+1

-1

proofs/proof.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/proof.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+28

-14

proofs/proof_global.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

62	62
63	63	(* Extra info on proofs. *)
64	64	type lemma_possible_guards = int list list
65		type proof_universes = Evd.evar_universe_context
	65	type proof_universes = Evd.evar_universe_context * Universes.universe_binders option
	66	type universe_binders = Id.t Loc.located list
66	67
67	68	type proof_object = {
68	69	id : Names.Id.t;
69	70	entries : Safe_typing.private_constants Entries.definition_entry list;
70	71	persistence : Decl_kinds.goal_kind;
71	72	universes: proof_universes;
72		(* constraints : Univ.constraints; *)
73	73	}
74	74
75	75	type proof_ending =

88	88	proof : Proof.proof;
89	89	strength : Decl_kinds.goal_kind;
90	90	mode : proof_mode Ephemeron.key;
	91	universe_binders: universe_binders option;
91	92	}
92	93
93	94	(* The head of [!pstates] is the actual current proof, the other ones are

225	226	end of the proof to close the proof. The proof is started in the
226	227	evar map [sigma] (which can typically contain universe
227	228	constraints). *)
228		let start_proof sigma id str goals terminator =
	229	let start_proof sigma id ?pl str goals terminator =
229	230	let initial_state = {
230	231	pid = id;
231	232	terminator = Ephemeron.create terminator;

233	234	endline_tactic = None;
234	235	section_vars = None;
235	236	strength = str;
236		mode = find_proof_mode "No" } in
	237	mode = find_proof_mode "No";
	238	universe_binders = pl } in
237	239	push initial_state pstates
238	240
239		let start_dependent_proof id str goals terminator =
	241	let start_dependent_proof id ?pl str goals terminator =
240	242	let initial_state = {
241	243	pid = id;
242	244	terminator = Ephemeron.create terminator;

244	246	endline_tactic = None;
245	247	section_vars = None;
246	248	strength = str;
247		mode = find_proof_mode "No" } in
	249	mode = find_proof_mode "No";
	250	universe_binders = pl } in
248	251	push initial_state pstates
249	252
250	253	let get_used_variables () = (cur_pstate ()).section_vars
251
252		let proof_using_auto_clear = ref true
	254	let get_universe_binders () = (cur_pstate ()).universe_binders
	255
	256	let proof_using_auto_clear = ref false
253	257	let _ = Goptions.declare_bool_option
254	258	{ Goptions.optsync = true;
255	259	Goptions.optdepr = false;

295	299	List.length shelf
296	300
297	301	let close_proof ~keep_body_ucst_separate ?feedback_id ~now fpl =
298		let { pid; section_vars; strength; proof; terminator } = cur_pstate () in
	302	let { pid; section_vars; strength; proof; terminator; universe_binders } =
	303	cur_pstate () in
299	304	let poly = pi2 strength (* Polymorphic *) in
300	305	let initial_goals = Proof.initial_goals proof in
301	306	let initial_euctx = Proof.initial_euctx proof in

327	332	(* For vi2vo compilation proofs are computed now but we need to
328	333	* complement the univ constraints of the typ with the ones of
329	334	* the body. So we keep the two sets distinct. *)
330		let ctx_body = restrict_universe_context ctx used_univs_body in
	335	let used_univs = Univ.LSet.union used_univs_body used_univs_typ in
	336	let ctx_body = restrict_universe_context ctx used_univs in
331	337	(initunivs, typ), ((body, ctx_body), eff)
332	338	else
333	339	let initunivs = Univ.UContext.empty in

361	367	const_entry_opaque = true;
362	368	const_entry_universes = univs;
363	369	const_entry_polymorphic = poly})
364		fpl initial_goals in
365		{ id = pid; entries = entries; persistence = strength; universes = universes },
	370	fpl initial_goals in
	371	let binders =
	372	Option.map (fun names -> fst (Evd.universe_context ~names (Evd.from_ctx universes)))
	373	universe_binders
	374	in
	375	{ id = pid; entries = entries; persistence = strength;
	376	universes = (universes, binders) },
366	377	fun pr_ending -> Ephemeron.get terminator pr_ending
367	378
368	379	type closed_proof_output = (Term.constr * Safe_typing.private_constants) list * Evd.evar_universe_context

611	622	(!current_behavior).name
612	623	end;
613	624	optwrite = begin fun n ->
614		current_behavior := Hashtbl.find behaviors n
	625	current_behavior :=
	626	try Hashtbl.find behaviors n
	627	with Not_found ->
	628	Errors.error ("Unknown bullet behavior: \"" ^ n ^ "\".")
615	629	end
616	630	}
617	631

+11

-8

proofs/proof_global.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

54	54	(i.e. an proof ending command) and registers the appropriate
55	55	values. *)
56	56	type lemma_possible_guards = int list list
57		type proof_universes = Evd.evar_universe_context
	57	type proof_universes = Evd.evar_universe_context * Universes.universe_binders option
	58	type universe_binders = Names.Id.t Loc.located list
58	59	type proof_object = {
59	60	id : Names.Id.t;
60	61	entries : Safe_typing.private_constants Entries.definition_entry list;
61	62	persistence : Decl_kinds.goal_kind;
62	63	universes: proof_universes;
63		(* constraints : Univ.constraints; *)
64		(** guards : lemma_possible_guards; *)
65	64	}
66	65
67	66	type proof_ending =
68		\| Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry * proof_universes
	67	\| Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry *
	68	proof_universes
69	69	\| Proved of Vernacexpr.opacity_flag *
70	70	(Vernacexpr.lident * Decl_kinds.theorem_kind option) option *
71	71	proof_object

79	79	closing commands and the xml plugin); [terminator] is used at the
80	80	end of the proof to close the proof. *)
81	81	val start_proof :
82		Evd.evar_map -> Names.Id.t -> Decl_kinds.goal_kind -> (Environ.env * Term.types) list ->
	82	Evd.evar_map -> Names.Id.t -> ?pl:universe_binders ->
	83	Decl_kinds.goal_kind -> (Environ.env * Term.types) list ->
83	84	proof_terminator -> unit
84	85
85	86	(** Like [start_proof] except that there may be dependencies between
86	87	initial goals. *)
87	88	val start_dependent_proof :
88		Names.Id.t -> Decl_kinds.goal_kind -> Proofview.telescope ->
89		proof_terminator -> unit
	89	Names.Id.t -> ?pl:universe_binders -> Decl_kinds.goal_kind ->
	90	Proofview.telescope -> proof_terminator -> unit
90	91
91	92	(** Update the proofs global environment after a side-effecting command
92	93	(e.g. a sublemma definition) has been run inside it. Assumes

138	139	val set_used_variables :
139	140	Names.Id.t list -> Context.section_context * (Loc.t * Names.Id.t) list
140	141	val get_used_variables : unit -> Context.section_context option
	142
	143	val get_universe_binders : unit -> universe_binders option
141	144
142	145	(**********************************************************)
143	146	(* *)

+1

-1

proofs/proof_type.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/proof_type.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/proof_using.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/proof_using.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+54

-13

proofs/proofview.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

31	31	let proofview p =
32	32	p.comb , p.solution
33	33
34		let compact el { comb; solution } =
	34	let compact el ({ solution } as pv) =
35	35	let nf = Evarutil.nf_evar solution in
36	36	let size = Evd.fold (fun _ _ i -> i+1) solution 0 in
37	37	let new_el = List.map (fun (t,ty) -> nf t, nf ty) el in

44	44	let new_solution = Evd.raw_map_undefined apply_subst_einfo pruned_solution in
45	45	let new_size = Evd.fold (fun _ _ i -> i+1) new_solution 0 in
46	46	msg_info (Pp.str (Printf.sprintf "Evars: %d -> %d\n" size new_size));
47		new_el, { comb; solution = new_solution }
	47	new_el, { pv with solution = new_solution; }
48	48
49	49
50	50	(** {6 Starting and querying a proof view} *)

61	61	let src = (Loc.ghost,Evar_kinds.GoalEvar) in
62	62	(* Main routine *)
63	63	let rec aux = function
64		\| TNil sigma -> [], { solution = sigma; comb = []; }
	64	\| TNil sigma -> [], { solution = sigma; comb = []; shelf = [] }
65	65	\| TCons (env, sigma, typ, t) ->
66	66	let (sigma, econstr ) = Evarutil.new_evar env sigma ~src ~store typ in
67	67	let ret, { solution = sol; comb = comb } = aux (t sigma econstr) in
68	68	let (gl, _) = Term.destEvar econstr in
69	69	let entry = (econstr, typ) :: ret in
70		entry, { solution = sol; comb = gl :: comb; }
	70	entry, { solution = sol; comb = gl :: comb; shelf = [] }
71	71	in
72	72	fun t ->
73	73	let entry, v = aux t in

231	231	match ans with
232	232	\| Nil (e, info) -> iraise (TacticFailure e, info)
233	233	\| Cons ((r, (state, _), status, info), _) ->
	234	let (status, gaveup) = status in
	235	let status = (status, state.shelf, gaveup) in
	236	let state = { state with shelf = [] } in
234	237	r, state, status, Trace.to_tree info
235	238
236	239

577	580	Comb.get >>= fun initial ->
578	581	Comb.set [] >>
579	582	InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve")) >>
580		Shelf.put initial
	583	Shelf.modify (fun gls -> gls @ initial)
581	584
582	585
583	586	(** [contained_in_info e evi] checks whether the evar [e] appears in

616	619	let (u,n) = partition_unifiable initial.solution initial.comb in
617	620	Comb.set n >>
618	621	InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_unifiable")) >>
619		Shelf.put u
	622	Shelf.modify (fun gls -> gls @ u)
620	623
621	624	(** [guard_no_unifiable] fails with error [UnresolvedBindings] if some
622	625	goals are unifiable (see {!shelve_unifiable}) in the current focus. *)

638	641	let l = undefined p.solution l in
639	642	{ p with comb = p.comb@l }
640	643
	644	let with_shelf tac =
	645	let open Proof in
	646	Pv.get >>= fun pv ->
	647	let { shelf; solution } = pv in
	648	Pv.set { pv with shelf = []; solution = Evd.reset_future_goals solution } >>
	649	tac >>= fun ans ->
	650	Pv.get >>= fun npv ->
	651	let { shelf = gls; solution = sigma } = npv in
	652	let gls' = Evd.future_goals sigma in
	653	let fgoals = Evd.future_goals solution in
	654	let pgoal = Evd.principal_future_goal solution in
	655	let sigma = Evd.restore_future_goals sigma fgoals pgoal in
	656	Pv.set { npv with shelf; solution = sigma } >>
	657	tclUNIT (CList.rev_append gls' gls, ans)
641	658
642	659	(** [goodmod p m] computes the representative of [p] modulo [m] in the
643	660	interval [[0,m-1]].*)

866	883	let tclSETGOALS = Comb.set
867	884
868	885	let tclEVARSADVANCE evd =
869		Pv.modify (fun ps -> { solution = evd; comb = undefined evd ps.comb })
	886	Pv.modify (fun ps -> { ps with solution = evd; comb = undefined evd ps.comb })
870	887
871	888	let tclEVARUNIVCONTEXT ctx =
872	889	Pv.modify (fun ps -> { ps with solution = Evd.set_universe_context ps.solution ctx })

1009	1026	module Refine =
1010	1027	struct
1011	1028
	1029	let extract_prefix env info =
	1030	let ctx1 = List.rev (Environ.named_context env) in
	1031	let ctx2 = List.rev (Evd.evar_context info) in
	1032	let rec share l1 l2 accu = match l1, l2 with
	1033	\| d1 :: l1, d2 :: l2 ->
	1034	if d1 == d2 then share l1 l2 (d1 :: accu)
	1035	else (accu, d2 :: l2)
	1036	\| _ -> (accu, l2)
	1037	in
	1038	share ctx1 ctx2 []
	1039
1012	1040	let typecheck_evar ev env sigma =
1013	1041	let info = Evd.find sigma ev in
	1042	(** Typecheck the hypotheses. *)
	1043	let type_hyp (sigma, env) (na, body, t as decl) =
	1044	let evdref = ref sigma in
	1045	let _ = Typing.sort_of env evdref t in
	1046	let () = match body with
	1047	\| None -> ()
	1048	\| Some body -> Typing.check env evdref body t
	1049	in
	1050	(!evdref, Environ.push_named decl env)
	1051	in
	1052	let (common, changed) = extract_prefix env info in
	1053	let env = Environ.reset_with_named_context (Environ.val_of_named_context common) env in
	1054	let (sigma, env) = List.fold_left type_hyp (sigma, env) changed in
	1055	(** Typecheck the conclusion *)
1014	1056	let evdref = ref sigma in
1015		let env = Environ.reset_with_named_context (Evd.evar_hyps info) env in
1016	1057	let _ = Typing.sort_of env evdref (Evd.evar_concl info) in
1017	1058	!evdref
1018	1059

1060	1101	let sigma = CList.fold_left Unsafe.mark_as_goal_evm sigma comb in
1061	1102	let open Proof in
1062	1103	InfoL.leaf (Info.Tactic (fun () -> Pp.(hov 2 (str"refine"++spc()++ Hook.get pr_constrv env sigma c)))) >>
1063		Pv.set { solution = sigma; comb; }
	1104	Pv.modify (fun ps -> { ps with solution = sigma; comb; })
1064	1105	end
1065	1106
1066	1107	(** Useful definitions *)

1139	1180	let sgs = CList.flatten goalss in
1140	1181	let sgs = undefined evd sgs in
1141	1182	InfoL.leaf (Info.Tactic (fun () -> Pp.str"<unknown>")) >>
1142		Pv.set { solution = evd; comb = sgs; }
	1183	Pv.set { ps with solution = evd; comb = sgs; }
1143	1184	with e when catchable_exception e ->
1144	1185	let (e, info) = Errors.push e in
1145	1186	tclZERO ~info e

1151	1192	Pv.modify begin fun ps ->
1152	1193	let map g s = GoalV82.nf_evar s g in
1153	1194	let (goals,evd) = Evd.Monad.List.map map ps.comb ps.solution in
1154		{ solution = evd; comb = goals; }
	1195	{ ps with solution = evd; comb = goals; }
1155	1196	end
1156	1197
1157	1198	let has_unresolved_evar pv =

1196	1237
1197	1238	let of_tactic t gls =
1198	1239	try
1199		let init = { solution = gls.Evd.sigma ; comb = [gls.Evd.it] } in
	1240	let init = { shelf = []; solution = gls.Evd.sigma ; comb = [gls.Evd.it] } in
1200	1241	let (_,final,_,_) = apply (GoalV82.env gls.Evd.sigma gls.Evd.it) t init in
1201	1242	{ Evd.sigma = final.solution ; it = final.comb }
1202	1243	with Logic_monad.TacticFailure e as src ->

+5

-1

proofs/proofview.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

302	302	goals of p *)
303	303	val unshelve : Goal.goal list -> proofview -> proofview
304	304
	305	(** [with_shelf tac] executes [tac] and returns its result together with the set
	306	of goals shelved by [tac]. The current shelf is unchanged. *)
	307	val with_shelf : 'a tactic -> (Goal.goal list * 'a) tactic
	308
305	309	(** If [n] is positive, [cycle n] puts the [n] first goal last. If [n]
306	310	is negative, then it puts the [n] last goals first.*)
307	311	val cycle : int -> unit tactic

+18

-13

proofs/proofview_monad.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

156	156
157	157	(** Type of proof views: current [evar_map] together with the list of
158	158	focused goals. *)
159		type proofview = { solution : Evd.evar_map; comb : Goal.goal list }
160
	159	type proofview = {
	160	solution : Evd.evar_map;
	161	comb : Goal.goal list;
	162	shelf : Goal.goal list;
	163	}
161	164
162	165	(** {6 Instantiation of the logic monad} *)
163	166

170	173	type e = bool
171	174
172	175	(** Status (safe/unsafe) * shelved goals * given up *)
173		type w = bool * Evar.t list * Evar.t list
174
175		let wunit = true , [] , []
176		let wprod (b1,s1,g1) (b2,s2,g2) = b1 && b2 , s1@s2 , g1@g2
	176	type w = bool * Evar.t list
	177
	178	let wunit = true , []
	179	let wprod (b1, g1) (b2, g2) = b1 && b2 , g1@g2
177	180
178	181	type u = Info.state
179	182

225	228	end
226	229
227	230	module Status : Writer with type t := bool = struct
228		let put s = Logical.put (s,[],[])
229		end
230
231		module Shelf : Writer with type t = Evar.t list = struct
	231	let put s = Logical.put (s, [])
	232	end
	233
	234	module Shelf : State with type t = Evar.t list = struct
232	235	(* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *)
233	236	type t = Evar.t list
234		let put sh = Logical.put (true,sh,[])
	237	let get = Logical.map (fun {shelf} -> shelf) Pv.get
	238	let set c = Pv.modify (fun pv -> { pv with shelf = c })
	239	let modify f = Pv.modify (fun pv -> { pv with shelf = f pv.shelf })
235	240	end
236	241
237	242	module Giveup : Writer with type t = Evar.t list = struct
238	243	(* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *)
239	244	type t = Evar.t list
240		let put gs = Logical.put (true,[],gs)
	245	let put gs = Logical.put (true, gs)
241	246	end
242	247
243	248	(** Lens and utilies pertaining to the info trace *)

+9

-5

proofs/proofview_monad.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

67	67
68	68	(** Type of proof views: current [evar_map] together with the list of
69	69	focused goals. *)
70		type proofview = { solution : Evd.evar_map; comb : Goal.goal list }
	70	type proofview = {
	71	solution : Evd.evar_map;
	72	comb : Goal.goal list;
	73	shelf : Goal.goal list;
	74	}
71	75
72	76	(** {6 Instantiation of the logic monad} *)
73	77
74	78	module P : sig
75	79	type s = proofview * Environ.env
76	80
77		(** Status (safe/unsafe) * shelved goals * given up *)
78		type w = bool * Evar.t list * Evar.t list
	81	(** Status (safe/unsafe) * given up *)
	82	type w = bool * Evar.t list
79	83
80	84	val wunit : w
81	85	val wprod : w -> w -> w

122	126
123	127	(** Lens to the list of goals which have been shelved during the
124	128	execution of the tactic. *)
125		module Shelf : Writer with type t = Evar.t list
	129	module Shelf : State with type t = Evar.t list
126	130
127	131	(** Lens to the list of goals which were given up during the execution
128	132	of the tactic. *)

+1

-1

proofs/redexpr.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/redexpr.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/refiner.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/refiner.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/tacmach.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/tacmach.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/tactic_debug.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

proofs/tactic_debug.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-3

stm/asyncTaskQueue.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

124	124	"-async-proofs-worker-priority";
125	125	Flags.string_of_priority !Flags.async_proofs_worker_priority]
126	126	\| ("-ideslave"\|"-emacs"\|"-emacs-U"\|"-batch")::tl -> set_slave_opt tl
127		\| ("-async-proofs" \|"-toploop" \|"-vi2vo" \|"-compile"
128		\|"-load-vernac-source" \|"-compile-verbose"
	127	\| ("-async-proofs" \|"-toploop" \|"-vi2vo"
	128	\|"-load-vernac-source" \|"-l" \|"-load-vernac-source-verbose" \|"-lv"
	129	\|"-compile" \|"-compile-verbose"
129	130	\|"-async-proofs-worker-priority" \|"-worker-id") :: _ :: tl ->
130	131	set_slave_opt tl
131	132	\| x::tl -> x :: set_slave_opt tl in

+1

-1

stm/asyncTaskQueue.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/coqworkmgrApi.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/coqworkmgrApi.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/dag.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/dag.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+36

-33

stm/lemmas.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

185	185
186	186	(* Saving a goal *)
187	187
188		let save ?export_seff id const cstrs do_guard (locality,poly,kind) hook =
	188	let save ?export_seff id const cstrs pl do_guard (locality,poly,kind) hook =
189	189	let fix_exn = Future.fix_exn_of const.Entries.const_entry_body in
190	190	try
191	191	let const = adjust_guardness_conditions const do_guard in

204	204	declare_constant ?export_seff id ~local (DefinitionEntry const, k) in
205	205	(locality, ConstRef kn) in
206	206	definition_message id;
	207	Option.iter (Universes.register_universe_binders r) pl;
207	208	call_hook (fun exn -> exn) hook l r
208	209	with e when Errors.noncritical e ->
209	210	let e = Errors.push e in

218	219	locality == Global && Nametab.exists_cci (Lib.make_path_except_section id)
219	220	then
220	221	user_err_loc (loc,"",pr_id id ++ str " already exists.");
221		id
	222	id, pl
222	223	\| None ->
223		next_global_ident_away default_thm_id (Pfedit.get_all_proof_names ())
224
225		let save_remaining_recthms (locality,p,kind) norm ctx body opaq i (id,(t_i,(_,imps))) =
	224	next_global_ident_away default_thm_id (Pfedit.get_all_proof_names ()), None
	225
	226	let save_remaining_recthms (locality,p,kind) norm ctx body opaq i ((id,pl),(t_i,(_,imps))) =
226	227	let t_i = norm t_i in
227	228	match body with
228	229	\| None ->

275	276	let set_save_hook f = save_hook := f
276	277
277	278	let save_named ?export_seff proof =
278		let id,const,cstrs,do_guard,persistence,hook = proof in
279		save ?export_seff id const cstrs do_guard persistence hook
	279	let id,const,(cstrs,pl),do_guard,persistence,hook = proof in
	280	save ?export_seff id const cstrs pl do_guard persistence hook
280	281
281	282	let check_anonymity id save_ident =
282	283	if not (String.equal (atompart_of_id id) (Id.to_string (default_thm_id))) then
283	284	error "This command can only be used for unnamed theorem."
284	285
285
286	286	let save_anonymous ?export_seff proof save_ident =
287		let id,const,cstrs,do_guard,persistence,hook = proof in
	287	let id,const,(cstrs,pl),do_guard,persistence,hook = proof in
288	288	check_anonymity id save_ident;
289		save ?export_seff save_ident const cstrs do_guard persistence hook
	289	save ?export_seff save_ident const cstrs pl do_guard persistence hook
290	290
291	291	let save_anonymous_with_strength ?export_seff proof kind save_ident =
292		let id,const,cstrs,do_guard,_,hook = proof in
	292	let id,const,(cstrs,pl),do_guard,_,hook = proof in
293	293	check_anonymity id save_ident;
294	294	(* we consider that non opaque behaves as local for discharge *)
295		save ?export_seff save_ident const cstrs do_guard (Global, const.const_entry_polymorphic, Proof kind) hook
	295	save ?export_seff save_ident const cstrs pl do_guard
	296	(Global, const.const_entry_polymorphic, Proof kind) hook
296	297
297	298	(* Admitted *)
298	299
299		let admit (id,k,e) hook () =
	300	let admit (id,k,e) pl hook () =
300	301	let kn = declare_constant id (ParameterEntry e, IsAssumption Conjectural) in
301	302	let () = match k with
302	303	\| Global, _, _ -> ()

305	306	str "declared as an axiom.")
306	307	in
307	308	let () = assumption_message id in
	309	Option.iter (Universes.register_universe_binders (ConstRef kn)) pl;
308	310	call_hook (fun exn -> exn) hook Global (ConstRef kn)
309	311
310	312	(* Starting a goal *)

314	316
315	317
316	318	let get_proof proof do_guard hook opacity =
317		let (id,(const,cstrs,persistence)) =
	319	let (id,(const,univs,persistence)) =
318	320	Pfedit.cook_this_proof proof
319	321	in
320		(** FIXME *)
321		id,{const with const_entry_opaque = opacity},cstrs,do_guard,persistence,hook
	322	id,{const with const_entry_opaque = opacity},univs,do_guard,persistence,hook
322	323
323	324	let check_exist =
324	325	List.iter (fun (loc,id) ->

328	329
329	330	let universe_proof_terminator compute_guard hook =
330	331	let open Proof_global in function
331		\| Admitted (id,k,pe,ctx) ->
332		admit (id,k,pe) (hook (Some ctx)) ();
	332	\| Admitted (id,k,pe,(ctx,pl)) ->
	333	admit (id,k,pe) pl (hook (Some ctx)) ();
333	334	Pp.feedback Feedback.AddedAxiom
334	335	\| Proved (opaque,idopt,proof) ->
335	336	let is_opaque, export_seff, exports = match opaque with
336	337	\| Vernacexpr.Transparent -> false, true, []
337	338	\| Vernacexpr.Opaque None -> true, false, []
338	339	\| Vernacexpr.Opaque (Some l) -> true, true, l in
339		let proof = get_proof proof compute_guard
340		(hook (Some proof.Proof_global.universes)) is_opaque in
	340	let proof = get_proof proof compute_guard
	341	(hook (Some (fst proof.Proof_global.universes))) is_opaque in
341	342	begin match idopt with
342	343	\| None -> save_named ~export_seff proof
343	344	\| Some ((_,id),None) -> save_anonymous ~export_seff proof id

349	350	let standard_proof_terminator compute_guard hook =
350	351	universe_proof_terminator compute_guard (fun _ -> hook)
351	352
352		let start_proof id kind sigma ?sign c ?init_tac ?(compute_guard=[]) hook =
	353	let start_proof id ?pl kind sigma ?sign c ?init_tac ?(compute_guard=[]) hook =
353	354	let terminator = standard_proof_terminator compute_guard hook in
354	355	let sign =
355	356	match sign with

357	358	\| None -> initialize_named_context_for_proof ()
358	359	in
359	360	!start_hook c;
360		Pfedit.start_proof id kind sigma sign c ?init_tac terminator
361
362		let start_proof_univs id kind sigma ?sign c ?init_tac ?(compute_guard=[]) hook =
	361	Pfedit.start_proof id ?pl kind sigma sign c ?init_tac terminator
	362
	363	let start_proof_univs id ?pl kind sigma ?sign c ?init_tac ?(compute_guard=[]) hook =
363	364	let terminator = universe_proof_terminator compute_guard hook in
364	365	let sign =
365	366	match sign with

367	368	\| None -> initialize_named_context_for_proof ()
368	369	in
369	370	!start_hook c;
370		Pfedit.start_proof id kind sigma sign c ?init_tac terminator
	371	Pfedit.start_proof id ?pl kind sigma sign c ?init_tac terminator
371	372
372	373	let rec_tac_initializer finite guard thms snl =
373	374	if finite then
374		match List.map (fun (id,(t,_)) -> (id,t)) thms with
	375	match List.map (fun ((id,_),(t,_)) -> (id,t)) thms with
375	376	\| (id,_)::l -> Tactics.mutual_cofix id l 0
376	377	\| _ -> assert false
377	378	else

379	380	let nl = match snl with
380	381	\| None -> List.map succ (List.map List.last guard)
381	382	\| Some nl -> nl
382		in match List.map2 (fun (id,(t,_)) n -> (id,n,t)) thms nl with
	383	in match List.map2 (fun ((id,_),(t,_)) n -> (id,n,t)) thms nl with
383	384	\| (id,n,_)::l -> Tactics.mutual_fix id n l 0
384	385	\| _ -> assert false
385	386

408	409	(if Flags.is_auto_intros () then Some (intro_tac (List.hd thms)) else None), [] in
409	410	match thms with
410	411	\| [] -> anomaly (Pp.str "No proof to start")
411		\| (id,(t,(_,imps)))::other_thms ->
	412	\| ((id,pl),(t,(_,imps)))::other_thms ->
412	413	let hook ctx strength ref =
413	414	let ctx = match ctx with
414	415	\| None -> Evd.empty_evar_universe_context

427	428	List.iter (fun (strength,ref,imps) ->
428	429	maybe_declare_manual_implicits false ref imps;
429	430	call_hook (fun exn -> exn) hook strength ref) thms_data in
430		start_proof_univs id kind ctx t ?init_tac (fun ctx -> mk_hook (hook ctx)) ~compute_guard:guard
	431	start_proof_univs id ?pl kind ctx t ?init_tac (fun ctx -> mk_hook (hook ctx)) ~compute_guard:guard
431	432
432	433	let start_proof_com kind thms hook =
433	434	let env0 = Global.env () in

471	472	if const_entry_type = None then
472	473	error "Admitted requires an explicit statement";
473	474	let typ = Option.get const_entry_type in
474		let ctx = Evd.evar_context_universe_context universes in
	475	let ctx = Evd.evar_context_universe_context (fst universes) in
475	476	Admitted(id, k, (const_entry_secctx, pi2 k, (typ, ctx), None), universes)
476	477	\| None ->
477	478	let id, k, typ = Pfedit.current_proof_statement () in
478	479	(* This will warn if the proof is complete *)
479	480	let pproofs, universes =
480	481	Proof_global.return_proof ~allow_partial:true () in
481		let ctx = Evd.evar_context_universe_context universes in
482	482	let sec_vars =
483	483	match Pfedit.get_used_variables(), pproofs with
484	484	\| Some _ as x, _ -> x

488	488	let ids_def = Environ.global_vars_set env pproof in
489	489	Some (Environ.keep_hyps env (Idset.union ids_typ ids_def))
490	490	\| _ -> None in
491		Admitted(id,k,(sec_vars, pi2 k, (typ, ctx), None),universes)
	491	let names = Pfedit.get_universe_binders () in
	492	let binders, ctx = Evd.universe_context ?names (Evd.from_ctx universes) in
	493	Admitted(id,k,(sec_vars, pi2 k, (typ, ctx), None),
	494	(universes, Some binders))
492	495	in
493	496	Proof_global.get_terminator() pe
494	497	\| Vernacexpr.Proved (is_opaque,idopt) ->

+10

-7

stm/lemmas.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

13	13	open Pfedit
14	14
15	15	type 'a declaration_hook
16
17	16	val mk_hook :
18	17	(Decl_kinds.locality -> Globnames.global_reference -> 'a) -> 'a declaration_hook
19	18

23	22	(** A hook start_proof calls on the type of the definition being started *)
24	23	val set_start_hook : (types -> unit) -> unit
25	24
26		val start_proof : Id.t -> goal_kind -> Evd.evar_map -> ?sign:Environ.named_context_val -> types ->
	25	val start_proof : Id.t -> ?pl:universe_binders -> goal_kind -> Evd.evar_map ->
	26	?sign:Environ.named_context_val -> types ->
27	27	?init_tac:unit Proofview.tactic -> ?compute_guard:lemma_possible_guards ->
28	28	unit declaration_hook -> unit
29	29
30		val start_proof_univs : Id.t -> goal_kind -> Evd.evar_map -> ?sign:Environ.named_context_val -> types ->
	30	val start_proof_univs : Id.t -> ?pl:universe_binders -> goal_kind -> Evd.evar_map ->
	31	?sign:Environ.named_context_val -> types ->
31	32	?init_tac:unit Proofview.tactic -> ?compute_guard:lemma_possible_guards ->
32		(Proof_global.proof_universes option -> unit declaration_hook) -> unit
	33	(Evd.evar_universe_context option -> unit declaration_hook) -> unit
33	34
34	35	val start_proof_com : goal_kind -> Vernacexpr.proof_expr list ->
35	36	unit declaration_hook -> unit
36	37
37	38	val start_proof_with_initialization :
38		goal_kind -> Evd.evar_map -> (bool * lemma_possible_guards * unit Proofview.tactic list option) option ->
39		(Id.t * (types * (Name.t list * Impargs.manual_explicitation list))) list
	39	goal_kind -> Evd.evar_map ->
	40	(bool * lemma_possible_guards * unit Proofview.tactic list option) option ->
	41	((Id.t * universe_binders option) *
	42	(types * (Name.t list * Impargs.manual_explicitation list))) list
40	43	-> int list option -> unit declaration_hook -> unit
41	44
42	45	val standard_proof_terminator :

+1

-1

stm/proofworkertop.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/queryworkertop.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/spawned.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/spawned.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+29

-7

stm/stm.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

51	51
52	52	let unreachable_state, unreachable_state_hook = Hook.make
53	53	~default:(fun _ _ -> ()) ()
	54
	55	let tactic_being_run, tactic_being_run_hook = Hook.make
	56	~default:(fun _ -> ()) ()
54	57
55	58	include Hook
56	59

1470	1473	try
1471	1474	Reach.known_state ~cache:`No id;
1472	1475	let t, uc = Future.purify (fun () ->
	1476	let _,_,_,_,sigma0 = Proof.proof (Proof_global.give_me_the_proof ()) in
	1477	let g = Evd.find sigma0 r_goal in
	1478	if not (
	1479	Evarutil.is_ground_term sigma0 Evd.(evar_concl g) &&
	1480	List.for_all (fun (_,bo,ty) ->
	1481	Evarutil.is_ground_term sigma0 ty &&
	1482	Option.cata (Evarutil.is_ground_term sigma0) true bo)
	1483	Evd.(evar_context g))
	1484	then
	1485	Errors.errorlabstrm "Stm" (strbrk("the par: goal selector supports ground "^
	1486	"goals only"))
	1487	else begin
1473	1488	vernac_interp r_state_fb r_ast;
1474	1489	let _,_,_,_,sigma = Proof.proof (Proof_global.give_me_the_proof ()) in
1475	1490	match Evd.(evar_body (find sigma r_goal)) with

1478	1493	let t = Evarutil.nf_evar sigma t in
1479	1494	if Evarutil.is_ground_term sigma t then
1480	1495	t, Evd.evar_universe_context sigma
1481		else Errors.errorlabstrm "Stm" (str"The solution is not ground"))
1482		() in
1483		RespBuiltSubProof (t,uc)
	1496	else Errors.errorlabstrm "Stm" (str"The solution is not ground")
	1497	end) ()
	1498	in
	1499	RespBuiltSubProof (t,uc)
1484	1500	with e when Errors.noncritical e -> RespError (Errors.print e)
1485	1501
1486	1502	let name_of_task { t_name } = t_name

1786	1802	), cache, true
1787	1803	\| `Cmd { cast = x; cqueue = `TacQueue cancel } -> (fun () ->
1788	1804	reach ~cache:`Shallow view.next;
	1805	Hooks.(call tactic_being_run true);
1789	1806	Partac.vernac_interp
1790		cancel !Flags.async_proofs_n_tacworkers view.next id x
	1807	cancel !Flags.async_proofs_n_tacworkers view.next id x;
	1808	Hooks.(call tactic_being_run false)
1791	1809	), cache, true
1792	1810	\| `Cmd { cast = x; cqueue = `QueryQueue cancel }
1793	1811	when Flags.async_proofs_is_master () -> (fun () ->
1794	1812	reach view.next;
1795	1813	Query.vernac_interp cancel view.next id x
1796	1814	), cache, false
1797		\| `Cmd { cast = x; ceff = eff } -> (fun () ->
1798		reach view.next; vernac_interp id x;
	1815	\| `Cmd { cast = x; ceff = eff; ctac } -> (fun () ->
	1816	reach view.next;
	1817	if ctac then Hooks.(call tactic_being_run true);
	1818	vernac_interp id x;
	1819	if ctac then Hooks.(call tactic_being_run false);
1799	1820	if eff then update_global_env ()), cache, true
1800	1821	\| `Fork ((x,_,_,_), None) -> (fun () ->
1801	1822	reach view.next; vernac_interp id x;

2576	2597	let with_fail_hook = Hooks.with_fail_hook
2577	2598	let unreachable_state_hook = Hooks.unreachable_state_hook
2578	2599	let get_fix_exn () = !State.fix_exn_ref
	2600	let tactic_being_run_hook = Hooks.tactic_being_run_hook
2579	2601	(* vim:set foldmethod=marker: *)

+3

-0

stm/stm.mli less more

106	106	val unreachable_state_hook : (Stateid.t -> Exninfo.iexn -> unit) Hook.t
107	107	(* ready means that master has it at hand *)
108	108	val state_ready_hook : (Stateid.t -> unit) Hook.t
	109	(* called with true before and with false after a tactic explicitly
	110	* in the document is run *)
	111	val tactic_being_run_hook : (bool -> unit) Hook.t
109	112
110	113	(* Messages from the workers to the master *)
111	114	val forward_feedback_hook : (Feedback.feedback -> unit) Hook.t

+1

-1

stm/tQueue.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/tQueue.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/tacworkertop.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/texmacspp.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/texmacspp.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/vcs.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/vcs.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/vernac_classifier.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/vernac_classifier.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

stm/vio_checking.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

42	42	let rec filter_argv b = function
43	43	\| [] -> []
44	44	\| "-schedule-vio-checking" :: rest -> filter_argv true rest
45		\| s :: rest when s.[0] = '-' && b -> filter_argv false (s :: rest)
	45	\| s :: rest when String.length s > 0 && s.[0] = '-' && b -> filter_argv false (s :: rest)
46	46	\| _ :: rest when b -> filter_argv b rest
47	47	\| s :: rest -> s :: filter_argv b rest in
48	48	let pack = function

+1

-1

stm/vio_checking.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/workerPool.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

stm/workerPool.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/auto.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/auto.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/autorewrite.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/autorewrite.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/btermdn.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/btermdn.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/class_tactics.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/class_tactics.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/contradiction.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/contradiction.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+5

-1

tactics/coretactics.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

39	39
40	40	TACTIC EXTEND vm_cast_no_check
41	41	[ "vm_cast_no_check" constr(c) ] -> [ Proofview.V82.tactic (Tactics.vm_cast_no_check c) ]
	42	END
	43
	44	TACTIC EXTEND native_cast_no_check
	45	[ "native_cast_no_check" constr(c) ] -> [ Proofview.V82.tactic (Tactics.native_cast_no_check c) ]
42	46	END
43	47
44	48	TACTIC EXTEND casetype

+1

-1

tactics/dnet.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/dnet.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-3

tactics/eauto.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

165	165	in
166	166	let tac_of_hint =
167	167	fun (st, {pri = b; pat = p; code = t; poly = poly}) ->
	168	let b = match Hints.repr_hint t with
	169	\| Unfold_nth _ -> 1
	170	\| _ -> b
	171	in
168	172	(b,
169	173	let tac = function
170	174	\| Res_pf (term,cl) -> unify_resolve poly st (term,cl)

244	248	let d = s'.depth - s.depth in
245	249	let d' = Int.compare s.priority s'.priority in
246	250	let nbgoals s = List.length (sig_it s.tacres) in
247		if not (Int.equal d' 0) then d'
248		else if not (Int.equal d 0) then d
	251	if not (Int.equal d 0) then d
	252	else if not (Int.equal d' 0) then d'
249	253	else Int.compare (nbgoals s) (nbgoals s')
250	254
251	255	let branching s =

+1

-1

tactics/eauto.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/elim.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/elim.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/elimschemes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/elimschemes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/eqdecide.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/eqdecide.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-6

tactics/eqschemes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

175	175	name_context env ((Name varH,None,applied_ind)::realsign) in
176	176	let ci = make_case_info (Global.env()) ind RegularStyle in
177	177	let c =
178		(my_it_mkLambda_or_LetIn mib.mind_params_ctxt
	178	(my_it_mkLambda_or_LetIn paramsctxt
179	179	(my_it_mkLambda_or_LetIn_name realsign_ind
180	180	(mkCase (ci,
181	181	my_it_mkLambda_or_LetIn_name

394	394	applied_sym_C 3,
395	395	[\|mkVar varHC\|]) in
396	396	let c =
397		(my_it_mkLambda_or_LetIn mib.mind_params_ctxt
	397	(my_it_mkLambda_or_LetIn paramsctxt
398	398	(my_it_mkLambda_or_LetIn_name realsign
399	399	(mkNamedLambda varP
400	400	(my_it_mkProd_or_LetIn (if dep then realsign_ind_P else realsign_P) s)

484	484	mkApp (mkVar varP,Array.append (rel_vect 3 nrealargs)
485	485	(if dep then [\|cstr (3*nrealargs+4) 3\|] else [\|\|])) in
486	486	let c =
487		(my_it_mkLambda_or_LetIn mib.mind_params_ctxt
	487	(my_it_mkLambda_or_LetIn paramsctxt
488	488	(my_it_mkLambda_or_LetIn_name realsign
489	489	(mkNamedLambda varH applied_ind
490	490	(mkCase (ci,

781	781
782	782	let congr_scheme_kind = declare_individual_scheme_object "_congr"
783	783	(fun _ ind ->
784		(* May fail if equality is not defined *)
785		build_congr (Global.env()) (get_coq_eq Univ.ContextSet.empty) ind, Safe_typing.empty_private_constants)
	784	(* May fail if equality is not defined *)
	785	build_congr (Global.env()) (get_coq_eq Univ.ContextSet.empty) ind,
	786	Safe_typing.empty_private_constants)

+1

-1

tactics/eqschemes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+41

-3

tactics/equality.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

204	204	resolve_evars = false
205	205	}
206	206
	207	let rewrite_keyed_core_unif_flags = {
	208	modulo_conv_on_closed_terms = Some full_transparent_state;
	209	(* We have this flag for historical reasons, it has e.g. the consequence *)
	210	(* to rewrite "?x+2" in "y+(1+1)=0" or to rewrite "?x+?x" in "2+(1+1)=0" *)
	211
	212	use_metas_eagerly_in_conv_on_closed_terms = true;
	213	use_evars_eagerly_in_conv_on_closed_terms = false;
	214	(* Combined with modulo_conv_on_closed_terms, this flag allows since 8.2 *)
	215	(* to rewrite e.g. "?x+(2+?x)" in "1+(1+2)=0" *)
	216
	217	modulo_delta = full_transparent_state;
	218	modulo_delta_types = full_transparent_state;
	219	check_applied_meta_types = true;
	220	use_pattern_unification = true;
	221	(* To rewrite "?n x y" in "y+x=0" when ?n is *)
	222	(* a preexisting evar of the goal*)
	223
	224	use_meta_bound_pattern_unification = true;
	225
	226	frozen_evars = Evar.Set.empty;
	227	(* This is set dynamically *)
	228
	229	restrict_conv_on_strict_subterms = false;
	230	modulo_betaiota = true;
	231	(* Different from conv_closed *)
	232	modulo_eta = true;
	233	}
	234
	235	let rewrite_keyed_unif_flags = {
	236	core_unify_flags = rewrite_keyed_core_unif_flags;
	237	merge_unify_flags = rewrite_keyed_core_unif_flags;
	238	subterm_unify_flags = rewrite_keyed_core_unif_flags;
	239	allow_K_in_toplevel_higher_order_unification = false;
	240	resolve_evars = false
	241	}
	242
207	243	let rewrite_elim with_evars frzevars cls c e =
208	244	Proofview.Goal.enter begin fun gl ->
209		let flags = make_flags frzevars (Proofview.Goal.sigma gl) rewrite_conv_closed_unif_flags c in
	245	let flags = if Unification.is_keyed_unification ()
	246	then rewrite_keyed_unif_flags else rewrite_conv_closed_unif_flags in
	247	let flags = make_flags frzevars (Proofview.Goal.sigma gl) flags c in
210	248	general_elim_clause with_evars flags cls c e
211	249	end
212	250

913	951	(match kind_of_term (last_arg f_clause.templval.Evd.rebus) with
914	952	\| Meta mv -> mv
915	953	\| _ -> errorlabstrm "" (str "Ill-formed clause applicator.")) in
916		clenv_fchain argmv f_clause clause
	954	clenv_fchain ~with_univs:false argmv f_clause clause
917	955
918	956	let discr_positions env sigma (lbeq,eqn,(t,t1,t2)) eq_clause cpath dirn sort =
919	957	let e = next_ident_away eq_baseid (ids_of_context env) in

+1

-1

tactics/equality.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/evar_tactics.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/evar_tactics.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/extraargs.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/extraargs.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+24

-5

tactics/extratactics.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

20	20	open Evd
21	21	open Equality
22	22	open Misctypes
	23	open Proofview.Notations
23	24
24	25	DECLARE PLUGIN "extratactics"
25	26

263	264	let add_rewrite_hint bases ort t lcsr =
264	265	let env = Global.env() in
265	266	let sigma = Evd.from_env env in
266		let poly = Flags.is_universe_polymorphism () in
	267	let poly = Flags.use_polymorphic_flag () in
267	268	let f ce =
268	269	let c, ctx = Constrintern.interp_constr env sigma ce in
269	270	let ctx =

343	344	(**********************************************************************)
344	345	(* Refine *)
345	346
346		let refine_tac {Glob_term.closure=closure;term=term} =
	347	let refine_tac simple {Glob_term.closure=closure;term=term} =
347	348	Proofview.Goal.nf_enter begin fun gl ->
348	349	let concl = Proofview.Goal.concl gl in
349	350	let env = Proofview.Goal.env gl in

355	356	Pretyping.ltac_idents = closure.Glob_term.idents;
356	357	} in
357	358	let update evd = Pretyping.understand_ltac flags env evd lvar tycon term in
358		Tactics.New.refine ~unsafe:false update
	359	let refine = Proofview.Refine.refine ~unsafe:false update in
	360	if simple then refine
	361	else refine <*>
	362	Tactics.New.reduce_after_refine <*>
	363	Proofview.shelve_unifiable
359	364	end
360	365
361	366	TACTIC EXTEND refine
362		[ "refine" uconstr(c) ] -> [ refine_tac c ]
	367	\| [ "refine" uconstr(c) ] -> [ refine_tac false c ]
	368	END
	369
	370	TACTIC EXTEND simple_refine
	371	\| [ "simple" "refine" uconstr(c) ] -> [ refine_tac true c ]
363	372	END
364	373
365	374	(**********************************************************************)

863	872	[ Proofview.shelve_unifiable ]
864	873	END
865	874
	875	(* Unshelves the goal shelved by the tactic. *)
	876	TACTIC EXTEND unshelve
	877	\| [ "unshelve" tactic1(t) ] ->
	878	[
	879	Proofview.with_shelf (Tacinterp.eval_tactic t) >>= fun (gls, ()) ->
	880	Proofview.Unsafe.tclGETGOALS >>= fun ogls ->
	881	Proofview.Unsafe.tclSETGOALS (gls @ ogls)
	882	]
	883	END
	884
866	885	(* Command to add every unshelved variables to the focus *)
867	886	VERNAC COMMAND EXTEND Unshelve
868	887	[ "Unshelve" ]

+1

-1

tactics/extratactics.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

tactics/ftactic.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

15	15
16	16	(** Type of tactics potentially goal-dependent. If it contains a [Depends],
17	17	then the length of the inner list is guaranteed to be the number of
18		currently focussed goals. Otherwise it means the tactic does not depends
	18	currently focussed goals. Otherwise it means the tactic does not depend
19	19	on the current set of focussed goals. *)
20	20	type 'a t = 'a focus Proofview.tactic
21	21

+1

-1

tactics/ftactic.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/g_class.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/g_eqdecide.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/g_rewrite.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/geninterp.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/geninterp.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-4

tactics/hints.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

676	676	match kind_of_term cty with
677	677	\| Prod _ -> failwith "make_exact_entry"
678	678	\| _ ->
679		let pat = pi3 (Patternops.pattern_of_constr env sigma cty) in
	679	let pat = Patternops.pattern_of_constr env sigma cty in
680	680	let hd =
681	681	try head_pattern_bound pat
682	682	with BoundPattern -> failwith "make_exact_entry"

695	695	let sigma' = Evd.merge_context_set univ_flexible sigma ctx in
696	696	let ce = mk_clenv_from_env env sigma' None (c,cty) in
697	697	let c' = clenv_type (* ~reduce:false *) ce in
698		let pat = pi3 (Patternops.pattern_of_constr env ce.evd c') in
	698	let pat = Patternops.pattern_of_constr env ce.evd c' in
699	699	let hd =
700	700	try head_pattern_bound pat
701	701	with BoundPattern -> failwith "make_apply_entry" in

793	793	let ce = mk_clenv_from_env env sigma None (c,t) in
794	794	(Some hd, { pri=1;
795	795	poly = poly;
796		pat = Some (pi3 (Patternops.pattern_of_constr env ce.evd (clenv_type ce)));
	796	pat = Some (Patternops.pattern_of_constr env ce.evd (clenv_type ce));
797	797	name = name;
798	798	code= with_uid (Res_pf_THEN_trivial_fail(c,t,ctx)) })
799	799

+1

-1

tactics/hints.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/hipattern.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/hipattern.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/inv.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/inv.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/leminv.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/leminv.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+26

-18

tactics/rewrite.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

402	402
403	403
404	404	let inverse env (evd,cstrs) car rel =
405		let evd, (sort,_) = Evarutil.new_type_evar env evd Evd.univ_flexible in
	405	let evd, sort = Evarutil.new_Type ~rigid:Evd.univ_flexible env evd in
406	406	app_poly_check env (evd,cstrs) coq_inverse [\| car ; car; sort; rel \|]
407	407
408	408	end

1504	1504	let after, before = List.split_when (fun (n, b, t) -> Id.equal n id) ctx in
1505	1505	let nc = match before with
1506	1506	\| [] -> assert false
1507		\| (id, b, _) :: rem -> insert_dependent env (id, b, newt) [] after @ rem
	1507	\| (id, b, _) :: rem -> insert_dependent env (id, None, newt) [] after @ rem
1508	1508	in
1509	1509	let env' = Environ.reset_with_named_context (val_of_named_context nc) env in
1510	1510	Proofview.Refine.refine ~unsafe:false begin fun sigma ->

1520	1520	let newfail n s =
1521	1521	Proofview.tclZERO (Refiner.FailError (n, lazy s))
1522	1522
1523		let cl_rewrite_clause_newtac ?abs ?origsigma strat clause =
	1523	let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
1524	1524	let open Proofview.Notations in
1525	1525	let treat sigma res =
1526	1526	match res with
1527	1527	\| None -> newfail 0 (str "Nothing to rewrite")
1528		\| Some None -> Proofview.tclUNIT ()
	1528	\| Some None -> if progress then newfail 0 (str"Failed to progress")
	1529	else Proofview.tclUNIT ()
1529	1530	\| Some (Some res) ->
1530	1531	let (undef, prf, newt) = res in
1531	1532	let fold ev _ accu = if Evd.mem sigma ev then accu else ev :: accu in

1592	1593	try init_setoid (); tclIDTAC
1593	1594	with e when Errors.noncritical e -> tclFAIL 0 (str"Setoid library not loaded")
1594	1595
1595		(** Setoid rewriting when called with "rewrite_strat" *)
1596		let cl_rewrite_clause_strat strat clause =
	1596	let cl_rewrite_clause_strat progress strat clause =
1597	1597	tclTHEN (tactic_init_setoid ())
1598		(fun gl ->
1599		try Proofview.V82.of_tactic (cl_rewrite_clause_newtac strat clause) gl
1600		with RewriteFailure e ->
1601		errorlabstrm "" (str"setoid rewrite failed: " ++ e)
1602		\| Refiner.FailError (n, pp) ->
1603		tclFAIL n (str"setoid rewrite failed: " ++ Lazy.force pp) gl)
	1598	((if progress then tclWEAK_PROGRESS else fun x -> x)
	1599	(fun gl ->
	1600	try Proofview.V82.of_tactic (cl_rewrite_clause_newtac ~progress strat clause) gl
	1601	with RewriteFailure e ->
	1602	errorlabstrm "" (str"setoid rewrite failed: " ++ e)
	1603	\| Refiner.FailError (n, pp) ->
	1604	tclFAIL n (str"setoid rewrite failed: " ++ Lazy.force pp) gl))
1604	1605
1605	1606	(** Setoid rewriting when called with "setoid_rewrite" *)
1606	1607	let cl_rewrite_clause l left2right occs clause gl =
1607	1608	let strat = rewrite_with left2right (general_rewrite_unif_flags ()) l occs in
1608		cl_rewrite_clause_strat strat clause gl
1609
	1609	cl_rewrite_clause_strat true strat clause gl
	1610
	1611	(** Setoid rewriting when called with "rewrite_strat" *)
	1612	let cl_rewrite_clause_strat strat clause =
	1613	cl_rewrite_clause_strat false strat clause
	1614
1610	1615	let apply_glob_constr c l2r occs = (); fun ({ state = () ; env = env } as input) ->
1611	1616	let c sigma =
1612	1617	let (sigma, c) = Pretyping.understand_tcc env sigma c in

2012	2017	tclWEAK_PROGRESS
2013	2018	(tclTHEN
2014	2019	(Refiner.tclEVARS evd)
2015		(Proofview.V82.of_tactic (cl_rewrite_clause_newtac ~abs:(Some abs) ~origsigma strat cl))) gl
	2020	(Proofview.V82.of_tactic
	2021	(cl_rewrite_clause_newtac ~progress:true ~abs:(Some abs) ~origsigma strat cl))) gl
2016	2022	with RewriteFailure e ->
2017	2023	tclFAIL 0 (str"setoid rewrite failed: " ++ e) gl
2018	2024

2076	2082	let setoid_reflexivity =
2077	2083	setoid_proof "reflexive"
2078	2084	(fun env evm car rel ->
2079		tac_open (poly_proof PropGlobal.get_reflexive_proof TypeGlobal.get_reflexive_proof
2080		env evm car rel) (fun c -> Proofview.V82.of_tactic (apply c)))
	2085	tac_open (poly_proof PropGlobal.get_reflexive_proof
	2086	TypeGlobal.get_reflexive_proof
	2087	env evm car rel)
	2088	(fun c -> tclCOMPLETE (Proofview.V82.of_tactic (apply c))))
2081	2089	(reflexivity_red true)
2082	2090
2083	2091	let setoid_symmetry =

+1

-1

tactics/rewrite.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/taccoerce.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/taccoerce.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/tacenv.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/tacenv.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-3

tactics/tacintern.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

399	399	\| CbvNative o -> CbvNative (Option.map (intern_typed_pattern_or_ref_with_occurrences ist) o)
400	400	\| (Red _ \| Hnf \| ExtraRedExpr _ as r ) -> r
401	401
402		let intern_in_hyp_as ist lf (clear,id,ipat) =
403		(clear,intern_hyp ist id, Option.map (intern_intro_pattern lf ist) ipat)
	402	let intern_in_hyp_as ist lf (id,ipat) =
	403	(intern_hyp ist id, Option.map (intern_intro_pattern lf ist) ipat)
404	404
405	405	let intern_hyp_list ist = List.map (intern_hyp ist)
406	406

+1

-1

tactics/tacintern.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+12

-12

tactics/tacinterp.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

687	687	try Inl (coerce_to_evaluable_ref env x)
688	688	with CannotCoerceTo _ ->
689	689	let c = coerce_to_closed_constr env x in
690		Inr (pi3 (pattern_of_constr env sigma c)) in
	690	Inr (pattern_of_constr env sigma c) in
691	691	(try try_interp_ltac_var coerce_eval_ref_or_constr ist (Some (env,sigma)) (loc,id)
692	692	with Not_found ->
693	693	error_global_not_found_loc loc (qualid_of_ident id))
694	694	\| Inl (ArgArg _ as b) -> Inl (interp_evaluable ist env sigma b)
695		\| Inr c -> Inr (pi3 (interp_typed_pattern ist env sigma c)) in
	695	\| Inr c -> Inr (interp_typed_pattern ist env sigma c) in
696	696	interp_occurrences ist occs, p
697	697
698	698	let interp_constr_with_occurrences_and_name_as_list =

865	865	let sigma,l = interp_intro_pattern_list_as_list ist env sigma l in
866	866	sigma, IntroInjection l
867	867	\| IntroApplyOn (c,ipat) ->
868		let c = fun env sigma -> interp_constr ist env sigma c in
	868	let c = fun env sigma -> interp_open_constr ist env sigma c in
869	869	let sigma,ipat = interp_intro_pattern ist env sigma ipat in
870	870	sigma, IntroApplyOn (c,ipat)
871	871	\| IntroWildcard \| IntroRewrite _ as x -> sigma, x

901	901	let sigma, ipat = interp_intro_pattern ist env sigma ipat in
902	902	sigma, Some ipat
903	903
904		let interp_in_hyp_as ist env sigma (clear,id,ipat) =
	904	let interp_in_hyp_as ist env sigma (id,ipat) =
905	905	let sigma, ipat = interp_intro_pattern_option ist env sigma ipat in
906		sigma,(clear,interp_hyp ist env sigma id,ipat)
	906	sigma,(interp_hyp ist env sigma id,ipat)
907	907
908	908	let interp_quantified_hypothesis ist = function
909	909	\| AnonHyp n -> AnonHyp n

988	988	try sigma, (constr_of_id env id', NoBindings)
989	989	with Not_found ->
990	990	user_err_loc (loc, "interp_induction_arg",
991		pr_id id ++ strbrk " binds to " ++ pr_id id' ++ strbrk " which is neither a declared or a quantified hypothesis."))
	991	pr_id id ++ strbrk " binds to " ++ pr_id id' ++ strbrk " which is neither a declared nor a quantified hypothesis."))
992	992	in
993	993	try
994	994	(** FIXME: should be moved to taccoerce *)

1042	1042	let eval_pattern lfun ist env sigma ((glob,_),pat as c) =
1043	1043	let bound_names = bound_glob_vars glob in
1044	1044	if use_types then
1045		(bound_names,pi3 (interp_typed_pattern ist env sigma c))
	1045	(bound_names,interp_typed_pattern ist env sigma c)
1046	1046	else
1047	1047	(bound_names,instantiate_pattern env sigma lfun pat)
1048	1048

1834	1834	let sigma,tac = match cl with
1835	1835	\| None -> sigma, Tactics.apply_with_delayed_bindings_gen a ev l
1836	1836	\| Some cl ->
1837		let sigma,(clear,id,cl) = interp_in_hyp_as ist env sigma cl in
1838		sigma, Tactics.apply_delayed_in a ev clear id l cl in
	1837	let sigma,(id,cl) = interp_in_hyp_as ist env sigma cl in
	1838	sigma, Tactics.apply_delayed_in a ev id l cl in
1839	1839	Tacticals.New.tclWITHHOLES ev tac sigma
1840	1840	end
1841	1841	end

2153	2153	let env = Proofview.Goal.env gl in
2154	2154	let sigma = Proofview.Goal.sigma gl in
2155	2155	Proofview.V82.tactic begin fun gl ->
2156		let (sigma,sign,op) = interp_typed_pattern ist env sigma op in
	2156	let op = interp_typed_pattern ist env sigma op in
2157	2157	let to_catch = function Not_found -> true \| e -> Errors.is_anomaly e in
2158	2158	let c_interp patvars sigma =
2159	2159	let lfun' = Id.Map.fold (fun id c lfun ->

2166	2166	errorlabstrm "" (strbrk "Failed to get enough information from the left-hand side to type the right-hand side.")
2167	2167	in
2168	2168	(Tactics.change (Some op) c_interp (interp_clause ist env sigma cl))
2169		{ gl with sigma = sigma }
	2169	gl
2170	2170	end
2171	2171	end
2172	2172	end

+1

-1

tactics/tacinterp.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/tacsubst.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/tacsubst.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/tactic_matching.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/tactic_option.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/tactic_option.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

tactics/tacticals.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

619	619	errorlabstrm "Tacticals.general_elim_then_using"
620	620	(str "The elimination combinator " ++ str name_elim ++ str " is unknown.")
621	621	in
622		let elimclause' = clenv_fchain indmv elimclause indclause in
	622	let elimclause' = clenv_fchain ~with_univs:false indmv elimclause indclause in
623	623	let branchsigns = compute_construtor_signatures isrec ind in
624	624	let brnames = compute_induction_names (Array.length branchsigns) allnames in
625	625	let flags = Unification.elim_flags () in

+1

-1

tactics/tacticals.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+64

-47

tactics/tactics.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

163	163	let inst = List.map (fun (id, _, _) -> mkVar id) (named_context env) in
164	164	let ninst = mkRel 1 :: inst in
165	165	let nb = subst1 (mkVar id) b in
166		let sigma, ev = new_evar_instance nctx sigma nb ~store ninst in
	166	let sigma, ev = new_evar_instance nctx sigma nb ~principal:true ~store ninst in
167	167	sigma, mkNamedLambda_or_LetIn (id, c, t) ev
168	168	end
169	169

276	276	error "keep/clear modifiers apply only to hypothesis names." in
277	277	let clear = match clear_flag with
278	278	\| None -> dft && isVar c
279		\| Some clear -> check_isvar c; clear in
	279	\| Some true -> check_isvar c; true
	280	\| Some false -> false in
280	281	if clear then Proofview.V82.tactic (thin [destVar c])
281	282	else Tacticals.New.tclIDTAC
282	283

632	633	let t1 = Retyping.get_type_of env sigma newc in
633	634	if deep then begin
634	635	let t2 = Retyping.get_type_of env sigma origc in
635		let sigma, t2 = Evarsolve.refresh_universes ~onlyalg:true (Some false) env sigma t2 in
636		if not (snd (infer_conv ~pb:Reduction.CUMUL env sigma t1 t2)) then
	636	let sigma, t2 = Evarsolve.refresh_universes
	637	~onlyalg:true (Some false) env sigma t2 in
	638	let sigma, b = infer_conv ~pb:Reduction.CUMUL env sigma t1 t2 in
	639	if not b then
637	640	if
638	641	isSort (whd_betadeltaiota env sigma t1) &&
639	642	isSort (whd_betadeltaiota env sigma t2)
640		then
641		mayneedglobalcheck := true
	643	then (mayneedglobalcheck := true; sigma)
642	644	else
643	645	errorlabstrm "convert-check-hyp" (str "Types are incompatible.")
	646	else sigma
644	647	end
645	648	else
646	649	if not (isSort (whd_betadeltaiota env sigma t1)) then
647	650	errorlabstrm "convert-check-hyp" (str "Not a type.")
	651	else sigma
648	652
649	653	(* Now we introduce different instances of the previous tacticals *)
650	654	let change_and_check cv_pb mayneedglobalcheck deep t env sigma c =
651	655	let sigma, t' = t sigma in
652		check_types env sigma mayneedglobalcheck deep t' c;
	656	let sigma = check_types env sigma mayneedglobalcheck deep t' c in
653	657	let sigma, b = infer_conv ~pb:cv_pb env sigma t' c in
654	658	if not b then errorlabstrm "convert-check-hyp" (str "Not convertible.");
655	659	sigma, t'

1318	1322	*)
1319	1323
1320	1324	let clenv_fchain_in id ?(flags=elim_flags ()) mv elimclause hypclause =
1321		try clenv_fchain ~flags mv elimclause hypclause
	1325	(** The evarmap of elimclause is assumed to be an extension of hypclause, so
	1326	we do not need to merge the universes coming from hypclause. *)
	1327	try clenv_fchain ~with_univs:false ~flags mv elimclause hypclause
1322	1328	with PretypeError (env,evd,NoOccurrenceFound (op,_)) ->
1323	1329	(* Set the hypothesis name in the message *)
1324	1330	raise (PretypeError (env,evd,NoOccurrenceFound (op,Some id)))

1602	1608	let ordered_metas = List.rev (clenv_independent clause) in
1603	1609	if List.is_empty ordered_metas then error "Statement without assumptions.";
1604	1610	let f mv =
1605		try Some (find_matching_clause (clenv_fchain mv ~flags clause) innerclause)
	1611	try Some (find_matching_clause (clenv_fchain ~with_univs:false mv ~flags clause) innerclause)
1606	1612	with Failure _ -> None
1607	1613	in
1608	1614	try List.find_map f ordered_metas

1726	1732	let vm_cast_no_check c gl =
1727	1733	let concl = pf_concl gl in
1728	1734	refine_no_check (Term.mkCast(c,Term.VMcast,concl)) gl
	1735
	1736	let native_cast_no_check c gl =
	1737	let concl = pf_concl gl in
	1738	refine_no_check (Term.mkCast(c,Term.NATIVEcast,concl)) gl
1729	1739
1730	1740
1731	1741	let exact_proof c gl =

1833	1843	in
1834	1844	check_hyps <> check_concl <>
1835	1845	Proofview.Refine.refine ~unsafe:true begin fun sigma ->
1836		Evarutil.new_evar env sigma concl
	1846	Evarutil.new_evar env sigma ~principal:true concl
1837	1847	end
1838	1848	end
1839	1849

2213	2223	Proofview.tclUNIT () (* apply_in_once do a replacement *)
2214	2224	else
2215	2225	Proofview.V82.tactic (clear [id]) in
2216		Proofview.Goal.enter begin fun gl ->
2217		let sigma = Proofview.Goal.sigma gl in
2218		let env = Proofview.Goal.env gl in
2219		let sigma,c = f env sigma in
2220		Tacticals.New.tclWITHHOLES false
2221		(Tacticals.New.tclTHENFIRST
2222		(* Skip the side conditions of the apply *)
2223		(apply_in_once false true true true naming id
2224		(None,(sigma,(c,NoBindings)))
2225		(fun id -> Tacticals.New.tclTHEN doclear (tac_ipat id)))
2226		(tac thin None []))
2227		sigma
2228		end
	2226	let f env sigma = let (sigma,c) = f env sigma in (sigma,(c,NoBindings)) in
	2227	apply_in_delayed_once false true true true naming id (None,(loc,f))
	2228	(fun id -> Tacticals.New.tclTHENLIST [doclear; tac_ipat id; tac thin None []])
2229	2229
2230	2230	and prepare_intros_loc loc dft destopt = function
2231	2231	\| IntroNaming ipat ->

2284	2284	(* apply in as *)
2285	2285
2286	2286	let general_apply_in sidecond_first with_delta with_destruct with_evars
2287		with_clear id lemmas ipat =
	2287	id lemmas ipat =
2288	2288	let tac (naming,lemma) tac id =
2289	2289	apply_in_delayed_once sidecond_first with_delta with_destruct with_evars
2290	2290	naming id lemma tac in

2309	2309	Tacticals.New.tclTHENFIRST (tclMAPFIRST tac lemmas_target) (ipat_tac id)
2310	2310	*)
2311	2311
2312		let apply_in simple with_evars clear_flag id lemmas ipat =
	2312	let apply_in simple with_evars id lemmas ipat =
2313	2313	let lemmas = List.map (fun (k,(loc,l)) -> k, (loc, fun _ sigma -> sigma, l)) lemmas in
2314		general_apply_in false simple simple with_evars clear_flag id lemmas ipat
2315
2316		let apply_delayed_in simple with_evars clear_flag id lemmas ipat =
2317		general_apply_in false simple simple with_evars clear_flag id lemmas ipat
	2314	general_apply_in false simple simple with_evars id lemmas ipat
	2315
	2316	let apply_delayed_in simple with_evars id lemmas ipat =
	2317	general_apply_in false simple simple with_evars id lemmas ipat
2318	2318
2319	2319	(*****************************)
2320	2320	(* Tactics abstracting terms *)

2344	2344	Proofview.Goal.enter begin fun gl ->
2345	2345	let env = Proofview.Goal.env gl in
2346	2346	let sigma = Proofview.Goal.sigma gl in
2347		let t = match ty with Some t -> t \| _ -> typ_of env sigma c in
	2347	let (sigma, t) = match ty with
	2348	\| Some t -> (sigma, t)
	2349	\| None ->
	2350	let t = typ_of env sigma c in
	2351	Evarsolve.refresh_universes ~onlyalg:true (Some false) env sigma t
	2352	in
2348	2353	let eq_tac gl = match with_eq with
2349	2354	\| Some (lr,(loc,ido)) ->
2350	2355	let heq = match ido with

2598	2603	in
2599	2604	Proofview.Unsafe.tclEVARS sigma <*>
2600	2605	Proofview.Refine.refine begin fun sigma ->
2601		let (sigma, ev) = Evarutil.new_evar env sigma newcl in
	2606	let (sigma, ev) = Evarutil.new_evar env sigma ~principal:true newcl in
2602	2607	(sigma, (applist (ev, args)))
2603	2608	end
2604	2609	end

2824	2829	s'embêter à regarder si un letin_tac ne fait pas des
2825	2830	substitutions aussi sur l'argument voisin *)
2826	2831
	2832	let expand_projections env sigma c =
	2833	let rec aux env c =
	2834	match kind_of_term c with
	2835	\| Proj (p, c) -> Retyping.expand_projection env sigma p (aux env c) []
	2836	\| _ -> map_constr_with_full_binders push_rel aux env c
	2837	in aux env c
	2838
	2839
2827	2840	(* Marche pas... faut prendre en compte l'occurrence précise... *)
2828	2841
2829	2842	let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =

2832	2845	let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 (Proofview.Goal.assume gl) in
2833	2846	let reduce_to_quantified_ref = Tacmach.New.pf_apply reduce_to_quantified_ref gl in
2834	2847	let typ0 = reduce_to_quantified_ref indref tmptyp0 in
2835		let prods, indtyp = decompose_prod typ0 in
	2848	let prods, indtyp = decompose_prod_assum typ0 in
2836	2849	let hd,argl = decompose_app indtyp in
	2850	let env' = push_rel_context prods env in
	2851	let sigma = Proofview.Goal.sigma gl in
2837	2852	let params = List.firstn nparams argl in
	2853	let params' = List.map (expand_projections env' sigma) params in
2838	2854	(* le gl est important pour ne pas préévaluer *)
2839		let rec atomize_one i args avoid =
	2855	let rec atomize_one i args args' avoid =
2840	2856	if Int.equal i nparams then
2841	2857	let t = applist (hd, params@args) in
2842	2858	Tacticals.New.tclTHEN

2845	2861	else
2846	2862	let c = List.nth argl (i-1) in
2847	2863	match kind_of_term c with
2848		\| Var id when not (List.exists (occur_var env id) args) &&
2849		not (List.exists (occur_var env id) params) ->
	2864	\| Var id when not (List.exists (occur_var env id) args') &&
	2865	not (List.exists (occur_var env id) params') ->
2850	2866	(* Based on the knowledge given by the user, all
2851	2867	constraints on the variable are generalizable in the
2852	2868	current environment so that it is clearable after destruction *)
2853		atomize_one (i-1) (c::args) (id::avoid)
	2869	atomize_one (i-1) (c::args) (c::args') (id::avoid)
2854	2870	\| _ ->
2855		if List.exists (dependent c) params \|\|
2856		List.exists (dependent c) args
	2871	let c' = expand_projections env' sigma c in
	2872	if List.exists (dependent c) params' \|\|
	2873	List.exists (dependent c) args'
2857	2874	then
2858	2875	(* This is a case where the argument is constrained in a
2859	2876	way which would require some kind of inversion; we
2860	2877	follow the (old) discipline of not generalizing over
2861	2878	this term, since we don't try to invert the
2862	2879	constraint anyway. *)
2863		atomize_one (i-1) (c::args) avoid
	2880	atomize_one (i-1) (c::args) (c'::args') avoid
2864	2881	else
2865	2882	(* We reason blindly on the term and do as if it were
2866	2883	generalizable, ignoring the constraints coming from

2873	2890	let x = fresh_id_in_env avoid id env in
2874	2891	Tacticals.New.tclTHEN
2875	2892	(letin_tac None (Name x) c None allHypsAndConcl)
2876		(atomize_one (i-1) (mkVar x::args) (x::avoid))
	2893	(atomize_one (i-1) (mkVar x::args) (mkVar x::args') (x::avoid))
2877	2894	in
2878		atomize_one (List.length argl) [] []
	2895	atomize_one (List.length argl) [] [] []
2879	2896	end
2880	2897
2881	2898	(* [cook_sign] builds the lists [beforetoclear] (preceding the

3195	3212	mkProd (Anonymous, eq, lift 1 concl), [\| refl \|]
3196	3213	else concl, [\|\|]
3197	3214	in
3198		(* Abstract by equalitites *)
	3215	(* Abstract by equalities *)
3199	3216	let eqs = lift_togethern 1 eqs in (* lift together and past genarg *)
3200	3217	let abseqs = it_mkProd_or_LetIn (lift eqslen abshypeq) (List.map (fun x -> (Anonymous, None, x)) eqs) in
3201	3218	(* Abstract by the "generalized" hypothesis. *)

3206	3223	let genc = mkCast (mkMeta meta, DEFAULTcast, genctyp) in
3207	3224	(* Apply the old arguments giving the proper instantiation of the hyp *)
3208	3225	let instc = mkApp (genc, Array.of_list args) in
3209		(* Then apply to the original instanciated hyp. *)
	3226	(* Then apply to the original instantiated hyp. *)
3210	3227	let instc = Option.cata (fun _ -> instc) (mkApp (instc, [\| mkVar id \|])) body in
3211	3228	(* Apply the reflexivity proofs on the indices. *)
3212	3229	let appeqs = mkApp (instc, Array.of_list refls) in
3213		(* Finaly, apply the reflexivity proof for the original hyp, to get a term of type gl again. *)
	3230	(* Finally, apply the reflexivity proof for the original hyp, to get a term of type gl again. *)
3214	3231	mkApp (appeqs, abshypt)
3215	3232
3216	3233	let hyps_of_vars env sign nogen hyps =

3736	3753	trying to unify (which would lead to trying to apply it to
3737	3754	evars if y is a product). *)
3738	3755	let indclause = mk_clenv_from_n gl (Some 0) (x,y) in
3739		let elimclause' = clenv_fchain i acc indclause in
	3756	let elimclause' = clenv_fchain ~with_univs:false i acc indclause in
3740	3757	elimclause')
3741	3758	(List.rev clauses)
3742	3759	elimclause

4533	4550	let case c = general_case_analysis false None (c,NoBindings)
4534	4551
4535	4552	let apply_in id c =
4536		apply_in false false None id [None,(Loc.ghost, (c, NoBindings))] None
	4553	apply_in false false id [None,(Loc.ghost, (c, NoBindings))] None
4537	4554
4538	4555	end
4539	4556

+4

-3

tactics/tactics.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

117	117	val assumption : unit Proofview.tactic
118	118	val exact_no_check : constr -> tactic
119	119	val vm_cast_no_check : constr -> tactic
	120	val native_cast_no_check : constr -> tactic
120	121	val exact_check : constr -> unit Proofview.tactic
121	122	val exact_proof : Constrexpr.constr_expr -> tactic
122	123

195	196	val cut_and_apply : constr -> unit Proofview.tactic
196	197
197	198	val apply_in :
198		advanced_flag -> evars_flag -> clear_flag -> Id.t ->
	199	advanced_flag -> evars_flag -> Id.t ->
199	200	(clear_flag * constr with_bindings located) list ->
200	201	intro_pattern option -> unit Proofview.tactic
201	202
202	203	val apply_delayed_in :
203		advanced_flag -> evars_flag -> clear_flag -> Id.t ->
	204	advanced_flag -> evars_flag -> Id.t ->
204	205	(clear_flag * delayed_open_constr_with_bindings located) list ->
205	206	intro_pattern option -> unit Proofview.tactic
206	207

+1

-1

tactics/tauto.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/term_dnet.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tactics/term_dnet.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-1

test-suite/Makefile less more

153	153	$(SHOW) SUMMARY
154	154	$(HIDE)$(MAKE) --quiet summary > "$@"
155	155
	156	report: summary.log
	157	$(HIDE)if grep -F 'Error!' summary.log ; then false; fi
	158
156	159	#######################################################################
157	160	# Regression (and progression) tests
158	161	#######################################################################

348	351	fi; \
349	352	} > "$@"
350	353
351		# Additionnal dependencies for module tests
	354	# Additional dependencies for module tests
352	355	$(addsuffix .log,$(wildcard modules/*.v)): %.v.log: modules/Nat.vo modules/plik.vo
353	356	modules/%.vo: modules/%.v
354	357	$(HIDE)$(coqtop) -R modules Mods -compile $<

+1

-1

test-suite/bench/lists-100.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/bench/lists_100.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

test-suite/bugs/closed/3249.v less more

4	4	lazymatch eval hnf in t with
5	5	\| ?a /\ ?b => constr:(proj1 T)
6	6	\| forall x : ?T', @?f x =>
7		constr:(fun x : T' => $(let fx := constr:(T x) in
	7	constr:(fun x : T' => ltac:(let fx := constr:(T x) in
8	8	let t := ret_and_left fx in
9		exact t)$)
	9	exact t))
10	10	end.

+5

-0

test-suite/bugs/closed/3257.v less more

	0	Require Import Setoid Morphisms Basics.
	1	Lemma foo A B (P : B -> Prop) :
	2	pointwise_relation _ impl (fun z => A -> P z) P.
	3	Proof.
	4	Fail reflexivity.

+1

-1

test-suite/bugs/closed/3285.v less more

0	0	Goal True.
1	1	Proof.
2	2	match goal with
3		\| _ => let x := constr:($(fail)$) in idtac
	3	\| _ => let x := constr:(ltac:(fail)) in idtac
4	4	\| _ => idtac
5	5	end.
6	6	Abort.

+4

-4

test-suite/bugs/closed/3286.v less more

5	5	\| forall x : ?T, @?P x
6	6	=> let ret := constr:(fun x' : T =>
7	7	let Hx := H x' in
8		$(let ret' := tac lem Hx in
9		exact ret')$) in
	8	ltac:(let ret' := tac lem Hx in
	9	exact ret')) in
10	10	match eval cbv zeta in ret with
11	11	\| fun x => Some (@?P x) => let P' := (eval cbv zeta in P) in
12	12	constr:(Some P')
13	13	end
14		\| _ => let ret := constr:($(match goal with
	14	\| _ => let ret := constr:(ltac:(match goal with
15	15	\| _ => (let H' := fresh in
16	16	pose H as H';
17	17	apply lem in H';
18	18	exact (Some H'))
19	19	\| _ => exact (@None nat)
20	20	end
21		)$) in
	21	)) in
22	22	let ret' := (eval cbv beta zeta in ret) in
23	23	constr:(ret')
24	24	\| _ => constr:(@None nat)

+2

-2

test-suite/bugs/closed/3314.v less more

0	0	Require Import TestSuite.admit.
1	1	Set Universe Polymorphism.
2	2	Definition Lift
3		: $(let U1 := constr:(Type) in
	3	: ltac:(let U1 := constr:(Type) in
4	4	let U0 := constr:(Type : U1) in
5		exact (U0 -> U1))$
	5	exact (U0 -> U1))
6	6	:= fun T => T.
7	7
8	8	Fail Check nat:Prop. (* The command has indeed failed with message:

+1

-1

test-suite/bugs/closed/3330.v less more

7	7	Section MakeEq.
8	8	Variables (a : foo@{i}) (b : foo@{j}).
9	9
10		Let t := $(let ty := type of b in exact ty)$.
	10	Let t := ltac:(let ty := type of b in exact ty).
11	11	Definition make_eq (x:=b) := a : t.
12	12	End MakeEq.
13	13

+1

-1

test-suite/bugs/closed/3347.v less more

0	0	Require Import TestSuite.admit.
1	1	(* File reduced by coq-bug-finder from original input, then from 12653 lines to 12453 lines, then from 11673 lines to 681 lines, then from 693 lines to 469 lines, then from 375 lines to 56 lines *)
2	2	Set Universe Polymorphism.
3		Notation Type1 := $(let U := constr:(Type) in let gt := constr:(Set : U) in exact U)$ (only parsing).
	3	Notation Type1 := ltac:(let U := constr:(Type) in let gt := constr:(Set : U) in exact U) (only parsing).
4	4	Inductive paths {A : Type} (a : A) : A -> Type := idpath : paths a a where "x = y" := (@paths _ x y) : type_scope.
5	5	Inductive Unit : Type1 := tt : Unit.
6	6	Fail Check Unit : Set. (* [Check Unit : Set] should fail if [Type1] is defined correctly *)

+1

-1

test-suite/bugs/closed/3354.v less more

0	0	Set Universe Polymorphism.
1		Notation Type1 := $(let U := constr:(Type) in let gt := constr:(Set : U) in exact U)$ (only parsing).
	1	Notation Type1 := ltac:(let U := constr:(Type) in let gt := constr:(Set : U) in exact U) (only parsing).
2	2	Inductive Empty : Type1 := .
3	3	Fail Check Empty : Set.
4	4	(* Toplevel input, characters 15-116:

+1

-1

test-suite/bugs/closed/3467.v less more

0	0	Module foo.
1		Notation x := $(exact I)$.
	1	Notation x := ltac:(exact I).
2	2	End foo.
3	3	Module bar.
4	4	Include foo.

+1

-1

test-suite/bugs/closed/3487.v less more

0		Notation bar := $(exact I)$.
	0	Notation bar := ltac:(exact I).
1	1	Notation foo := bar (only parsing).
2	2	Class baz := { x : False }.
3	3	Instance: baz.

+1

-0

test-suite/bugs/closed/3554.v less more

0

Example foo (f : forall {_ : Type}, Type) : Type.

+1

-1

test-suite/bugs/closed/3682.v less more

2	2	Definition bar `{Foo} (x : Set) := Set.
3	3	Instance: Foo.
4	4	Definition bar1 := bar nat.
5		Definition bar2 := bar $(admit)$.
	5	Definition bar2 := bar ltac:(admit).

+1

-1

test-suite/bugs/closed/3684.v less more

0	0	Require Import TestSuite.admit.
1	1	Definition foo : Set.
2	2	Proof.
3		refine ($(abstract admit)$).
	3	refine (ltac:(abstract admit)).
4	4	Qed.

+2

-2

test-suite/bugs/closed/3685.v less more

38	38	(G : Functor D D')
39	39	: Functor (C -> D) (C' -> D').
40	40	Proof.
41		refine (Build_Functor
	41	unshelve (refine (Build_Functor
42	42	(C -> D) (C' -> D')
43	43	_
44	44	_
45		_);
	45	_));
46	46	abstract admit.
47	47	Defined.
48	48	End PointwiseCore.

+2

-2

test-suite/bugs/closed/3686.v less more

32	32	(G : Functor D D')
33	33	: Functor (C -> D) (C' -> D').
34	34	Proof.
35		refine (Build_Functor
	35	unshelve (refine (Build_Functor
36	36	(C -> D) (C' -> D')
37	37	_
38	38	_
39		_);
	39	_));
40	40	abstract admit.
41	41	Defined.
42	42	End PointwiseCore.

+1

-1

test-suite/bugs/closed/3690.v less more

17	17	Top.6
18	18	Top.7
19	19	Top.8 \|= ) )
20		Definition bar := $(let t := eval compute in foo in exact t)$.
	20	Definition bar := ltac:(let t := eval compute in foo in exact t).
21	21	Check @bar. (* bar@{Top.13 Top.14 Top.15
22	22	Top.16}
23	23	: Type@{Top.16+1}

+8

-8

test-suite/bugs/closed/3699.v less more

33	33	: forall b:B, P b.
34	34	Proof.
35	35	intros b.
36		refine (pr1 (isconnected_elim _ _)).
37		2:exact b.
	36	unshelve (refine (pr1 (isconnected_elim _ _))).
	37	exact b.
38	38	intro x.
39	39	exact (transport P x.2 (d x.1)).
40	40	Defined.

46	46	: forall b:B, P b.
47	47	Proof.
48	48	intros b.
49		refine (pr1 (isconnected_elim _ _)).
50		2:exact b.
	49	unshelve (refine (pr1 (isconnected_elim _ _))).
	50	exact b.
51	51	intros [a p].
52	52	exact (transport P p (d a)).
53	53	Defined.

110	110	: forall b:B, P b.
111	111	Proof.
112	112	intros b.
113		refine (pr1 (isconnected_elim _ _)).
114		2:exact b.
	113	unshelve (refine (pr1 (isconnected_elim _ _))).
	114	exact b.
115	115	intro x.
116	116	exact (transport P x.2 (d x.1)).
117	117	Defined.

123	123	: forall b:B, P b.
124	124	Proof.
125	125	intros b.
126		refine (pr1 (isconnected_elim _ _)).
127		2:exact b.
	126	unshelve (refine (pr1 (isconnected_elim _ _))).
	127	exact b.
128	128	intros [a p].
129	129	exact (transport P p (d a)).
130	130	Defined.

+4

-0

test-suite/bugs/closed/3735.v less more

	0	Require Import Coq.Program.Tactics.
	1	Class Foo := { bar : Type }.
	2	Fail Lemma foo : Foo -> bar. (* 'Command has indeed failed.' in both 8.4 and trunk *)
	3	Fail Program Lemma foo : Foo -> bar. ⏎

+1

-1

test-suite/bugs/closed/3743.v less more

2	2	coqtop version cagnode16:/afs/csail.mit.edu/u/j/jgross/coq-trunk,trunk (d65496f09c4b68fa318783e53f9cd6d5c18e1eb7) *)
3	3	Require Export Coq.Setoids.Setoid.
4	4
5		Fail Add Parametric Relation A
	5	Add Parametric Relation A
6	6	: A (@eq A)
7	7	transitivity proved by transitivity
8	8	as refine_rel.

+92

-0

test-suite/bugs/closed/3746.v less more

	0
	1	(* Bug report #3746 : Include and restricted signature *)
	2
	3	Module Type MT. Parameter p : nat. End MT.
	4	Module Type EMPTY. End EMPTY.
	5	Module Empty. End Empty.
	6
	7	(* Include of an applied functor with restricted sig :
	8	Used to create axioms (bug report #3746), now forbidden. *)
	9
	10	Module F (X:EMPTY) : MT.
	11	Definition p := 0.
	12	End F.
	13
	14	Module InclFunctRestr.
	15	Fail Include F(Empty).
	16	End InclFunctRestr.
	17
	18	(* A few variants (indirect restricted signature), also forbidden. *)
	19
	20	Module F1 := F.
	21	Module F2 (X:EMPTY) := F X.
	22
	23	Module F3a (X:EMPTY). Definition p := 0. End F3a.
	24	Module F3 (X:EMPTY) : MT := F3a X.
	25
	26	Module InclFunctRestrBis.
	27	Fail Include F1(Empty).
	28	Fail Include F2(Empty).
	29	Fail Include F3(Empty).
	30	End InclFunctRestrBis.
	31
	32	(* Recommended workaround: manual instance before the include. *)
	33
	34	Module InclWorkaround.
	35	Module Temp := F(Empty).
	36	Include Temp.
	37	End InclWorkaround.
	38
	39	Compute InclWorkaround.p.
	40	Print InclWorkaround.p.
	41	Print Assumptions InclWorkaround.p. (* Closed under the global context *)
	42
	43
	44
	45	(* Related situations which are ok, just to check *)
	46
	47	(* A) Include of non-functor with restricted signature :
	48	creates a proxy to initial stuff *)
	49
	50	Module M : MT.
	51	Definition p := 0.
	52	End M.
	53
	54	Module InclNonFunct.
	55	Include M.
	56	End InclNonFunct.
	57
	58	Definition check : InclNonFunct.p = M.p := eq_refl.
	59	Print Assumptions InclNonFunct.p. (* Closed *)
	60
	61
	62	(* B) Include of a module type with opaque content:
	63	The opaque content is "copy-pasted". *)
	64
	65	Module Type SigOpaque.
	66	Definition p : nat. Proof. exact 0. Qed.
	67	End SigOpaque.
	68
	69	Module InclSigOpaque.
	70	Include SigOpaque.
	71	End InclSigOpaque.
	72
	73	Compute InclSigOpaque.p.
	74	Print InclSigOpaque.p.
	75	Print Assumptions InclSigOpaque.p. (* Closed *)
	76
	77
	78	(* C) Include of an applied functor with opaque proofs :
	79	opaque proof "copy-pasted" (and substituted). *)
	80
	81	Module F' (X:EMPTY).
	82	Definition p : nat. Proof. exact 0. Qed.
	83	End F'.
	84
	85	Module InclFunctOpa.
	86	Include F'(Empty).
	87	End InclFunctOpa.
	88
	89	Compute InclFunctOpa.p.
	90	Print InclFunctOpa.p.
	91	Print Assumptions InclFunctOpa.p. (* Closed *)

+33

-0

test-suite/bugs/closed/3807.v less more

	0	Set Universe Polymorphism.
	1	Set Printing Universes.
	2	Unset Universe Minimization ToSet.
	3
	4
	5	Definition foo : Type := nat.
	6	About foo.
	7	(* foo@{Top.1} : Type@{Top.1}*)
	8	(* Top.1 \|= *)
	9
	10	Definition bar : foo -> nat.
	11	Admitted.
	12	About bar.
	13	(* bar@{Top.2} : foo@{Top.2} -> nat *)
	14	(* Top.2 \|= *)
	15
	16	Lemma baz@{i} : foo@{i} -> nat.
	17	Proof.
	18	exact bar.
	19	Defined.
	20
	21	Definition bar'@{i} : foo@{i} -> nat.
	22	intros f. exact 0.
	23	Admitted.
	24	About bar'.
	25	(* bar'@{i} : foo@{i} -> nat *)
	26	(* i \|= *)
	27
	28	Axiom f@{i} : Type@{i}.
	29	(*
	30	*** [ f@{i} : Type@{i} ]
	31	(* i \|= *)
	32	*)⏎

+22

-0

test-suite/bugs/closed/3848.v less more

	0	Require Import TestSuite.admit.
	1	Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y.
	2	Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing).
	3	Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x.
	4	Class IsEquiv {A B} (f : A -> B) := { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }.
	5	Arguments eisretr {A B} f {_} _.
	6	Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'").
	7	Generalizable Variables A B f g e n.
	8	Definition functor_forall `{P : A -> Type} `{Q : B -> Type}
	9	(f0 : B -> A) (f1 : forall b:B, P (f0 b) -> Q b)
	10	: (forall a:A, P a) -> (forall b:B, Q b).
	11	admit.
	12	Defined.
	13
	14	Lemma isequiv_functor_forall `{P : A -> Type} `{Q : B -> Type}
	15	`{IsEquiv B A f} `{forall b, @IsEquiv (P (f b)) (Q b) (g b)}
	16	: (forall b : B, Q b) -> forall a : A, P a.
	17	Proof.
	18	refine (functor_forall
	19	(f^-1)
	20	(fun (x:A) (y:Q (f^-1 x)) => eisretr f x # (g (f^-1 x))^-1 y)).
	21	Defined. (* was: Error: Attempt to save an incomplete proof *)

+1

-1

test-suite/bugs/closed/3881.v less more

7	7	Notation "A -> B" := (forall (_ : A), B) : type_scope.
8	8	Axiom admit : forall {T}, T.
9	9	Notation "g 'o' f" := (fun x => g (f x)) (at level 40, left associativity).
10		Notation "g 'o' f" := $(let g' := g in let f' := f in exact (fun x => g' (f' x)))$ (at level 40, left associativity). (* Ensure that x is not captured in [g] or [f] in case they contain holes *)
	10	Notation "g 'o' f" := ltac:(let g' := g in let f' := f in exact (fun x => g' (f' x))) (at level 40, left associativity). (* Ensure that x is not captured in [g] or [f] in case they contain holes *)
11	11	Inductive eq {A} (x:A) : A -> Prop := eq_refl : x = x where "x = y" := (@eq _ x y) : type_scope.
12	12	Arguments eq_refl {_ _}.
13	13	Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with eq_refl => eq_refl end.

+33

-0

test-suite/bugs/closed/3923.v less more

	0	Module Type TRIVIAL.
	1	Parameter t:Type.
	2	End TRIVIAL.
	3
	4	Module MkStore (Key : TRIVIAL).
	5
	6	Module St : TRIVIAL.
	7	Definition t := unit.
	8	End St.
	9
	10	End MkStore.
	11
	12
	13
	14	Module Type CERTRUNTIMETYPES (B : TRIVIAL).
	15
	16	Parameter cert_fieldstore : Type.
	17	Parameter empty_fieldstore : cert_fieldstore.
	18
	19	End CERTRUNTIMETYPES.
	20
	21
	22
	23	Module MkCertRuntimeTypes (B : TRIVIAL) : CERTRUNTIMETYPES B.
	24
	25	Module FieldStore := MkStore B.
	26
	27	Definition cert_fieldstore := FieldStore.St.t.
	28	Axiom empty_fieldstore : cert_fieldstore.
	29
	30	End MkCertRuntimeTypes.
	31
	32	Extraction MkCertRuntimeTypes. (* Was leading to an uncaught Not_found *)

+24

-0

test-suite/bugs/closed/3998.v less more

	0	Class FieldType (F : Set) := mkFieldType { fldTy: F -> Set }.
	1	Hint Mode FieldType + : typeclass_instances. (* The F parameter is an input *)
	2
	3	Inductive I1 := C.
	4	Inductive I2 := .
	5
	6	Instance I1FieldType : FieldType I1 := { fldTy := I1_rect _ bool }.
	7	Instance I2FieldType : FieldType I2 := { fldTy := I2_rect _ }.
	8
	9	Definition RecordOf F (FT: FieldType F) := forall f:F, fldTy f.
	10
	11	Class MapOps (M K : Set) := {
	12	tgtTy: K -> Set;
	13	update: M -> forall k:K, tgtTy k -> M
	14	}.
	15
	16	Instance RecordMapOps F (FT: FieldType F) : MapOps (RecordOf F FT) F :=
	17	{ tgtTy := fldTy; update := fun r (f: F) (x: fldTy f) z => r z }.
	18
	19	Axiom ex : RecordOf _ I1FieldType.
	20
	21	Definition works := (fun ex' => update ex' C true) (update ex C false).
	22	Set Typeclasses Debug.
	23	Definition doesnt := update (update ex C false) C true.⏎

+3

-3

test-suite/bugs/closed/4116.v less more

109	109	Trunc_is_trunc : IsTrunc_internal n A.
110	110
111	111	Tactic Notation "transparent" "assert" "(" ident(name) ":" constr(type) ")" :=
112		refine (let __transparent_assert_hypothesis := (_ : type) in _);
	112	unshelve refine (let __transparent_assert_hypothesis := (_ : type) in _);
113	113	[
114	114	\| (
115	115	let H := match goal with H := _ \|- _ => constr:(H) end in

320	320
321	321	Definition Gcategory : PreCategory.
322	322	Proof.
323		refine (@Build_PreCategory
	323	unshelve refine (@Build_PreCategory
324	324	Pair
325	325	(fun s d => Gmorphism s d)
326	326	Gidentity

345	345	Instance iscategory_grothendieck_toset : IsCategory (Gcategory F).
346	346	Proof.
347	347	intros s d.
348		refine (isequiv_adjointify _ _ _ _).
	348	unshelve refine (isequiv_adjointify _ _ _ _).
349	349	{
350	350	intro m.
351	351	transparent assert (H' : (s.(c) = d.(c))).

+4

-0

test-suite/bugs/closed/4149.v less more

	0	Goal forall A, A -> Type.
	1	Proof.
	2	intros; eauto.
	3	Qed.

+43

-0

test-suite/bugs/closed/4256.v less more

	0	(* Testing 8.5 regression with type classes not solving evars
	1	redefined while trying to solve them with the type class mechanism *)
	2
	3	Global Set Universe Polymorphism.
	4	Monomorphic Universe i.
	5	Inductive paths {A : Type} (a : A) : A -> Type :=
	6	idpath : paths a a.
	7	Arguments idpath {A a} , [A] a.
	8	Notation "x = y :> A" := (@paths A x y) : type_scope.
	9	Notation "x = y" := (x = y :>_) : type_scope.
	10
	11	Inductive trunc_index : Type :=
	12	\| minus_two : trunc_index
	13	\| trunc_S : trunc_index -> trunc_index.
	14	Notation "-1" := (trunc_S minus_two) (at level 0).
	15
	16	Class IsPointed (A : Type) := point : A.
	17	Arguments point A {_}.
	18
	19	Record pType :=
	20	{ pointed_type : Type ;
	21	ispointed_type : IsPointed pointed_type }.
	22	Coercion pointed_type : pType >-> Sortclass.
	23	Existing Instance ispointed_type.
	24
	25	Private Inductive Trunc (n : trunc_index) (A :Type) : Type :=
	26	tr : A -> Trunc n A.
	27	Arguments tr {n A} a.
	28
	29
	30
	31	Record ooGroup :=
	32	{ classifying_space : pType@{i} }.
	33
	34	Definition group_loops (X : pType)
	35	: ooGroup.
	36	Proof.
	37	(** This works: *)
	38	pose (x0 := point X).
	39	pose (H := existT (fun x:X => Trunc -1 (x = point X)) x0 (tr idpath)).
	40	clear H x0.
	41	(** But this doesn't: *)
	42	pose (existT (fun x:X => Trunc -1 (x = point X)) (point X) (tr idpath)).

+9

-0

test-suite/bugs/closed/4273.v less more

	0
	1
	2	Set Primitive Projections.
	3	Record total2 (P : nat -> Prop) := tpair { pr1 : nat; pr2 : P pr1 }.
	4	Theorem onefiber' (q : total2 (fun y => y = 0)) : True.
	5	Proof. assert (foo:=pr2 _ q). simpl in foo.
	6	destruct foo. (* Error: q is used in conclusion. *) exact I. Qed.
	7
	8	Print onefiber'.⏎

+6

-0

test-suite/bugs/closed/4284.v less more

	0	Set Primitive Projections.
	1	Record total2 { T: Type } ( P: T -> Type ) := tpair { pr1 : T; pr2 : P pr1 }.
	2	Theorem onefiber' {X : Type} (P : X -> Type) (x : X) : True.
	3	Proof.
	4	set (Q1 := total2 (fun f => pr1 P f = x)).
	5	set (f1:=fun q1 : Q1 => pr2 _ (pr1 _ q1)).

+2

-4

test-suite/bugs/closed/4287.v less more

117	117	let foo (A : Type@{j}) := A in foo B.
118	118
119	119	Fail Check @setlt@{j Prop}.
120		Check @setlt@{Prop j}.
121		Check @setle@{Prop j}.
122
123	120	Fail Definition foo := @setle@{j Prop}.
124		Definition foo := @setle@{Prop j}.
	121	Check setlt@{Set i}.
	122	Check setlt@{Set j}.⏎

+7

-0

test-suite/bugs/closed/4293.v less more

	0	Module Type Foo.
	1	Definition T := let X := Type in Type.
	2	End Foo.
	3
	4	Module M : Foo.
	5	Definition T := let X := Type in Type.
	6	End M.⏎

+9

-0

test-suite/bugs/closed/4363.v less more

	0	Set Printing Universes.
	1	Definition foo : Type.
	2	Proof.
	3	assert (H : Set) by abstract (assert Type by abstract exact Type using bar; exact nat).
	4	exact bar.
	5	Defined. (* Toplevel input, characters 0-8:
	6	Error:
	7	The term "(fun _ : Set => bar) foo_subproof" has type
	8	"Type@{Top.2}" while it is expected to have type "Type@{Top.1}". *)

+19

-0

test-suite/bugs/closed/4400.v less more

	0	(* -- coq-prog-args: ("-emacs" "-require" "Coq.Compat.Coq84" "-compat" "8.4") -- *)
	1	Require Import Coq.Lists.List Coq.Logic.JMeq Program.Equality.
	2	Set Printing Universes.
	3	Inductive Foo (I : Type -> Type) (A : Type) : Type :=
	4	\| foo (B : Type) : A -> I B -> Foo I A.
	5	Definition Family := Type -> Type.
	6	Definition FooToo : Family -> Family := Foo.
	7	Definition optionize (I : Type -> Type) (A : Type) := option (I A).
	8	Definition bar (I : Type -> Type) (A : Type) : A -> option (I A) -> Foo(optionize I) A := foo (optionize I) A A.
	9	Record Rec (I : Type -> Type) := { rec : forall A : Type, A -> I A -> Foo I A }.
	10	Definition barRec : Rec (optionize id) := {\| rec := bar id \|}.
	11	Inductive Empty {T} : T -> Prop := .
	12	Theorem empty (family : Family) (a : fold_right prod unit (map (Foo family)
	13	nil)) (b : unit) :
	14	Empty (a, b) -> False.
	15	Proof.
	16	intro e.
	17	dependent induction e.
	18	Qed.

+4

-0

test-suite/bugs/closed/4404.v less more

	0	Inductive Foo : Type -> Type := foo A : Foo A.
	1	Goal True.
	2	remember Foo.
	3

+4

-0

test-suite/bugs/closed/4412.v less more

	0	Require Import Coq.Bool.Bool Coq.Setoids.Setoid.
	1	Goal forall (P : forall b : bool, b = true -> Type) (x y : bool) (H : andb x y = true) (H' : P _ H), True.
	2	intros.
	3	Fail rewrite Bool.andb_true_iff in H.

+19

-0

test-suite/bugs/closed/4420.v less more

	0	Module foo.
	1	Context (Char : Type).
	2	Axiom foo : Type -> Type.
	3	Goal foo Char = foo Char.
	4	change foo with (fun x => foo x).
	5	cbv beta.
	6	reflexivity.
	7	Defined.
	8	End foo.
	9
	10	Inductive foo (A : Type) : Prop := I. (Top.1)
	11	Lemma bar : foo Type. (Top.3)
	12	Proof.
	13	Set Printing Universes.
	14	change foo with (fun x : Type => foo x). (Top.4)
	15	cbv beta.
	16	apply I. (* I Type@{Top.3} : (fun x : Type@{Top.4} => foo x) Type@{Top.3} *)
	17	Defined.
	18

+31

-0

test-suite/bugs/closed/4429.v less more

	0	Require Import Arith.Compare_dec.
	1	Require Import Unicode.Utf8.
	2
	3	Fixpoint my_nat_iter (n : nat) {A} (f : A → A) (x : A) : A :=
	4	match n with
	5	\| O => x
	6	\| S n' => f (my_nat_iter n' f x)
	7	end.
	8
	9	Definition gcd_IT_F (f : nat * nat → nat) (mn : nat * nat) : nat :=
	10	match mn with
	11	\| (0, 0) => 0
	12	\| (0, S n') => S n'
	13	\| (S m', 0) => S m'
	14	\| (S m', S n') =>
	15	match le_gt_dec (S m') (S n') with
	16	\| left _ => f (S m', S n' - S m')
	17	\| right _ => f (S m' - S n', S n')
	18	end
	19	end.
	20
	21	Axiom max_correct_l : ∀ m n : nat, m <= max m n.
	22	Axiom max_correct_r : ∀ m n : nat, n <= max m n.
	23
	24	Hint Resolve max_correct_l max_correct_r : arith.
	25
	26	Theorem foo : ∀ p p' p'' : nat, p'' < S (max p (max p' p'')).
	27	Proof.
	28	intros.
	29	Timeout 3 eauto with arith.
	30	Qed.

+29

-0

test-suite/bugs/closed/4433.v less more

	0	Require Import Coq.Arith.Arith Coq.Init.Wf.
	1	Axiom proof_admitted : False.
	2	Goal exists x y z : nat, Fix
	3	Wf_nat.lt_wf
	4	(fun _ => nat -> nat)
	5	(fun x' f => match x' as x'0
	6	return match x'0 with
	7	\| 0 => True
	8	\| S x'' => x'' < x'
	9	end
	10	-> nat -> nat
	11	with
	12	\| 0 => fun _ _ => 0
	13	\| S x'' => f x''
	14	end
	15	(match x' with
	16	\| 0 => I
	17	\| S x'' => (Nat.lt_succ_diag_r _)
	18	end))
	19	z
	20	y
	21	= 0.
	22	Proof.
	23	do 3 (eexists; [ shelve.. \| ]).
	24	match goal with \|- ?G => let G' := (eval lazy in G) in change G with G' end.
	25	case proof_admitted.
	26	Unshelve.
	27	all:constructor.
	28	Defined.⏎

+31

-0

test-suite/bugs/closed/4443.v less more

	0	Set Universe Polymorphism.
	1
	2	Record TYPE@{i} := cType {
	3	type : Type@{i};
	4	}.
	5
	6	Definition PROD@{i j k}
	7	(A : Type@{i})
	8	(B : A -> Type@{j})
	9	: TYPE@{k}.
	10	Proof.
	11	refine (cType@{i} _).
	12	+ refine (forall x : A, B x).
	13	Defined.
	14
	15	Local Unset Strict Universe Declaration.
	16	Definition PRODinj
	17	(A : Type@{i})
	18	(B : A -> Type)
	19	: TYPE.
	20	Proof.
	21	refine (cType@{i} _).
	22	+ refine (forall x : A, B x).
	23	Defined.
	24
	25	Monomorphic Universe i j.
	26	Monomorphic Constraint j < i.
	27	Set Printing Universes.
	28	Check PROD@{i i i}.
	29	Check PRODinj@{i j}.
	30	Fail Check PRODinj@{j i}.⏎

+8

-0

test-suite/bugs/closed/4453.v less more

	0
	1	Section Foo.
	2	Variable A : Type.
	3	Lemma foo : A -> True. now intros _. Qed.
	4	Goal Type -> True.
	5	rename A into B.
	6	intros A.
	7	Fail apply foo.

+647

-0

test-suite/bugs/closed/4456.v less more

	0	(* -- mode: coq; coq-prog-args: ("-emacs" "-R" "." "Fiat" "-top" "BooleanRecognizerMin" "-R" "." "Top") -- *)
	1	(* File reduced by coq-bug-finder from original input, then from 2475 lines to 729 lines, then from 746 lines to 658 lines, then from 675 lines to 658 lines *)
	2	(* coqc version 8.5beta3 (November 2015) compiled on Nov 11 2015 18:23:0 with OCaml 4.01.0
	3	coqtop version 8.5beta3 (November 2015) *)
	4	(* Variable P : forall n m : nat, n = m -> Prop. *)
	5	(* Axiom Prefl : forall n : nat, P n n eq_refl. *)
	6	Axiom proof_admitted : False.
	7
	8	Tactic Notation "admit" := case proof_admitted.
	9
	10	Require Coq.Program.Program.
	11	Require Coq.Strings.String.
	12	Require Coq.omega.Omega.
	13	Module Export Fiat_DOT_Common.
	14	Module Export Fiat.
	15	Module Common.
	16	Import Coq.Lists.List.
	17	Export Coq.Program.Program.
	18
	19	Global Set Implicit Arguments.
	20
	21	Global Coercion is_true : bool >-> Sortclass.
	22	Coercion bool_of_sum {A B} (b : sum A B) : bool := if b then true else false.
	23
	24	Fixpoint ForallT {T} (P : T -> Type) (ls : list T) : Type
	25	:= match ls return Type with
	26	\| nil => True
	27	\| x::xs => (P x * ForallT P xs)%type
	28	end.
	29	Fixpoint Forall_tails {T} (P : list T -> Type) (ls : list T) : Type
	30	:= match ls with
	31	\| nil => P nil
	32	\| x::xs => (P (x::xs) * Forall_tails P xs)%type
	33	end.
	34
	35	End Common.
	36
	37	End Fiat.
	38
	39	End Fiat_DOT_Common.
	40	Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Core.
	41	Module Export Fiat.
	42	Module Export Parsers.
	43	Module Export StringLike.
	44	Module Export Core.
	45	Import Coq.Relations.Relation_Definitions.
	46	Import Coq.Classes.Morphisms.
	47
	48	Local Coercion is_true : bool >-> Sortclass.
	49
	50	Module Export StringLike.
	51	Class StringLike {Char : Type} :=
	52	{
	53	String :> Type;
	54	is_char : String -> Char -> bool;
	55	length : String -> nat;
	56	take : nat -> String -> String;
	57	drop : nat -> String -> String;
	58	get : nat -> String -> option Char;
	59	unsafe_get : nat -> String -> Char;
	60	bool_eq : String -> String -> bool;
	61	beq : relation String := fun x y => bool_eq x y
	62	}.
	63
	64	Arguments StringLike : clear implicits.
	65	Infix "=s" := (@beq _ _) (at level 70, no associativity) : type_scope.
	66	Notation "s ~= [ ch ]" := (is_char s ch) (at level 70, no associativity) : string_like_scope.
	67	Local Open Scope string_like_scope.
	68
	69	Class StringLikeProperties (Char : Type) `{StringLike Char} :=
	70	{
	71	singleton_unique : forall s ch ch', s ~= [ ch ] -> s ~= [ ch' ] -> ch = ch';
	72	singleton_exists : forall s, length s = 1 -> exists ch, s ~= [ ch ];
	73	get_0 : forall s ch, take 1 s ~= [ ch ] <-> get 0 s = Some ch;
	74	get_S : forall n s, get (S n) s = get n (drop 1 s);
	75	unsafe_get_correct : forall n s ch, get n s = Some ch -> unsafe_get n s = ch;
	76	length_singleton : forall s ch, s ~= [ ch ] -> length s = 1;
	77	bool_eq_char : forall s s' ch, s ~= [ ch ] -> s' ~= [ ch ] -> s =s s';
	78	is_char_Proper :> Proper (beq ==> eq ==> eq) is_char;
	79	length_Proper :> Proper (beq ==> eq) length;
	80	take_Proper :> Proper (eq ==> beq ==> beq) take;
	81	drop_Proper :> Proper (eq ==> beq ==> beq) drop;
	82	bool_eq_Equivalence :> Equivalence beq;
	83	bool_eq_empty : forall str str', length str = 0 -> length str' = 0 -> str =s str';
	84	take_short_length : forall str n, n <= length str -> length (take n str) = n;
	85	take_long : forall str n, length str <= n -> take n str =s str;
	86	take_take : forall str n m, take n (take m str) =s take (min n m) str;
	87	drop_length : forall str n, length (drop n str) = length str - n;
	88	drop_0 : forall str, drop 0 str =s str;
	89	drop_drop : forall str n m, drop n (drop m str) =s drop (n + m) str;
	90	drop_take : forall str n m, drop n (take m str) =s take (m - n) (drop n str);
	91	take_drop : forall str n m, take n (drop m str) =s drop m (take (n + m) str);
	92	bool_eq_from_get : forall str str', (forall n, get n str = get n str') -> str =s str'
	93	}.
	94	Global Arguments StringLikeProperties _ {_}.
	95	End StringLike.
	96
	97	End Core.
	98
	99	End StringLike.
	100
	101	End Parsers.
	102
	103	End Fiat.
	104
	105	End Fiat_DOT_Parsers_DOT_StringLike_DOT_Core.
	106
	107	Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core.
	108	Module Export Fiat.
	109	Module Export Parsers.
	110	Module Export ContextFreeGrammar.
	111	Module Export Core.
	112	Import Coq.Strings.String.
	113	Import Coq.Lists.List.
	114	Export Fiat.Parsers.StringLike.Core.
	115
	116	Section cfg.
	117	Context {Char : Type}.
	118
	119	Section definitions.
	120
	121	Inductive item :=
	122	\| Terminal (_ : Char)
	123	\| NonTerminal (_ : string).
	124
	125	Definition production := list item.
	126	Definition productions := list production.
	127
	128	Record grammar :=
	129	{
	130	Start_symbol :> string;
	131	Lookup :> string -> productions;
	132	Start_productions :> productions := Lookup Start_symbol;
	133	Valid_nonterminals : list string;
	134	Valid_productions : list productions := map Lookup Valid_nonterminals
	135	}.
	136	End definitions.
	137
	138	End cfg.
	139
	140	Arguments item _ : clear implicits.
	141	Arguments production _ : clear implicits.
	142	Arguments productions _ : clear implicits.
	143	Arguments grammar _ : clear implicits.
	144
	145	End Core.
	146
	147	End ContextFreeGrammar.
	148
	149	End Parsers.
	150
	151	End Fiat.
	152
	153	End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Core.
	154
	155	Module Export Fiat_DOT_Parsers_DOT_BaseTypes.
	156	Module Export Fiat.
	157	Module Export Parsers.
	158	Module Export BaseTypes.
	159	Import Coq.Arith.Wf_nat.
	160
	161	Local Coercion is_true : bool >-> Sortclass.
	162
	163	Section recursive_descent_parser.
	164	Context {Char} {HSL : StringLike Char} {G : grammar Char}.
	165
	166	Class parser_computational_predataT :=
	167	{ nonterminals_listT : Type;
	168	nonterminal_carrierT : Type;
	169	of_nonterminal : String.string -> nonterminal_carrierT;
	170	to_nonterminal : nonterminal_carrierT -> String.string;
	171	initial_nonterminals_data : nonterminals_listT;
	172	nonterminals_length : nonterminals_listT -> nat;
	173	is_valid_nonterminal : nonterminals_listT -> nonterminal_carrierT -> bool;
	174	remove_nonterminal : nonterminals_listT -> nonterminal_carrierT -> nonterminals_listT }.
	175
	176	Class parser_removal_dataT' `{predata : parser_computational_predataT} :=
	177	{ nonterminals_listT_R : nonterminals_listT -> nonterminals_listT -> Prop
	178	:= ltof _ nonterminals_length;
	179	nonterminals_length_zero : forall ls,
	180	nonterminals_length ls = 0
	181	-> forall nt, is_valid_nonterminal ls nt = false;
	182	remove_nonterminal_dec : forall ls nonterminal,
	183	is_valid_nonterminal ls nonterminal
	184	-> nonterminals_listT_R (remove_nonterminal ls nonterminal) ls;
	185	remove_nonterminal_noninc : forall ls nonterminal,
	186	~nonterminals_listT_R ls (remove_nonterminal ls nonterminal);
	187	initial_nonterminals_correct : forall nonterminal,
	188	is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal) <-> List.In nonterminal (Valid_nonterminals G);
	189	initial_nonterminals_correct' : forall nonterminal,
	190	is_valid_nonterminal initial_nonterminals_data nonterminal <-> List.In (to_nonterminal nonterminal) (Valid_nonterminals G);
	191	to_of_nonterminal : forall nonterminal,
	192	List.In nonterminal (Valid_nonterminals G)
	193	-> to_nonterminal (of_nonterminal nonterminal) = nonterminal;
	194	of_to_nonterminal : forall nonterminal,
	195	is_valid_nonterminal initial_nonterminals_data nonterminal
	196	-> of_nonterminal (to_nonterminal nonterminal) = nonterminal;
	197	ntl_wf : well_founded nonterminals_listT_R
	198	:= well_founded_ltof _ _;
	199	remove_nonterminal_1
	200	: forall ls ps ps',
	201	is_valid_nonterminal (remove_nonterminal ls ps) ps'
	202	-> is_valid_nonterminal ls ps';
	203	remove_nonterminal_2
	204	: forall ls ps ps',
	205	is_valid_nonterminal (remove_nonterminal ls ps) ps' = false
	206	<-> is_valid_nonterminal ls ps' = false \/ ps = ps' }.
	207
	208	Class split_dataT :=
	209	{ split_string_for_production
	210	: item Char -> production Char -> String -> list nat }.
	211
	212	Class boolean_parser_dataT :=
	213	{ predata :> parser_computational_predataT;
	214	split_data :> split_dataT }.
	215	End recursive_descent_parser.
	216
	217	End BaseTypes.
	218
	219	End Parsers.
	220
	221	End Fiat.
	222
	223	End Fiat_DOT_Parsers_DOT_BaseTypes.
	224
	225	Module Export Fiat_DOT_Common_DOT_List_DOT_Operations.
	226	Module Export Fiat.
	227	Module Export Common.
	228	Module Export List.
	229	Module Export Operations.
	230
	231	Import Coq.Lists.List.
	232
	233	Module Export List.
	234	Section InT.
	235	Context {A : Type} (a : A).
	236
	237	Fixpoint InT (ls : list A) : Set
	238	:= match ls return Set with
	239	\| nil => False
	240	\| b :: m => (b = a) + InT m
	241	end%type.
	242	End InT.
	243
	244	End List.
	245
	246	End Operations.
	247
	248	End List.
	249
	250	End Common.
	251
	252	End Fiat.
	253
	254	End Fiat_DOT_Common_DOT_List_DOT_Operations.
	255
	256	Module Export Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties.
	257	Module Export Fiat.
	258	Module Export Parsers.
	259	Module Export StringLike.
	260	Module Export Properties.
	261
	262	Section String.
	263	Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char}.
	264
	265	Lemma take_length {str n}
	266	: length (take n str) = min n (length str).
	267	admit.
	268	Defined.
	269
	270	End String.
	271
	272	End Properties.
	273
	274	End StringLike.
	275
	276	End Parsers.
	277
	278	End Fiat.
	279
	280	End Fiat_DOT_Parsers_DOT_StringLike_DOT_Properties.
	281
	282	Module Export Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties.
	283	Module Export Fiat.
	284	Module Export Parsers.
	285	Module Export ContextFreeGrammar.
	286	Module Export Properties.
	287
	288	Local Open Scope list_scope.
	289	Definition production_is_reachableT {Char} (G : grammar Char) (p : production Char)
	290	:= { nt : _
	291	& { prefix : _
	292	& List.In nt (Valid_nonterminals G)
	293	* List.InT
	294	(prefix ++ p)
	295	(Lookup G nt) } }%type.
	296
	297	End Properties.
	298
	299	End ContextFreeGrammar.
	300
	301	End Parsers.
	302
	303	End Fiat.
	304
	305	End Fiat_DOT_Parsers_DOT_ContextFreeGrammar_DOT_Properties.
	306
	307	Module Export Fiat_DOT_Parsers_DOT_MinimalParse.
	308	Module Export Fiat.
	309	Module Export Parsers.
	310	Module Export MinimalParse.
	311	Import Coq.Lists.List.
	312	Import Fiat.Parsers.ContextFreeGrammar.Core.
	313
	314	Local Coercion is_true : bool >-> Sortclass.
	315	Local Open Scope string_like_scope.
	316
	317	Section cfg.
	318	Context {Char} {HSL : StringLike Char} {G : grammar Char}.
	319	Context {predata : @parser_computational_predataT}
	320	{rdata' : @parser_removal_dataT' _ G predata}.
	321
	322	Inductive minimal_parse_of
	323	: forall (len0 : nat) (valid : nonterminals_listT)
	324	(str : String),
	325	productions Char -> Type :=
	326	\| MinParseHead : forall len0 valid str pat pats,
	327	@minimal_parse_of_production len0 valid str pat
	328	-> @minimal_parse_of len0 valid str (pat::pats)
	329	\| MinParseTail : forall len0 valid str pat pats,
	330	@minimal_parse_of len0 valid str pats
	331	-> @minimal_parse_of len0 valid str (pat::pats)
	332	with minimal_parse_of_production
	333	: forall (len0 : nat) (valid : nonterminals_listT)
	334	(str : String),
	335	production Char -> Type :=
	336	\| MinParseProductionNil : forall len0 valid str,
	337	length str = 0
	338	-> @minimal_parse_of_production len0 valid str nil
	339	\| MinParseProductionCons : forall len0 valid str n pat pats,
	340	length str <= len0
	341	-> @minimal_parse_of_item len0 valid (take n str) pat
	342	-> @minimal_parse_of_production len0 valid (drop n str) pats
	343	-> @minimal_parse_of_production len0 valid str (pat::pats)
	344	with minimal_parse_of_item
	345	: forall (len0 : nat) (valid : nonterminals_listT)
	346	(str : String),
	347	item Char -> Type :=
	348	\| MinParseTerminal : forall len0 valid str ch,
	349	str ~= [ ch ]
	350	-> @minimal_parse_of_item len0 valid str (Terminal ch)
	351	\| MinParseNonTerminal
	352	: forall len0 valid str (nt : String.string),
	353	@minimal_parse_of_nonterminal len0 valid str nt
	354	-> @minimal_parse_of_item len0 valid str (NonTerminal nt)
	355	with minimal_parse_of_nonterminal
	356	: forall (len0 : nat) (valid : nonterminals_listT)
	357	(str : String),
	358	String.string -> Type :=
	359	\| MinParseNonTerminalStrLt
	360	: forall len0 valid (nt : String.string) str,
	361	length str < len0
	362	-> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt)
	363	-> @minimal_parse_of (length str) initial_nonterminals_data str (Lookup G nt)
	364	-> @minimal_parse_of_nonterminal len0 valid str nt
	365	\| MinParseNonTerminalStrEq
	366	: forall len0 str valid nonterminal,
	367	length str = len0
	368	-> is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal)
	369	-> is_valid_nonterminal valid (of_nonterminal nonterminal)
	370	-> @minimal_parse_of len0 (remove_nonterminal valid (of_nonterminal nonterminal)) str (Lookup G nonterminal)
	371	-> @minimal_parse_of_nonterminal len0 valid str nonterminal.
	372
	373	End cfg.
	374
	375	End MinimalParse.
	376
	377	End Parsers.
	378
	379	End Fiat.
	380
	381	End Fiat_DOT_Parsers_DOT_MinimalParse.
	382
	383	Module Export Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes.
	384	Module Export Fiat.
	385	Module Export Parsers.
	386	Module Export CorrectnessBaseTypes.
	387	Import Coq.Lists.List.
	388	Import Fiat.Parsers.ContextFreeGrammar.Core.
	389	Import Fiat_DOT_Common.Fiat.Common.
	390	Section general.
	391	Context {Char} {HSL : StringLike Char} {G : grammar Char}.
	392
	393	Definition split_list_completeT_for {data : @parser_computational_predataT}
	394	{len0 valid}
	395	(it : item Char) (its : production Char)
	396	(str : String)
	397	(pf : length str <= len0)
	398	(split_list : list nat)
	399
	400	:= ({ n : nat
	401	& (minimal_parse_of_item (G := G) (predata := data) len0 valid (take n str) it)
	402	* (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type)
	403	-> ({ n : nat
	404	& (In (min (length str) n) (map (min (length str)) split_list))
	405	* (minimal_parse_of_item (G := G) len0 valid (take n str) it)
	406	* (minimal_parse_of_production (G := G) len0 valid (drop n str) its) }%type).
	407
	408	Definition split_list_completeT {data : @parser_computational_predataT}
	409	(splits : item Char -> production Char -> String -> list nat)
	410	:= forall len0 valid str (pf : length str <= len0) nt,
	411	is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt)
	412	-> ForallT
	413	(Forall_tails
	414	(fun prod
	415	=> match prod return Type with
	416	\| nil => True
	417	\| it::its
	418	=> @split_list_completeT_for data len0 valid it its str pf (splits it its str)
	419	end))
	420	(Lookup G nt).
	421
	422	Class boolean_parser_completeness_dataT' {data : boolean_parser_dataT} :=
	423	{ split_string_for_production_complete
	424	: split_list_completeT split_string_for_production }.
	425	End general.
	426
	427	End CorrectnessBaseTypes.
	428
	429	End Parsers.
	430
	431	End Fiat.
	432
	433	End Fiat_DOT_Parsers_DOT_CorrectnessBaseTypes.
	434
	435	Module Export Fiat.
	436	Module Export Parsers.
	437	Module Export ContextFreeGrammar.
	438	Module Export Valid.
	439	Export Fiat.Parsers.StringLike.Core.
	440
	441	Section cfg.
	442	Context {Char : Type} {HSL : StringLike Char} (G : grammar Char)
	443	{predata : parser_computational_predataT}.
	444
	445	Definition item_valid (it : item Char)
	446	:= match it with
	447	\| Terminal _ => True
	448	\| NonTerminal nt' => is_true (is_valid_nonterminal initial_nonterminals_data (of_nonterminal nt'))
	449	end.
	450
	451	Definition production_valid pat
	452	:= List.Forall item_valid pat.
	453
	454	Definition productions_valid pats
	455	:= List.Forall production_valid pats.
	456
	457	Definition grammar_valid
	458	:= forall nt,
	459	List.In nt (Valid_nonterminals G)
	460	-> productions_valid (Lookup G nt).
	461	End cfg.
	462
	463	End Valid.
	464
	465	Section app.
	466	Context {Char : Type} {HSL : StringLike Char} (G : grammar Char)
	467	{predata : parser_computational_predataT}.
	468
	469	Lemma hd_production_valid
	470	(it : item Char)
	471	(its : production Char)
	472	(H : production_valid (it :: its))
	473	: item_valid it.
	474	admit.
	475	Defined.
	476
	477	Lemma production_valid_cons
	478	(it : item Char)
	479	(its : production Char)
	480	(H : production_valid (it :: its))
	481	: production_valid its.
	482	admit.
	483	Defined.
	484
	485	End app.
	486
	487	Import Coq.Lists.List.
	488	Import Coq.omega.Omega.
	489	Import Fiat_DOT_Common.Fiat.Common.
	490	Import Fiat.Parsers.ContextFreeGrammar.Valid.
	491	Local Open Scope string_like_scope.
	492
	493	Section recursive_descent_parser.
	494	Context {Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} (G : grammar Char).
	495	Context {data : @boolean_parser_dataT Char _}
	496	{cdata : @boolean_parser_completeness_dataT' Char _ G data}
	497	{rdata : @parser_removal_dataT' _ G _}
	498	{gvalid : grammar_valid G}.
	499
	500	Local Notation dec T := (T + (T -> False))%type (only parsing).
	501
	502	Local Notation iffT x y := ((x -> y) * (y -> x))%type (only parsing).
	503
	504	Lemma dec_prod {A B} (HA : dec A) (HB : dec B) : dec (A * B).
	505	admit.
	506	Defined.
	507
	508	Lemma dec_In {A} {P : A -> Type} (HA : forall a, dec (P a)) ls
	509	: dec { a : _ & (In a ls * P a) }.
	510	admit.
	511	Defined.
	512
	513	Section item.
	514	Context {len0 valid}
	515	(str : String)
	516	(str_matches_nonterminal'
	517	: nonterminal_carrierT -> bool)
	518	(str_matches_nonterminal
	519	: forall nt : nonterminal_carrierT,
	520	dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))).
	521
	522	Section valid.
	523	Context (Hmatches
	524	: forall nt,
	525	is_valid_nonterminal initial_nonterminals_data nt
	526	-> str_matches_nonterminal nt = str_matches_nonterminal' nt :> bool)
	527	(it : item Char)
	528	(Hvalid : item_valid it).
	529
	530	Definition parse_item'
	531	: dec (minimal_parse_of_item (G := G) len0 valid str it).
	532	Proof.
	533	clear Hvalid.
	534	refine (match it return dec (minimal_parse_of_item len0 valid str it) with
	535	\| Terminal ch => if Sumbool.sumbool_of_bool (str ~= [ ch ])
	536	then inl (MinParseTerminal _ _ _ _ _)
	537	else inr (fun _ => !)
	538	\| NonTerminal nt => if str_matches_nonterminal (of_nonterminal nt)
	539	then inl (MinParseNonTerminal _)
	540	else inr (fun _ => !)
	541	end);
	542	clear str_matches_nonterminal Hmatches;
	543	admit.
	544	Defined.
	545	End valid.
	546
	547	End item.
	548	Context {len0 valid}
	549	(parse_nonterminal
	550	: forall (str : String) (len : nat) (Hlen : length str = len) (pf : len <= len0) (nt : nonterminal_carrierT),
	551	dec (minimal_parse_of_nonterminal (G := G) len0 valid str (to_nonterminal nt))).
	552
	553	Lemma dec_in_helper {ls it its str}
	554	: iffT {n0 : nat &
	555	(In (min (length str) n0) (map (min (length str)) ls) *
	556	minimal_parse_of_item (G := G) len0 valid (take n0 str) it *
	557	minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type}
	558	{n0 : nat &
	559	(In n0 ls *
	560	(minimal_parse_of_item (G := G) len0 valid (take n0 str) it *
	561	minimal_parse_of_production (G := G) len0 valid (drop n0 str) its))%type}.
	562	admit.
	563	Defined.
	564
	565	Lemma parse_production'_helper {str it its} (pf : length str <= len0)
	566	: dec {n0 : nat &
	567	(minimal_parse_of_item (G := G) len0 valid (take n0 str) it *
	568	minimal_parse_of_production (G := G) len0 valid (drop n0 str) its)%type}
	569	-> dec (minimal_parse_of_production (G := G) len0 valid str (it :: its)).
	570	admit.
	571	Defined.
	572	Local Ltac t_parse_production_for := repeat
	573	match goal with
	574	\| [ H : (beq_nat _ _) = true \|- _ ] => apply EqNat.beq_nat_true in H
	575	\| _ => progress subst
	576	\| _ => solve [ constructor; assumption ]
	577	\| [ H : minimal_parse_of_production _ _ _ nil \|- _ ] => (inversion H; clear H)
	578	\| [ H : minimal_parse_of_production _ _ _ (_::_) \|- _ ] => (inversion H; clear H)
	579	\| [ H : ?x = 0, H' : context[?x] \|- _ ] => rewrite H in H'
	580	\| _ => progress simpl in *
	581	\| _ => discriminate
	582	\| [ H : forall x, (_ * _)%type -> _ \|- _ ] => specialize (fun x y z => H x (y, z))
	583	\| _ => solve [ eauto with nocore ]
	584	\| _ => solve [ apply Min.min_case_strong; omega ]
	585	\| _ => omega
	586	\| [ H : production_valid (_::_) \|- _ ]
	587	=> let H' := fresh in
	588	pose proof H as H';
	589	apply production_valid_cons in H;
	590	apply hd_production_valid in H'
	591	end.
	592
	593	Definition parse_production'_for
	594	(splits : item Char -> production Char -> String -> list nat)
	595	(Hsplits : forall str it its (Hreachable : production_is_reachableT G (it::its)) pf', split_list_completeT_for (len0 := len0) (G := G) (valid := valid) it its str pf' (splits it its str))
	596	(str : String)
	597	(len : nat)
	598	(Hlen : length str = len)
	599	(pf : len <= len0)
	600	(prod : production Char)
	601	(Hreachable : production_is_reachableT G prod)
	602	: dec (minimal_parse_of_production (G := G) len0 valid str prod).
	603	Proof.
	604	revert prod Hreachable str len Hlen pf.
	605	refine
	606	((fun pf_helper =>
	607	list_rect
	608	(fun prod =>
	609	forall (Hreachable : production_is_reachableT G prod)
	610	(str : String)
	611	(len : nat)
	612	(Hlen : length str = len)
	613	(pf : len <= len0),
	614	dec (minimal_parse_of_production (G := G) len0 valid str prod))
	615	(
	616	fun Hreachable str len Hlen pf
	617	=> match Utils.dec (beq_nat len 0) with
	618	\| left H => inl _
	619	\| right H => inr (fun p => _)
	620	end)
	621	(fun it its parse_production' Hreachable str len Hlen pf
	622	=> parse_production'_helper
	623	_
	624	(let parse_item := (fun n pf => parse_item' (parse_nonterminal (take n str) (len := min n len) (eq_trans take_length (f_equal (min _) Hlen)) pf) it) in
	625	let parse_item := (fun n => parse_item n (Min.min_case_strong n len (fun k => k <= len0) (fun Hlen => (Nat.le_trans _ _ _ Hlen pf)) (fun Hlen => pf))) in
	626	let parse_production := (fun n => parse_production' (pf_helper it its Hreachable) (drop n str) (len - n) (eq_trans (drop_length _ _) (f_equal (fun x => x - _) Hlen)) (Nat.le_trans _ _ _ (Nat.le_sub_l _ _) pf)) in
	627	match dec_In
	628	(fun n => dec_prod (parse_item n) (parse_production n))
	629	(splits it its str)
	630	with
	631	\| inl p => inl (existT _ (projT1 p) (snd (projT2 p)))
	632	\| inr p
	633	=> let pf' := (Nat.le_trans _ _ _ (Nat.eq_le_incl _ _ Hlen) pf) in
	634	let H := (_ : split_list_completeT_for (G := G) (len0 := len0) (valid := valid) it its str pf' (splits it its str)) in
	635	inr (fun p' => p (fst dec_in_helper (H p')))
	636	end)
	637	)) _);
	638	[ clear parse_nonterminal Hsplits splits rdata cdata
	639	\| clear parse_nonterminal Hsplits splits rdata cdata
	640	\| ..
	641	\| admit ].
	642	abstract t_parse_production_for.
	643	abstract t_parse_production_for.
	644	abstract t_parse_production_for.
	645	abstract t_parse_production_for.
	646	Defined.

+7

-0

test-suite/bugs/closed/4462.v less more

	0	Variables P Q : Prop.
	1	Axiom pqrw : P <-> Q.
	2
	3	Require Setoid.
	4
	5	Goal P -> Q.
	6	unshelve (rewrite pqrw).

+15

-0

test-suite/bugs/closed/4467.v less more

	0	(* Fixing missing test for variable shadowing *)
	1
	2	Definition test (x y:bool*bool) :=
	3	match x with
	4	\| (e as e1, (true) as e2)
	5	\| ((true) as e1, e as e2) =>
	6	let '(e, b) := y in
	7	e
	8	\| _ => true
	9	end.
	10
	11	Goal test (true,false) (true,true) = true.
	12	(* used to evaluate to "false = true" in 8.4 *)
	13	reflexivity.
	14	Qed.

+12

-0

test-suite/bugs/closed/4480.v less more

	0	Require Import Setoid.
	1
	2	Definition proj (P Q : Prop) := P.
	3
	4	Lemma foo (P : Prop) : proj P P = P.
	5	Admitted.
	6	Lemma trueI : True <-> True.
	7	Admitted.
	8	Goal True.
	9	Fail setoid_rewrite foo.
	10	Fail setoid_rewrite trueI.
	11	⏎

+10

-0

test-suite/bugs/closed/4484.v less more

	0	(* Testing 8.5 regression with type classes not solving evars
	1	redefined while trying to solve them with the type class mechanism *)
	2
	3	Class A := {}.
	4	Axiom foo : forall {ac : A}, bool.
	5	Lemma bar (ac : A) : True.
	6	Check (match foo as k return foo = k -> True with
	7	\| true => _
	8	\| false => _
	9	end eq_refl).

+1

-1

test-suite/bugs/closed/931.v less more

1	1
2	2	Goal Prop.
3	3	refine (P _ _).
4		2:instantiate (1:=0).
	4	instantiate (1:=0).
5	5	trivial.
6	6	Qed.

+1

-1

test-suite/bugs/closed/HoTT_coq_077.v less more

29	29	(p : prod A B) : P p
30	30	:= u (fst p) (snd p).
31	31
32		Notation typeof x := ($(let T := type of x in exact T)$) (only parsing).
	32	Notation typeof x := (ltac:(let T := type of x in exact T)) (only parsing).
33	33
34	34	(* Check for eta *)
35	35	Check eq_refl : typeof (@prod_rect) = typeof (@prod_rect').

+1

-1

test-suite/bugs/closed/HoTT_coq_090.v less more

83	83	Instance isequiv_path {A B : Type} (p : A = B)
84	84	: IsEquiv (transport (fun X:Type => X) p) \| 0.
85	85	Proof.
86		refine (@BuildIsEquiv _ _ _ (transport (fun X:Type => X) p^) _ _ _);
	86	unshelve refine (@BuildIsEquiv _ _ _ (transport (fun X:Type => X) p^) _ _ _);
87	87	admit.
88	88	Defined.
89	89

+1

-1

test-suite/bugs/closed/HoTT_coq_114.v less more

0		Inductive test : $(let U := type of Type in exact U)$ := t.
	0	Inductive test : ltac:(let U := type of Type in exact U) := t.

+2

-2

test-suite/bugs/opened/3248.v less more

2	2	let T := type of f in
3	3	lazymatch eval hnf in T with
4	4	\| ?T' -> _ =>
5		let ret := constr:(fun x' : T' => $(tac (f x'))$) in
	5	let ret := constr:(fun x' : T' => ltac:(tac (f x'))) in
6	6	exact ret
7	7	\| ?T' => exact f
8	8	end.

11	11	Proof.
12	12	intros A B x y.
13	13	pose (f := fun (x y : A) => conj x y).
14		pose (a := $(ret_and_left f)$).
	14	pose (a := ltac:(ret_and_left f)).
15	15	Fail unify (a x y) (conj x y).
16	16	Abort.

+1

-1

test-suite/bugs/opened/3277.v less more

3	3	evarr _.
4	4	Admitted.
5	5	Goal True.
6		Fail exact $(evarr _)$. (* Error: Cannot infer this placeholder. *)
	6	Fail exact ltac:(evarr _). (* Error: Cannot infer this placeholder. *)

+4

-4

test-suite/bugs/opened/3278.v less more

0	0	Module a.
1	1	Check let x' := _ in
2		$(exact x')$.
	2	ltac:(exact x').
3	3
4		Notation foo x := (let x' := x in $(exact x')$).
	4	Notation foo x := (let x' := x in ltac:(exact x')).
5	5
6	6	Fail Check foo _. (* Error:
7	7	Cannot infer an internal placeholder of type "Type" in environment:

11	11	End a.
12	12
13	13	Module b.
14		Notation foo x := (let x' := x in let y := ($(exact I)$ : True) in I).
	14	Notation foo x := (let x' := x in let y := (ltac:(exact I) : True) in I).
15	15	Notation bar x := (let x' := x in let y := (I : True) in I).
16	16
17		Check let x' := _ in $(exact I)$. (* let x' := ?5 in I *)
	17	Check let x' := _ in ltac:(exact I). (* let x' := ?5 in I *)
18	18	Check bar _. (* let x' := ?9 in let y := I in I *)
19	19	Fail Check foo _. (* Error:
20	20	Cannot infer an internal placeholder of type "Type" in environment:

+1

-1

test-suite/bugs/opened/3304.v less more

0		Fail Notation "( x , y , .. , z )" := $(let r := constr:(prod .. (prod x y) .. z) in r)$.
	0	Fail Notation "( x , y , .. , z )" := ltac:(let r := constr:(prod .. (prod x y) .. z) in r).
1	1	(* The command has indeed failed with message:
2	2	=> Error: Special token .. is for use in the Notation command. *)

+2

-2

test-suite/bugs/opened/3459.v less more

6	6	(* This line used to fail with a Not_found up to some point, and then
7	7	to produce an ill-typed term *)
8	8	match goal with
9		\| [ \|- context G[2] ] => let y := constr:(fun x => $(let r := constr:(@eq Set x x) in
	9	\| [ \|- context G[2] ] => let y := constr:(fun x => ltac:(let r := constr:(@eq Set x x) in
10	10	clear x;
11		exact r)$) in
	11	exact r)) in
12	12	pose y
13	13	end.
14	14	(* Add extra test for typability (should not fail when bug closed) *)

+0

-1

~~test-suite/bugs/opened/3554.v~~ less more

0

Fail Example foo (f : forall {_ : Type}, Type) : Type.

+0

-22

~~test-suite/bugs/opened/3848.v~~ less more

0		Require Import TestSuite.admit.
1		Axiom transport : forall {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x), P y.
2		Notation "p # x" := (transport _ p x) (right associativity, at level 65, only parsing).
3		Definition Sect {A B : Type} (s : A -> B) (r : B -> A) := forall x : A, r (s x) = x.
4		Class IsEquiv {A B} (f : A -> B) := { equiv_inv : B -> A ; eisretr : Sect equiv_inv f }.
5		Arguments eisretr {A B} f {_} _.
6		Notation "f ^-1" := (@equiv_inv _ _ f _) (at level 3, format "f '^-1'").
7		Generalizable Variables A B f g e n.
8		Definition functor_forall `{P : A -> Type} `{Q : B -> Type}
9		(f0 : B -> A) (f1 : forall b:B, P (f0 b) -> Q b)
10		: (forall a:A, P a) -> (forall b:B, Q b).
11		admit.
12		Defined.
13
14		Lemma isequiv_functor_forall `{P : A -> Type} `{Q : B -> Type}
15		`{IsEquiv B A f} `{forall b, @IsEquiv (P (f b)) (Q b) (g b)}
16		: (forall b : B, Q b) -> forall a : A, P a.
17		Proof.
18		refine (functor_forall
19		(f^-1)
20		(fun (x:A) (y:Q (f^-1 x)) => eisretr f x # (g (f^-1 x))^-1 y)).
21		Fail Defined. (* Error: Attempt to save an incomplete proof *)

+14

-0

test-suite/complexity/f_equal.v less more

	0	(* Checks that f_equal does not reduce the term uselessly *)
	1	(* Expected time < 1.00s *)
	2
	3	Fixpoint stupid (n : nat) : unit :=
	4	match n with
	5	\| 0 => tt
	6	\| S n =>
	7	let () := stupid n in
	8	let () := stupid n in
	9	tt
	10	end.
	11
	12	Goal stupid 23 = stupid 23.
	13	Timeout 5 Time f_equal.

+1

-1

test-suite/failure/Tauto.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/failure/clash_cons.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/failure/fixpoint1.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/failure/guard.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/failure/illtype1.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/failure/positivity.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/failure/redef.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/failure/search.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/ideal-features/Apply.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+0

-145

~~test-suite/kernel/vm-univ.v~~ less more

0		(* Basic tests *)
1		Polymorphic Definition pid {T : Type} (x : T) : T := x.
2		(*
3		Definition _1 : pid true = true :=
4		@eq_refl _ true <: pid true = true.
5
6		Polymorphic Definition a_type := Type.
7
8		Definition _2 : a_type@{i} = Type@{i} :=
9		@eq_refl _ Type@{i} <: a_type@{i} = Type@{i}.
10
11		Polymorphic Definition FORALL (T : Type) (P : T -> Prop) : Prop :=
12		forall x : T, P x.
13
14		Polymorphic Axiom todo : forall {T:Type}, T -> T.
15
16		Polymorphic Definition todo' (T : Type) := @todo T.
17
18		Definition _3 : @todo'@{Set} = @todo@{Set} :=
19		@eq_refl _ (@todo@{Set}) <: @todo'@{Set} = @todo@{Set}.
20		*)
21
22		(* Inductive Types *)
23		Inductive sumbool (A B : Prop) : Set :=
24		\| left : A -> sumbool A B
25		\| right : B -> sumbool A B.
26
27		Definition x : sumbool True False := left _ _ I.
28
29		Definition sumbool_copy {A B : Prop} (H : sumbool A B) : sumbool A B :=
30		match H with
31		\| left _ _ x => left _ _ x
32		\| right _ _ x => right _ _ x
33		end.
34
35		Definition _4 : sumbool_copy x = x :=
36		@eq_refl _ x <: sumbool_copy x = x.
37
38		(* Polymorphic Inductive Types *)
39		Polymorphic Inductive poption (T : Type@{i}) : Type@{i} :=
40		\| PSome : T -> poption@{i} T
41		\| PNone : poption@{i} T.
42
43		Polymorphic Definition poption_default {T : Type@{i}} (p : poption@{i} T) (x : T) : T :=
44		match p with
45		\| @PSome _ y => y
46		\| @PNone _ => x
47		end.
48
49		Polymorphic Inductive plist (T : Type@{i}) : Type@{i} :=
50		\| pnil
51		\| pcons : T -> plist@{i} T -> plist@{i} T.
52
53		Arguments pnil {_}.
54		Arguments pcons {_} _ _.
55
56		Section pmap.
57		Context {T : Type@{i}} {U : Type@{j}} (f : T -> U).
58
59		Polymorphic Fixpoint pmap (ls : plist@{i} T) : plist@{j} U :=
60		match ls with
61		\| @pnil _ => @pnil _
62		\| @pcons _ l ls => @pcons@{j} U (f l) (pmap@{i j} ls)
63		end.
64		End pmap.
65
66		Universe Ubool.
67		Inductive tbool : Type@{Ubool} := ttrue \| tfalse.
68
69
70		Eval vm_compute in pmap pid (pcons true (pcons false pnil)).
71		Eval vm_compute in pmap (fun x => match x with
72		\| pnil => true
73		\| pcons _ _ => false
74		end) (pcons pnil (pcons (pcons false pnil) pnil)).
75		Eval vm_compute in pmap (fun x => x -> Type) (pcons tbool (pcons (plist tbool) pnil)).
76
77		Polymorphic Inductive Tree (T : Type@{i}) : Type@{i} :=
78		\| Empty
79		\| Branch : plist@{i} (Tree@{i} T) -> Tree@{i} T.
80
81		Section pfold.
82		Context {T : Type@{i}} {U : Type@{u}} (f : T -> U -> U).
83
84		Polymorphic Fixpoint pfold (acc : U) (ls : plist@{i} T) : U :=
85		match ls with
86		\| pnil => acc
87		\| pcons a b => pfold (f a acc) b
88		end.
89		End pfold.
90
91		Polymorphic Inductive nat : Type@{i} :=
92		\| O
93		\| S : nat -> nat.
94
95		Fixpoint nat_max (a b : nat) : nat :=
96		match a , b with
97		\| O , b => b
98		\| a , O => a
99		\| S a , S b => S (nat_max a b)
100		end.
101
102		Polymorphic Fixpoint height {T : Type@{i}} (t : Tree@{i} T) : nat :=
103		match t with
104		\| Empty _ => O
105		\| Branch _ ls => S (pfold nat_max O (pmap height ls))
106		end.
107
108		Polymorphic Fixpoint repeat {T : Type@{i}} (n : nat) (v : T) : plist@{i} T :=
109		match n with
110		\| O => pnil
111		\| S n => pcons v (repeat n v)
112		end.
113
114		Polymorphic Fixpoint big_tree (n : nat) : Tree@{i} nat :=
115		match n with
116		\| O => @Empty nat
117		\| S n' => Branch _ (repeat n' (big_tree n'))
118		end.
119
120		Eval compute in height (big_tree (S (S (S O)))).
121
122		Let big := S (S (S (S (S O)))).
123		Polymorphic Definition really_big := (S@{i} (S (S (S (S (S (S (S (S (S O)))))))))).
124
125		Time Definition _5 : height (@Empty nat) = O :=
126		@eq_refl nat O <: height (@Empty nat) = O.
127
128		Time Definition _6 : height@{Set} (@Branch nat pnil) = S O :=
129		@eq_refl nat@{Set} (S@{Set} O@{Set}) <: height@{Set} (@Branch nat pnil) = S O.
130
131		Time Definition _7 : height (big_tree big) = big :=
132		@eq_refl nat big <: height (big_tree big) = big.
133
134		Time Definition _8 : height (big_tree really_big) = really_big :=
135		@eq_refl nat@{Set} (S@{Set}
136		(S@{Set}
137		(S@{Set}
138		(S@{Set}
139		(S@{Set}
140		(S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} O@{Set}))))))))))
141		<:
142		@eq nat@{Set}
143		(@height nat@{Set} (big_tree really_big@{Set}))
144		really_big@{Set}.

+1

-1

test-suite/misc/berardi_test.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

test-suite/output/Existentials.out less more

0	0	Existential 1 =
1		?Goal0 : [p : nat q := S p : nat n : nat m : nat \|- ?y = m]
	1	?Goal1 : [p : nat q := S p : nat n : nat m : nat \|- ?y = m]
2	2	Existential 2 =
3	3	?y : [p : nat q := S p : nat n : nat m : nat \|- nat] (p, q cannot be used)
4		Existential 3 = ?e : [q : nat n : nat m : nat \|- n = ?y]
	4	Existential 3 = ?Goal0 : [q : nat n : nat m : nat \|- n = ?y]

+1

-1

test-suite/output/Extraction_matchs_2413.out less more

3	3	b
4	4	( val test2 : bool -> bool )
5	5
6		let test2 b =
	6	let test2 _ =
7	7	False
8	8	( val wrong_id : 'a1 hole -> 'a2 hole )
9	9

+44

-0

test-suite/success/Case22.v less more

16	16	match x with
17	17	C' => true
18	18	end.
	19
	20	(* Bug found in november 2015: was wrongly failing in 8.5beta2 and 8.5beta3 *)
	21
	22	Inductive I2 (A:Type) : let B:=A in forall C, let D:=(C*B)%type in Type :=
	23	E2 : I2 A nat.
	24
	25	Check fun x:I2 nat nat => match x in I2 _ X Y Z return XYZ with
	26	E2 _ => (0,0,(0,0))
	27	end.
	28
	29	(* This used to succeed in 8.3, 8.4 and 8.5beta1 *)
	30
	31	Inductive IND : forall X:Type, let Y:=X in Type :=
	32	CONSTR : IND True.
	33
	34	Definition F (x:IND True) (A:Type) :=
	35	(* This failed in 8.5beta2 though it should have been accepted *)
	36	match x in IND X Y return Y with
	37	CONSTR => Logic.I
	38	end.
	39
	40	Theorem paradox : False.
	41	(* This succeeded in 8.3, 8.4 and 8.5beta1 because F had wrong type *)
	42	Fail Proof (F C False).
	43
	44	(* Another bug found in November 2015 (a substitution was wrongly
	45	reversed at pretyping level) *)
	46
	47	Inductive Ind (A:Type) :
	48	let X:=A in forall Y:Type, let Z:=(X*Y)%type in Type :=
	49	Constr : Ind A nat.
	50
	51	Check fun x:Ind bool nat =>
	52	match x in Ind _ X Y Z return Z with
	53	\| Constr _ => (true,0)
	54	end.
	55
	56	(* A vm_compute bug (the type of constructors was not supposed to
	57	contain local definitions before proper parameters) *)
	58
	59	Inductive Ind2 (b:=1) (c:nat) : Type :=
	60	Constr2 : Ind2 c.
	61
	62	Eval vm_compute in Constr2 2.

+7

-0

test-suite/success/Cases.v less more

1860	1860
1861	1861	Definition transport {A} (P : A->Type) {x y : A} (p : x=y) (u : P x) : P y :=
1862	1862	match p with eq_refl => u end.
	1863
	1864	(* Check in-pattern clauses with constant constructors, which were
	1865	previously interpreted as variables (before 8.5) *)
	1866
	1867	Check match eq_refl 0 in _=O return O=O with eq_refl => eq_refl end.
	1868
	1869	Check match niln in listn O return O=O with niln => eq_refl end.

+1

-1

test-suite/success/Check.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/success/Field.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+6

-0

test-suite/success/Notations.v less more

100	100
101	101	Parameter traverse : (nat -> unit) -> (nat -> unit).
102	102	Notation traverse_var f l := (traverse (fun l => f l) l).
	103
	104	(* Check that when an ident become a keyword, it does not break
	105	previous rules relying on the string to be classified as an ident *)
	106
	107	Notation "'intros' x" := (S x) (at level 0).
	108	Goal True -> True. intros H. exact H. Qed.

+1

-1

test-suite/success/Tauto.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/success/TestRefine.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-1

test-suite/success/destruct.v less more

96	96
97	97	Goal exists x, S x = S 0.
98	98	eexists.
	99	Show x. (* Incidentally test Show on a named goal *)
99	100	destruct (S _). (* Incompatible occurrences but takes the first one since Oct 2014 *)
100	101	change (0 = S 0).
101	102	Abort.

104	105	eexists.
105	106	destruct (S _). (* Incompatible occurrences but takes the first one since Oct 2014 *)
106	107	change (0 = S ?x).
	108	[x]: exact 0. (* Incidentally test applying a tactic to a goal on the shelve *)
107	109	Abort.
108	110
109	111	Goal exists n p:nat, (S n,S n) = (S p,S p) /\ p = n.

386	388
387	389	Goal forall b:bool, True.
388	390	intro b.
389		destruct !b.
	391	destruct (b).
390	392	clear b. (* b has to be here *)
391	393	Abort.
392	394

+1

-1

test-suite/success/eauto.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/success/eqdecide.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/success/extraction.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+82

-0

test-suite/success/extraction_impl.v less more

	0
	1	(** Examples of extraction with manually-declared implicit arguments *)
	2
	3	(** NB: we should someday check the produced code instead of
	4	simply running the commands. *)
	5
	6	(** Bug #4243, part 1 *)
	7
	8	Inductive dnat : nat -> Type :=
	9	\| d0 : dnat 0
	10	\| ds : forall n m, n = m -> dnat n -> dnat (S n).
	11
	12	Extraction Implicit ds [m].
	13
	14	Lemma dnat_nat: forall n, dnat n -> nat.
	15	Proof.
	16	intros n d.
	17	induction d as [\| n m Heq d IHn].
	18	exact 0. exact (S IHn).
	19	Defined.
	20
	21	Recursive Extraction dnat_nat.
	22
	23	Extraction Implicit dnat_nat [n].
	24	Recursive Extraction dnat_nat.
	25
	26	(** Same, with a Fixpoint *)
	27
	28	Fixpoint dnat_nat' n (d:dnat n) :=
	29	match d with
	30	\| d0 => 0
	31	\| ds n m _ d => S (dnat_nat' n d)
	32	end.
	33
	34	Recursive Extraction dnat_nat'.
	35
	36	Extraction Implicit dnat_nat' [n].
	37	Recursive Extraction dnat_nat'.
	38
	39	(** Bug #4243, part 2 *)
	40
	41	Inductive enat: nat -> Type :=
	42	e0: enat 0
	43	\| es: forall n, enat n -> enat (S n).
	44
	45	Lemma enat_nat: forall n, enat n -> nat.
	46	Proof.
	47	intros n e.
	48	induction e as [\| n e IHe].
	49	exact (O).
	50	exact (S IHe).
	51	Defined.
	52
	53	Extraction Implicit es [n].
	54	Extraction Implicit enat_nat [n].
	55	Recursive Extraction enat_nat.
	56
	57	(** Same, with a Fixpoint *)
	58
	59	Fixpoint enat_nat' n (e:enat n) : nat :=
	60	match e with
	61	\| e0 => 0
	62	\| es n e => S (enat_nat' n e)
	63	end.
	64
	65	Extraction Implicit enat_nat' [n].
	66	Recursive Extraction enat_nat'.
	67
	68	(** Bug #4228 *)
	69
	70	Module Food.
	71	Inductive Course :=
	72	\| main: nat -> Course
	73	\| dessert: nat -> Course.
	74
	75	Inductive Meal : Course -> Type :=
	76	\| one_course : forall n:nat, Meal (main n)
	77	\| two_course : forall n m, Meal (main n) -> Meal (dessert m).
	78	Extraction Implicit two_course [n].
	79	End Food.
	80
	81	Recursive Extraction Food.Meal.

+1

-1

test-suite/success/inds_type_sec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

test-suite/success/induct.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+23

-8

test-suite/success/intros.v less more

33	33	exact H.
34	34	Qed.
35	35
36		(* A short test about introduction pattern pat/c *)
	36	(* A short test about introduction pattern pat%c *)
37	37	Goal (True -> 0=0) -> True /\ False -> 0=0.
38		intros H (H1/H,_).
	38	intros H (H1%H,_).
39	39	exact H1.
40	40	Qed.
41	41
42	42	(* A test about bugs in 8.5beta2 *)
43	43	Goal (True -> 0=0) -> True /\ False -> False -> 0=0.
44	44	intros H H0 H1.
45		destruct H0 as (a/H,_).
	45	destruct H0 as (a%H,_).
46	46	(* Check that H0 is removed (was bugged in 8.5beta2) *)
47	47	Fail clear H0.
48		(* Check position of newly created hypotheses when using pat/c (was
	48	(* Check position of newly created hypotheses when using pat%c (was
49	49	left at top in 8.5beta2) *)
50	50	match goal with H:_ \|- _ => clear H end. (* clear H1:False *)
51	51	match goal with H:_ \|- _ => exact H end. (* check that next hyp shows 0=0 *)
52	52	Qed.
53	53
54	54	Goal (True -> 0=0) -> True -> 0=0.
55		intros H H1/H.
	55	intros H H1%H.
56	56	exact H1.
57	57	Qed.
58	58
59	59	Goal forall n, n = S n -> 0=0.
60		intros n H/n_Sn.
	60	intros n H%n_Sn.
61	61	destruct H.
62	62	Qed.
63	63
64	64	(* Another check about generated names and cleared hypotheses with
65		pat/c patterns *)
	65	pat%c patterns *)
66	66	Goal (True -> 0=0 /\ 1=1) -> True -> 0=0.
67		intros H (H1,?)/H.
	67	intros H (H1,?)%H.
68	68	change (1=1) in H0.
69	69	exact H1.
70	70	Qed.
	71
	72	(* Checking iterated pat%c1...%cn introduction patterns and side conditions *)
	73
	74	Goal forall A B C D:Prop, (A -> B -> C) -> (C -> D) -> B -> A -> D.
	75	intros * H H0 H1.
	76	intros H2%H%H0.
	77	- exact H2.
	78	- exact H1.
	79	Qed.
	80
	81	(* Bug found by Enrico *)
	82
	83	Goal forall x : nat, True.
	84	intros y%(fun x => x).
	85	Abort.

+37

-0

test-suite/success/keyedrewrite.v less more

21	21
22	22	Print Equivalent Keys.
23	23	End foo.
	24
	25	Require Import Arith List Omega.
	26
	27	Definition G {A} (f : A -> A -> A) (x : A) := f x x.
	28
	29	Lemma list_foo A (l : list A) : G (@app A) (l ++ nil) = G (@app A) l.
	30	Proof. unfold G; rewrite app_nil_r; reflexivity. Qed.
	31
	32	(* Bundled version of a magma *)
	33	Structure magma := Magma { b_car :> Type; op : b_car -> b_car -> b_car }.
	34	Arguments op {_} _ _.
	35
	36	(* Instance for lists *)
	37	Canonical Structure list_magma A := Magma (list A) (@app A).
	38
	39	(* Basically like list_foo, but now uses the op projection instead of app for
	40	the argument of G *)
	41	Lemma test1 A (l : list A) : G op (l ++ nil) = G op l.
	42
	43	(* Ensure that conversion of terms with evars is allowed once a keyed candidate unifier is found *)
	44	rewrite -> list_foo.
	45	reflexivity.
	46	Qed.
	47
	48	(* Basically like list_foo, but now uses the op projection for everything *)
	49	Lemma test2 A (l : list A) : G op (op l nil) = G op l.
	50	Proof.
	51	rewrite ->list_foo.
	52	reflexivity.
	53	Qed.
	54
	55	Require Import Bool.
	56	Set Keyed Unification.
	57
	58	Lemma test b : b && true = b.
	59	Fail rewrite andb_true_l.
	60	Admitted.⏎

+1

-1

test-suite/success/mutual_ind.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

test-suite/success/polymorphism.v less more

241	241	Fail Check (Set : Set).
242	242	Check (Set : Type).
243	243	Check (Prop : Type).
244		Definition setType := $(let t := type of Set in exact t)$.
	244	Definition setType := ltac:(let t := type of Set in exact t).
245	245
246	246	Definition foo (A : Prop) := A.
247	247

302	302	Axiom admit : forall A, A.
303	303	Record R := {O : Type}.
304	304
305		Definition RL (x : R@{i}) : $(let u := constr:(Type@{i}:Type@{j}) in exact (R@{j}) )$ := {\|O := @O x\|}.
	305	Definition RL (x : R@{i}) : ltac:(let u := constr:(Type@{i}:Type@{j}) in exact (R@{j}) ) := {\|O := @O x\|}.
306	306	Definition RLRL : forall x : R, RL x = RL (RL x) := fun x => eq_refl.
307	307	Definition RLRL' : forall x : R, RL x = RL (RL x).
308	308	intros. apply eq_refl.

+14

-1

test-suite/success/primitiveproj.v less more

193	193	Definition term (x : wrap nat) := x.(unwrap).
194	194	Definition term' (x : wrap nat) := let f := (@unwrap2 nat) in f x.
195	195	Recursive Extraction term term'.
196		(Unset Printing Primitive Projection Parameters.)⏎
	196	(Unset Printing Primitive Projection Parameters.)
	197
	198	(* Primitive projections in the presence of let-ins (was not failing in beta3)*)
	199
	200	Set Primitive Projections.
	201	Record s (x:nat) (y:=S x) := {c:=x; d:x=c}.
	202	Lemma f : 0=1.
	203	Proof.
	204	Fail apply d.
	205	(*
	206	split.
	207	reflexivity.
	208	Qed.
	209	*)

+2

-1

test-suite/success/proof_using.v less more

177	177
178	178	Check (test_let 3).
179	179
	180	(* Disabled
180	181	Section Clear.
181	182
182	183	Variable a: nat.

191	192	Qed.
192	193
193	194	End Clear.
	195	*)
194	196
195	197
196

+1

-1

test-suite/success/refine.v less more

61	61	Goal (forall n : nat, n = 0 -> Prop) -> Prop.
62	62	intro P.
63	63	refine (P _ _).
64		2:reflexivity.
	64	reflexivity.
65	65	Abort.
66	66
67	67	(* Submitted by Jacek Chrzaszcz (bug #1102) *)

+1

-1

test-suite/success/unfold.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+11

-0

test-suite/success/unshelve.v less more

	0	Axiom F : forall (b : bool), b = true ->
	1	forall (i : unit), i = i -> True.
	2
	3	Goal True.
	4	Proof.
	5	unshelve (refine (F _ _ _ _)).
	6	+ exact true.
	7	+ exact tt.
	8	+ exact (@eq_refl bool true).
	9	+ exact (@eq_refl unit tt).
	10	Qed.

+141

-0

test-suite/success/vm_univ_poly.v less more

	0	(* Basic tests *)
	1	Polymorphic Definition pid {T : Type} (x : T) : T := x.
	2	(*
	3	Definition _1 : pid true = true :=
	4	@eq_refl _ true <: pid true = true.
	5
	6	Polymorphic Definition a_type := Type.
	7
	8	Definition _2 : a_type@{i} = Type@{i} :=
	9	@eq_refl _ Type@{i} <: a_type@{i} = Type@{i}.
	10
	11	Polymorphic Definition FORALL (T : Type) (P : T -> Prop) : Prop :=
	12	forall x : T, P x.
	13
	14	Polymorphic Axiom todo : forall {T:Type}, T -> T.
	15
	16	Polymorphic Definition todo' (T : Type) := @todo T.
	17
	18	Definition _3 : @todo'@{Set} = @todo@{Set} :=
	19	@eq_refl _ (@todo@{Set}) <: @todo'@{Set} = @todo@{Set}.
	20	*)
	21
	22	(* Inductive Types *)
	23	Inductive sumbool (A B : Prop) : Set :=
	24	\| left : A -> sumbool A B
	25	\| right : B -> sumbool A B.
	26
	27	Definition x : sumbool True False := left _ _ I.
	28
	29	Definition sumbool_copy {A B : Prop} (H : sumbool A B) : sumbool A B :=
	30	match H with
	31	\| left _ _ x => left _ _ x
	32	\| right _ _ x => right _ _ x
	33	end.
	34
	35	Definition _4 : sumbool_copy x = x :=
	36	@eq_refl _ x <: sumbool_copy x = x.
	37
	38	(* Polymorphic Inductive Types *)
	39	Polymorphic Inductive poption@{i} (T : Type@{i}) : Type@{i} :=
	40	\| PSome : T -> poption@{i} T
	41	\| PNone : poption@{i} T.
	42
	43	Polymorphic Definition poption_default@{i} {T : Type@{i}} (p : poption@{i} T) (x : T) : T :=
	44	match p with
	45	\| @PSome _ y => y
	46	\| @PNone _ => x
	47	end.
	48
	49	Polymorphic Inductive plist@{i} (T : Type@{i}) : Type@{i} :=
	50	\| pnil
	51	\| pcons : T -> plist@{i} T -> plist@{i} T.
	52
	53	Arguments pnil {_}.
	54	Arguments pcons {_} _ _.
	55
	56	Polymorphic Definition pmap@{i j}
	57	{T : Type@{i}} {U : Type@{j}} (f : T -> U) :=
	58	fix pmap (ls : plist@{i} T) : plist@{j} U :=
	59	match ls with
	60	\| @pnil _ => @pnil _
	61	\| @pcons _ l ls => @pcons@{j} U (f l) (pmap@{i j} ls)
	62	end.
	63
	64	Universe Ubool.
	65	Inductive tbool : Type@{Ubool} := ttrue \| tfalse.
	66
	67
	68	Eval vm_compute in pmap pid (pcons true (pcons false pnil)).
	69	Eval vm_compute in pmap (fun x => match x with
	70	\| pnil => true
	71	\| pcons _ _ => false
	72	end) (pcons pnil (pcons (pcons false pnil) pnil)).
	73	Eval vm_compute in pmap (fun x => x -> Type) (pcons tbool (pcons (plist tbool) pnil)).
	74
	75	Polymorphic Inductive Tree@{i} (T : Type@{i}) : Type@{i} :=
	76	\| Empty
	77	\| Branch : plist@{i} (Tree@{i} T) -> Tree@{i} T.
	78
	79	Polymorphic Definition pfold@{i u}
	80	{T : Type@{i}} {U : Type@{u}} (f : T -> U -> U) :=
	81	fix pfold (acc : U) (ls : plist@{i} T) : U :=
	82	match ls with
	83	\| pnil => acc
	84	\| pcons a b => pfold (f a acc) b
	85	end.
	86
	87	Polymorphic Inductive nat@{i} : Type@{i} :=
	88	\| O
	89	\| S : nat -> nat.
	90
	91	Polymorphic Fixpoint nat_max@{i} (a b : nat@{i}) : nat@{i} :=
	92	match a , b with
	93	\| O , b => b
	94	\| a , O => a
	95	\| S a , S b => S (nat_max a b)
	96	end.
	97
	98	Polymorphic Fixpoint height@{i} {T : Type@{i}} (t : Tree@{i} T) : nat@{i} :=
	99	match t return nat@{i} with
	100	\| Empty _ => O
	101	\| Branch _ ls => S@{i} (pfold@{i i} nat_max O (pmap height ls))
	102	end.
	103
	104	Polymorphic Fixpoint repeat@{i} {T : Type@{i}} (n : nat@{i}) (v : T) : plist@{i} T :=
	105	match n return plist@{i} T with
	106	\| O => pnil
	107	\| S n => pcons@{i} v (repeat n v)
	108	end.
	109
	110	Polymorphic Fixpoint big_tree@{i} (n : nat@{i}) : Tree@{i} nat@{i} :=
	111	match n with
	112	\| O => @Empty nat@{i}
	113	\| S n' => Branch@{i} nat@{i} (repeat@{i} n' (big_tree@{i} n'))
	114	end.
	115
	116	Eval compute in height (big_tree (S (S (S O)))).
	117
	118	Let big := S (S (S (S (S O)))).
	119	Polymorphic Definition really_big@{i} := (S@{i} (S (S (S (S (S (S (S (S (S O)))))))))).
	120
	121	Time Definition _5 : height (@Empty nat) = O :=
	122	@eq_refl nat O <: height (@Empty nat) = O.
	123
	124	Time Definition _6 : height@{Set} (@Branch nat pnil) = S O :=
	125	@eq_refl nat@{Set} (S@{Set} O@{Set}) <: @eq nat@{Set} (height@{Set} (@Branch@{Set} nat@{Set} (@pnil@{Set} (Tree@{Set} nat@{Set})))) (S@{Set} O@{Set}).
	126
	127	Time Definition _7 : height (big_tree big) = big :=
	128	@eq_refl nat big <: height (big_tree big) = big.
	129
	130	Time Definition _8 : height (big_tree really_big) = really_big :=
	131	@eq_refl nat@{Set} (S@{Set}
	132	(S@{Set}
	133	(S@{Set}
	134	(S@{Set}
	135	(S@{Set}
	136	(S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} O@{Set}))))))))))
	137	<:
	138	@eq nat@{Set}
	139	(@height nat@{Set} (big_tree really_big@{Set}))
	140	really_big@{Set}.

+28

-0

test-suite/success/vm_univ_poly_match.v less more

	0	Set Dump Bytecode.
	1	Set Printing Universes.
	2	Set Printing All.
	3
	4	Polymorphic Class Applicative@{d c} (T : Type@{d} -> Type@{c}) :=
	5	{ pure : forall {A : Type@{d}}, A -> T A
	6	; ap : forall {A B : Type@{d}}, T (A -> B) -> T A -> T B
	7	}.
	8
	9	Universes Uo Ua.
	10
	11	Eval compute in @pure@{Uo Ua}.
	12
	13	Global Instance Applicative_option : Applicative@{Uo Ua} option :=
	14	{\| pure := @Some
	15	; ap := fun _ _ f x =>
	16	match f , x with
	17	\| Some f , Some x => Some (f x)
	18	\| _ , _ => None
	19	end
	20	\|}.
	21
	22	Definition foo := ap (ap (pure plus) (pure 1)) (pure 1).
	23
	24	Print foo.
	25
	26
	27	Eval vm_compute in foo.

+1

-1

test-suite/typeclasses/NewSetoid.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Arith.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Arith_base.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Between.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Bool_nat.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Compare.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Compare_dec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Div2.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/EqNat.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Euclid.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Even.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Factorial.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Gt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Le.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Lt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Max.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Min.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Minus.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Mult.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/PeanoNat.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Peano_dec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Arith/Wf_nat.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Bool/Bool.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Bool/BoolEq.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Bool/Bvector.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Bool/DecBool.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Bool/IfProp.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Bool/Sumbool.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Bool/Zerob.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/CEquivalence.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+3

-13

theories/Classes/CMorphisms.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

268	268	Unset Strict Universe Declaration.
269	269
270	270	(** The complement of a crelation conserves its proper elements. *)
271		Program Definition complement_proper (A : Type@{k}) (RA : crelation A)
272		`(mR : Proper (A -> A -> Prop) (RA ==> RA ==> iff) R) :
273		Proper (RA ==> RA ==> iff) (complement@{i j Prop} R) := _.
274
275		Next Obligation.
276		Proof.
277		unfold complement.
278		pose (mR x y X x0 y0 X0).
279		intuition.
280		Qed.
281	271
282	272	(** The [flip] too, actually the [flip] instance is a bit more general. *)
283	273	Program Definition flip_proper

520	510	Hint Extern 1 (subrelation (flip _) _) => class_apply @flip1 : typeclass_instances.
521	511	Hint Extern 1 (subrelation _ (flip _)) => class_apply @flip2 : typeclass_instances.
522	512
523		Hint Extern 1 (Proper _ (complement _)) => apply @complement_proper
524		: typeclass_instances.
	513	(* Hint Extern 1 (Proper _ (complement _)) => apply @complement_proper *)
	514	(* : typeclass_instances. *)
525	515	Hint Extern 1 (Proper _ (flip _)) => apply @flip_proper
526	516	: typeclass_instances.
527	517	Hint Extern 2 (@Proper _ (flip _) _) => class_apply @proper_flip_proper

+1

-1

theories/Classes/CRelationClasses.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/DecidableClass.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/EquivDec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/Equivalence.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/Init.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/Morphisms.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/Morphisms_Prop.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/Morphisms_Relations.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+5

-1

theories/Classes/RelationClasses.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

207	207	class_apply @subrelation_symmetric : typeclass_instances.
208	208
209	209	Arguments irreflexivity {A R Irreflexive} [x] _.
	210	Arguments symmetry {A} {R} {_} [x] [y] _.
	211	Arguments asymmetry {A} {R} {_} [x] [y] _ _.
	212	Arguments transitivity {A} {R} {_} [x] [y] [z] _ _.
	213	Arguments Antisymmetric A eqA {_} _.
210	214
211	215	Hint Resolve irreflexivity : ord.
212	216

+1

-1

theories/Classes/SetoidClass.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/SetoidDec.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Classes/SetoidTactics.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+15

-0

theories/Compat/AdmitAxiom.v less more

	0	(************************************************************************)
	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
	3	(* \VV/ **************************************************************)
	4	(* // * This file is distributed under the terms of the *)
	5	(* * GNU Lesser General Public License Version 2.1 *)
	6	(************************************************************************)
	7
	8	(** Compatibility file for making the admit tactic act similar to Coq v8.4. In
	9	8.4, [admit] created a new axiom; in 8.5, it just shelves the goal. This
	10	compatibility definition is not in the Coq84.v file to avoid loading an
	11	inconsistent axiom implicitly. *)
	12
	13	Axiom proof_admitted : False.
	14	Ltac admit := clear; abstract case proof_admitted.

+1

-5

theories/Compat/Coq84.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

16	16
17	17	(** See bug 3545 *)
18	18	Global Set Universal Lemma Under Conjunction.
19
20		(** In 8.4, [admit] created a new axiom; in 8.5, it just shelves the goal. *)
21		Axiom proof_admitted : False.
22		Ltac admit := clear; abstract case proof_admitted.
23	19
24	20	(** In 8.5, [refine] leaves over dependent subgoals. *)
25	21	Tactic Notation "refine" uconstr(term) := refine term; shelve_unifiable.

+1

-1

theories/Compat/Coq85.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-0

theories/Compat/vo.itarget less more

	0	AdmitAxiom.vo
0	1	Coq84.vo
1	2	Coq85.vo

+1

-1

theories/FSets/FMapFacts.v less more

2142	2142	Section Fold_properties.
2143	2143
2144	2144	(** The following lemma has already been proved on Weak Maps,
2145		but with one additionnal hypothesis (some [transpose] fact). *)
	2145	but with one additional hypothesis (some [transpose] fact). *)
2146	2146
2147	2147	Lemma fold_Equal : forall m1 m2 (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA)
2148	2148	(f:key->elt->A->A)(i:A),

+1

-1

theories/FSets/FMapPositive.v less more

1060	1060
1061	1061	End PositiveMap.
1062	1062
1063		(** Here come some additionnal facts about this implementation.
	1063	(** Here come some additional facts about this implementation.
1064	1064	Most are facts that cannot be derivable from the general interface. *)
1065	1065
1066	1066

+1

-1

theories/Init/Datatypes.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Logic.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Logic_Type.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Nat.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Notations.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Peano.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Prelude.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Specif.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Tactics.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Init/Wf.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-1

theories/Lists/List.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

969	969	Lemma in_flat_map : forall (f:A->list B)(l:list A)(y:B),
970	970	In y (flat_map f l) <-> exists x, In x l /\ In y (f x).
971	971	Proof using A B.
	972	clear Hfinjective.
972	973	induction l; simpl; split; intros.
973	974	contradiction.
974	975	destruct H as (x,(H,_)); contradiction.

+1

-1

theories/Lists/ListDec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Lists/ListSet.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Lists/ListTactics.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Lists/StreamMemo.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Lists/Streams.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Berardi.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/ChoiceFacts.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Classical.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/ClassicalChoice.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/ClassicalDescription.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/ClassicalEpsilon.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+3

-4

theories/Logic/ClassicalFacts.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

441	441	Theorem wproof_irrelevance_cc : ~~(b1 = b2).
442	442	Proof.
443	443	intros h.
444		refine (let NB := exist (fun P=>~~P -> P) B _ in _).
	444	unshelve (refine (let NB := exist (fun P=>~~P -> P) B _ in _)).
445	445	{ exact (fun _ => b1). }
446	446	pose proof (NoRetractToNegativeProp.paradox NB p2b b2p (wp2p2 h) wp2p1) as paradox.
447		refine (let F := exist (fun P=>~~P->P) False _ in _).
	447	unshelve (refine (let F := exist (fun P=>~~P->P) False _ in _)).
448	448	{ auto. }
449	449	exact (paradox F).
450	450	Qed.

657	657	exists x; intro; exact Hx.
658	658	exists x0; exact Hnot.
659	659	Qed.
660

+1

-1

theories/Logic/ClassicalUniqueChoice.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Classical_Pred_Type.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Classical_Prop.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/ConstructiveEpsilon.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Decidable.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Description.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Diaconescu.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Epsilon.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Eqdep.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/EqdepFacts.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/Eqdep_dec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/ExtensionalityFacts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/FinFun.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/FunctionalExtensionality.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+114

-86

theories/Logic/Hurkens.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

265	265
266	266	(** The [paradox] tactic can be called as a shortcut to use the paradox. *)
267	267	Ltac paradox h :=
268		refine ((fun h => _) (paradox _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ));cycle 1.
	268	unshelve (refine ((fun h => _) (paradox _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ))).
269	269
270	270	End Generic.
271	271

318	318	+ cbn. exact (fun u F => forall x:u, F x).
319	319	+ cbn. exact (fun _ _ x => x).
320	320	+ cbn. exact (fun _ _ x => x).
321		+ cbn. easy.
	321
322	322	+ cbn. exact (fun F => u22u1 (forall x, F x)).
323	323	+ cbn. exact (fun _ x => u22u1_unit _ x).
324	324	+ cbn. exact (fun _ x => u22u1_counit _ x).
325		+ cbn. intros **. now rewrite u22u1_coherent.
326	325	(** Small universe *)
327	326	+ exact U0.
328	327	(** The interpretation of the small universe is the image of
329	328	[U0] in [U1]. *)
330	329	+ cbn. exact (fun X => u02u1 X).
331	330	+ cbn. exact (fun u F => u12u0 (forall x:(u02u1 u), u02u1 (F x))).
332		+ cbn. intros * x. exact (u12u0_unit _ x).
333		+ cbn. intros * x. exact (u12u0_counit _ x).
334	331	+ cbn. exact (fun u F => u12u0 (forall x:u, u02u1 (F x))).
335		+ cbn. intros * x. exact (u12u0_unit _ x).
336		+ cbn. intros * x. exact (u12u0_counit _ x).
337	332	+ cbn. exact (u12u0 F).
338	333	+ cbn in h.
339	334	exact (u12u0_counit _ h).
	335	+ cbn. easy.
	336	+ cbn. intros **. now rewrite u22u1_coherent.
	337	+ cbn. intros * x. exact (u12u0_unit _ x).
	338	+ cbn. intros * x. exact (u12u0_counit _ x).
	339	+ cbn. intros * x. exact (u12u0_unit _ x).
	340	+ cbn. intros * x. exact (u12u0_counit _ x).
340	341	Qed.
341	342
342	343	End Paradox.
343	344
344	345	End NoRetractToImpredicativeUniverse.
345
346		(** * Prop is not a retract *)
347
348		(** The existence in the pure Calculus of Constructions of a retract
349		from [Prop] into a small type of [Prop] is inconsistent. This is a
350		special case of the previous result. *)
351
352		Module NoRetractFromSmallPropositionToProp.
353
354		Section Paradox.
355
356		( Retract of [Prop] in a small type *)
357
358		(** The retract is axiomatized using logical equivalence as the
359		equality on propositions. *)
360
361		Variable bool : Prop.
362		Variable p2b : Prop -> bool.
363		Variable b2p : bool -> Prop.
364		Hypothesis p2p1 : forall A:Prop, b2p (p2b A) -> A.
365		Hypothesis p2p2 : forall A:Prop, A -> b2p (p2b A).
366
367		( Paradox *)
368
369		Theorem paradox : forall B:Prop, B.
370		Proof.
371		intros B.
372		pose proof
373		(NoRetractToImpredicativeUniverse.paradox@{Type Prop}) as P.
374		refine (P _ _ _ _ _ _ _ _ _ _);clear P.
375		+ exact bool.
376		+ exact (fun x => forall P:Prop, (x->P)->P).
377		+ cbn. exact (fun _ x P k => k x).
378		+ cbn. intros F P x.
379		apply P.
380		intros f.
381		exact (f x).
382		+ cbn. easy.
383		+ exact b2p.
384		+ exact p2b.
385		+ exact p2p2.
386		+ exact p2p1.
387		Qed.
388
389		End Paradox.
390
391		End NoRetractFromSmallPropositionToProp.
392	346
393	347	(** * Modal fragments of [Prop] are not retracts *)
394	348

427	381
428	382	Definition Forall {A:Type} (P:A->MProp) : MProp.
429	383	Proof.
430		refine (exist _ _ _).
	384	unshelve (refine (exist _ _ _)).
431	385	+ exact (forall x:A, El (P x)).
432	386	+ intros h x.
433	387	eapply strength in h.

457	411	+ exact (fun _ => Forall).
458	412	+ cbn. exact (fun _ _ f => f).
459	413	+ cbn. exact (fun _ _ f => f).
460		+ cbn. easy.
461	414	+ exact Forall.
462	415	+ cbn. exact (fun _ f => f).
463	416	+ cbn. exact (fun _ f => f).
464		+ cbn. easy.
465	417	(** Small universe *)
466	418	+ exact bool.
467	419	+ exact (fun b => El (b2p b)).
468	420	+ cbn. exact (fun _ F => p2b (Forall (fun x => b2p (F x)))).
	421	+ exact (fun _ F => p2b (Forall (fun x => b2p (F x)))).
	422	+ apply p2b.
	423	exact B.
	424	+ cbn in h. auto.
	425	+ cbn. easy.
	426	+ cbn. easy.
469	427	+ cbn. auto.
470	428	+ cbn. intros * f.
471	429	apply p2p1 in f. cbn in f.
472	430	exact f.
473		+ exact (fun _ F => p2b (Forall (fun x => b2p (F x)))).
474	431	+ cbn. auto.
475	432	+ cbn. intros * f.
476	433	apply p2p1 in f. cbn in f.
477	434	exact f.
478		+ apply p2b.
479		exact B.
480		+ cbn in h. auto.
481	435	Qed.
482	436
483	437	End Paradox.

515	469	Theorem paradox : forall B:NProp, El B.
516	470	Proof.
517	471	intros B.
518		refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _ _ _));cycle 1.
	472	unshelve (refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _ _ _))).
519	473	+ exact (fun P => ~~P).
	474	+ exact bool.
	475	+ exact p2b.
	476	+ exact b2p.
	477	+ exact B.
	478	+ exact h.
520	479	+ cbn. auto.
521	480	+ cbn. auto.
522	481	+ cbn. auto.
	482	+ auto.
	483	+ auto.
	484	Qed.
	485
	486	End Paradox.
	487
	488	End NoRetractToNegativeProp.
	489
	490	(** * Prop is not a retract *)
	491
	492	(** The existence in the pure Calculus of Constructions of a retract
	493	from [Prop] into a small type of [Prop] is inconsistent. This is a
	494	special case of the previous result. *)
	495
	496	Module NoRetractFromSmallPropositionToProp.
	497
	498	( The universe of propositions. *)
	499
	500	Definition NProp := { P:Prop \| P -> P}.
	501	Definition El : NProp -> Prop := @proj1_sig _ _.
	502
	503	Section MParadox.
	504
	505	( Retract of [Prop] in a small type, using the identity modality. *)
	506
	507	Variable bool : NProp.
	508	Variable p2b : NProp -> El bool.
	509	Variable b2p : El bool -> NProp.
	510	Hypothesis p2p1 : forall A:NProp, El (b2p (p2b A)) -> El A.
	511	Hypothesis p2p2 : forall A:NProp, El A -> El (b2p (p2b A)).
	512
	513	( Paradox *)
	514
	515	Theorem mparadox : forall B:NProp, El B.
	516	Proof.
	517	intros B.
	518	unshelve (refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _ _ _))).
	519	+ exact (fun P => P).
523	520	+ exact bool.
524	521	+ exact p2b.
525	522	+ exact b2p.
	523	+ exact B.
	524	+ exact h.
	525	+ cbn. auto.
	526	+ cbn. auto.
	527	+ cbn. auto.
526	528	+ auto.
527	529	+ auto.
528		+ exact B.
529		+ exact h.
	530	Qed.
	531
	532	End MParadox.
	533
	534	Section Paradox.
	535
	536	( Retract of [Prop] in a small type *)
	537
	538	(** The retract is axiomatized using logical equivalence as the
	539	equality on propositions. *)
	540	Variable bool : Prop.
	541	Variable p2b : Prop -> bool.
	542	Variable b2p : bool -> Prop.
	543	Hypothesis p2p1 : forall A:Prop, b2p (p2b A) -> A.
	544	Hypothesis p2p2 : forall A:Prop, A -> b2p (p2b A).
	545
	546	( Paradox *)
	547
	548	Theorem paradox : forall B:Prop, B.
	549	Proof.
	550	intros B.
	551	unshelve (refine (mparadox (exist _ bool (fun x => x)) _ _ _ _
	552	(exist _ B (fun x => x)))).
	553	+ intros p. red. red. exact (p2b (El p)).
	554	+ cbn. intros b. red. exists (b2p b). exact (fun x => x).
	555	+ cbn. intros [A H]. cbn. apply p2p1.
	556	+ cbn. intros [A H]. cbn. apply p2p2.
530	557	Qed.
531	558
532	559	End Paradox.
533	560
534		End NoRetractToNegativeProp.
	561	End NoRetractFromSmallPropositionToProp.
	562
535	563
536	564	(** * Large universes are no retracts of [Prop]. *)
537	565

568	596	+ cbn. exact (fun u F => forall x, F x).
569	597	+ cbn. exact (fun _ _ x => x).
570	598	+ cbn. exact (fun _ _ x => x).
571		+ cbn. easy.
572	599	+ exact (fun F => forall A:Prop, F(up A)).
573	600	+ cbn. exact (fun F f A => f (up A)).
574	601	+ cbn.

576	603	specialize (f (down A)).
577	604	rewrite up_down in f.
578	605	exact f.
	606	+ exact Prop.
	607	+ cbn. exact (fun X => X).
	608	+ cbn. exact (fun A P => forall x:A, P x).
	609	+ cbn. exact (fun A P => forall x:A, P x).
	610	+ cbn. exact P.
	611	+ exact h.
	612	+ cbn. easy.
579	613	+ cbn.
580	614	intros F f A.
581	615	destruct (up_down A). cbn.
582	616	reflexivity.
583		+ exact Prop.
584		+ cbn. exact (fun X => X).
585		+ cbn. exact (fun A P => forall x:A, P x).
586		+ cbn. exact (fun _ _ x => x).
587		+ cbn. exact (fun _ _ x => x).
588		+ cbn. exact (fun A P => forall x:A, P x).
589		+ cbn. exact (fun _ _ x => x).
590		+ cbn. exact (fun _ _ x => x).
591		+ cbn. exact P.
592		+ exact h.
	617	+ cbn. exact (fun _ _ x => x).
	618	+ cbn. exact (fun _ _ x => x).
	619	+ cbn. exact (fun _ _ x => x).
	620	+ cbn. exact (fun _ _ x => x).
593	621	Qed.
594	622
595	623	End Paradox.

636	664	+ cbn. exact (fun X F => forall x:X, F x).
637	665	+ cbn. exact (fun _ _ x => x).
638	666	+ cbn. exact (fun _ _ x => x).
639		+ cbn. easy.
640	667	+ exact (fun F => forall x:A, F (up x)).
641	668	+ cbn. exact (fun _ f => fun x:A => f (up x)).
642	669	+ cbn. intros * f X.
643	670	specialize (f (down X)).
644	671	rewrite up_down in f.
645	672	exact f.
646		+ cbn. intros ? f X.
647		destruct (up_down X). cbn.
648		reflexivity.
649	673	(** Small universe *)
650	674	+ exact A.
651	675	(** The interpretation of [A] as a universe is [U]. *)
652	676	+ cbn. exact up.
653	677	+ cbn. exact (fun _ F => down (forall x, up (F x))).
	678	+ cbn. exact (fun _ F => down (forall x, up (F x))).
	679	+ cbn. exact (down False).
	680	+ rewrite up_down in p.
	681	exact p.
	682	+ cbn. easy.
	683	+ cbn. intros ? f X.
	684	destruct (up_down X). cbn.
	685	reflexivity.
654	686	+ cbn. intros ? ? f.
655	687	rewrite up_down.
656	688	exact f.
657	689	+ cbn. intros ? ? f.
658	690	rewrite up_down in f.
659	691	exact f.
660		+ cbn. exact (fun _ F => down (forall x, up (F x))).
661	692	+ cbn. intros ? ? f.
662	693	rewrite up_down.
663	694	exact f.
664	695	+ cbn. intros ? ? f.
665	696	rewrite up_down in f.
666	697	exact f.
667		+ cbn. exact (down False).
668		+ rewrite up_down in p.
669		exact p.
670	698	Qed.
671	699
672	700	End Paradox.

682	710	Theorem paradox : Prop <> Type.
683	711	Proof.
684	712	intros h.
685		refine (TypeNeqSmallType.paradox _ _).
	713	unshelve (refine (TypeNeqSmallType.paradox _ _)).
686	714	+ exact Prop.
687	715	+ easy.
688	716	Qed.

+1

-1

theories/Logic/IndefiniteDescription.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/JMeq.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/ProofIrrelevance.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/ProofIrrelevanceFacts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/RelationalChoice.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Logic/SetIsType.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-4

theories/Logic/WKL.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

39	39	Proof.
40	40	intros. split.
41	41	- induction 1 as [\|* HP _ (l'&Hl'&HPl')\|* HP _ (l'&Hl'&HPl')].
42		+ exists []. split. reflexivity. intros n <-/le_n_0_eq. assumption.
	42	+ exists []. split. reflexivity. intros n <-%le_n_0_eq. assumption.
43	43	+ exists (true :: l'). split. apply eq_S, Hl'. intros [\|] H.
44	44	* assumption.
45	45	* simpl. rewrite <- app_assoc. apply HPl', le_S_n, H.

50	50	+ constructor. apply (HPl' 0). apply le_0_n.
51	51	+ eapply next_left.
52	52	* apply (HPl' 0), le_0_n.
53		* fold (length l'). apply IHl'. intros n' H/le_n_S. apply HPl' in H. simpl in H. rewrite <- app_assoc in H. assumption.
	53	* fold (length l'). apply IHl'. intros n' H%le_n_S. apply HPl' in H. simpl in H. rewrite <- app_assoc in H. assumption.
54	54	+ apply next_right.
55	55	* apply (HPl' 0), le_0_n.
56		* fold (length l'). apply IHl'. intros n' H/le_n_S. apply HPl' in H. simpl in H. rewrite <- app_assoc in H. assumption.
	56	* fold (length l'). apply IHl'. intros n' H%le_n_S. apply HPl' in H. simpl in H. rewrite <- app_assoc in H. assumption.
57	57	Qed.
58	58
59	59	(** [infinite_from P l] means that we can find arbitrary long paths

+2

-2

theories/Logic/WeakFan.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

88	88	Theorem WeakFanTheorem : forall P, barred P -> inductively_barred P [].
89	89	Proof.
90	90	intros P Hbar.
91		destruct Hbar with (X P) as (l,(Hd/Y_approx,HP)).
	91	destruct Hbar with (X P) as (l,(Hd%Y_approx,HP)).
92	92	assert (inductively_barred P l) by (apply (now P l), HP).
93	93	clear Hbar HP.
94	94	induction l as [\|a l].

+0

-2158

~~theories/MMaps/MMapAVL.v~~ less more

0		(***********************************************************************)
1		(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
3		(* \VV/ *************************************************************)
4		(* // * This file is distributed under the terms of the *)
5		(* * GNU Lesser General Public License Version 2.1 *)
6		(***********************************************************************)
7
8		(* Finite map library. *)
9
10		(** * MMapAVL *)
11
12		(** This module implements maps using AVL trees.
13		It follows the implementation from Ocaml's standard library.
14
15		See the comments at the beginning of MSetAVL for more details.
16		*)
17
18		Require Import Bool PeanoNat BinInt Int MMapInterface MMapList.
19		Require Import Orders OrdersFacts OrdersLists.
20
21		Set Implicit Arguments.
22		Unset Strict Implicit.
23		(* For nicer extraction, we create inductive principles
24		only when needed *)
25		Local Unset Elimination Schemes.
26
27		(** Notations and helper lemma about pairs *)
28
29		Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope.
30		Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope.
31
32		(** * The Raw functor
33
34		Functor of pure functions + separate proofs of invariant
35		preservation *)
36
37		Module Raw (Import I:Int)(X: OrderedType).
38		Local Open Scope pair_scope.
39		Local Open Scope lazy_bool_scope.
40		Local Open Scope Int_scope.
41		Local Notation int := I.t.
42
43		Definition key := X.t.
44		Hint Transparent key.
45
46		(** * Trees *)
47
48		Section Elt.
49
50		Variable elt : Type.
51
52		(** * Trees
53
54		The fifth field of [Node] is the height of the tree *)
55
56		Inductive tree :=
57		\| Leaf : tree
58		\| Node : tree -> key -> elt -> tree -> int -> tree.
59
60		Notation t := tree.
61
62		(** * Basic functions on trees: height and cardinal *)
63
64		Definition height (m : t) : int :=
65		match m with
66		\| Leaf => 0
67		\| Node _ _ _ _ h => h
68		end.
69
70		Fixpoint cardinal (m : t) : nat :=
71		match m with
72		\| Leaf => 0%nat
73		\| Node l _ _ r _ => S (cardinal l + cardinal r)
74		end.
75
76		(** * Empty Map *)
77
78		Definition empty := Leaf.
79
80		(** * Emptyness test *)
81
82		Definition is_empty m := match m with Leaf => true \| _ => false end.
83
84		(** * Membership *)
85
86		(** The [mem] function is deciding membership. It exploits the [Bst] property
87		to achieve logarithmic complexity. *)
88
89		Fixpoint mem x m : bool :=
90		match m with
91		\| Leaf => false
92		\| Node l y _ r _ =>
93		match X.compare x y with
94		\| Eq => true
95		\| Lt => mem x l
96		\| Gt => mem x r
97		end
98		end.
99
100		Fixpoint find x m : option elt :=
101		match m with
102		\| Leaf => None
103		\| Node l y d r _ =>
104		match X.compare x y with
105		\| Eq => Some d
106		\| Lt => find x l
107		\| Gt => find x r
108		end
109		end.
110
111		(** * Helper functions *)
112
113		(** [create l x r] creates a node, assuming [l] and [r]
114		to be balanced and [\|height l - height r\| <= 2]. *)
115
116		Definition create l x e r :=
117		Node l x e r (max (height l) (height r) + 1).
118
119		(** [bal l x e r] acts as [create], but performs one step of
120		rebalancing if necessary, i.e. assumes [\|height l - height r\| <= 3]. *)
121
122		Definition assert_false := create.
123
124		Fixpoint bal l x d r :=
125		let hl := height l in
126		let hr := height r in
127		if (hr+2) <? hl then
128		match l with
129		\| Leaf => assert_false l x d r
130		\| Node ll lx ld lr _ =>
131		if (height lr) <=? (height ll) then
132		create ll lx ld (create lr x d r)
133		else
134		match lr with
135		\| Leaf => assert_false l x d r
136		\| Node lrl lrx lrd lrr _ =>
137		create (create ll lx ld lrl) lrx lrd (create lrr x d r)
138		end
139		end
140		else
141		if (hl+2) <? hr then
142		match r with
143		\| Leaf => assert_false l x d r
144		\| Node rl rx rd rr _ =>
145		if (height rl) <=? (height rr) then
146		create (create l x d rl) rx rd rr
147		else
148		match rl with
149		\| Leaf => assert_false l x d r
150		\| Node rll rlx rld rlr _ =>
151		create (create l x d rll) rlx rld (create rlr rx rd rr)
152		end
153		end
154		else
155		create l x d r.
156
157		(** * Insertion *)
158
159		Fixpoint add x d m :=
160		match m with
161		\| Leaf => Node Leaf x d Leaf 1
162		\| Node l y d' r h =>
163		match X.compare x y with
164		\| Eq => Node l y d r h
165		\| Lt => bal (add x d l) y d' r
166		\| Gt => bal l y d' (add x d r)
167		end
168		end.
169
170		(** * Extraction of minimum binding
171
172		Morally, [remove_min] is to be applied to a non-empty tree
173		[t = Node l x e r h]. Since we can't deal here with [assert false]
174		for [t=Leaf], we pre-unpack [t] (and forget about [h]).
175		*)
176
177		Fixpoint remove_min l x d r : t(keyelt) :=
178		match l with
179		\| Leaf => (r,(x,d))
180		\| Node ll lx ld lr lh =>
181		let (l',m) := remove_min ll lx ld lr in
182		(bal l' x d r, m)
183		end.
184
185		(** * Merging two trees
186
187		[merge0 t1 t2] builds the union of [t1] and [t2] assuming all elements
188		of [t1] to be smaller than all elements of [t2], and
189		[\|height t1 - height t2\| <= 2].
190		*)
191
192		Definition merge0 s1 s2 :=
193		match s1,s2 with
194		\| Leaf, _ => s2
195		\| _, Leaf => s1
196		\| _, Node l2 x2 d2 r2 h2 =>
197		let '(s2',(x,d)) := remove_min l2 x2 d2 r2 in
198		bal s1 x d s2'
199		end.
200
201		(** * Deletion *)
202
203		Fixpoint remove x m := match m with
204		\| Leaf => Leaf
205		\| Node l y d r h =>
206		match X.compare x y with
207		\| Eq => merge0 l r
208		\| Lt => bal (remove x l) y d r
209		\| Gt => bal l y d (remove x r)
210		end
211		end.
212
213		(** * join
214
215		Same as [bal] but does not assume anything regarding heights of [l]
216		and [r].
217		*)
218
219		Fixpoint join l : key -> elt -> t -> t :=
220		match l with
221		\| Leaf => add
222		\| Node ll lx ld lr lh => fun x d =>
223		fix join_aux (r:t) : t := match r with
224		\| Leaf => add x d l
225		\| Node rl rx rd rr rh =>
226		if rh+2 <? lh then bal ll lx ld (join lr x d r)
227		else if lh+2 <? rh then bal (join_aux rl) rx rd rr
228		else create l x d r
229		end
230		end.
231
232		(** * Splitting
233
234		[split x m] returns a triple [(l, o, r)] where
235		- [l] is the set of elements of [m] that are [< x]
236		- [r] is the set of elements of [m] that are [> x]
237		- [o] is the result of [find x m].
238		*)
239
240		Record triple := mktriple { t_left:t; t_opt:option elt; t_right:t }.
241		Notation "〚 l , b , r 〛" := (mktriple l b r) (at level 9).
242
243		Fixpoint split x m : triple := match m with
244		\| Leaf => 〚 Leaf, None, Leaf 〛
245		\| Node l y d r h =>
246		match X.compare x y with
247		\| Lt => let (ll,o,rl) := split x l in 〚 ll, o, join rl y d r 〛
248		\| Eq => 〚 l, Some d, r 〛
249		\| Gt => let (rl,o,rr) := split x r in 〚 join l y d rl, o, rr 〛
250		end
251		end.
252
253		(** * Concatenation
254
255		Same as [merge] but does not assume anything about heights.
256		*)
257
258		Definition concat m1 m2 :=
259		match m1, m2 with
260		\| Leaf, _ => m2
261		\| _ , Leaf => m1
262		\| _, Node l2 x2 d2 r2 _ =>
263		let (m2',xd) := remove_min l2 x2 d2 r2 in
264		join m1 xd#1 xd#2 m2'
265		end.
266
267		(** * Bindings *)
268
269		(** [bindings_aux acc t] catenates the bindings of [t] in infix
270		order to the list [acc] *)
271
272		Fixpoint bindings_aux (acc : list (keyelt)) m : list (keyelt) :=
273		match m with
274		\| Leaf => acc
275		\| Node l x d r _ => bindings_aux ((x,d) :: bindings_aux acc r) l
276		end.
277
278		(** then [bindings] is an instantiation with an empty [acc] *)
279
280		Definition bindings := bindings_aux nil.
281
282		(** * Fold *)
283
284		Fixpoint fold {A} (f : key -> elt -> A -> A) (m : t) : A -> A :=
285		fun a => match m with
286		\| Leaf => a
287		\| Node l x d r _ => fold f r (f x d (fold f l a))
288		end.
289
290		(** * Comparison *)
291
292		Variable cmp : elt->elt->bool.
293
294		( Enumeration of the elements of a tree *)
295
296		Inductive enumeration :=
297		\| End : enumeration
298		\| More : key -> elt -> t -> enumeration -> enumeration.
299
300		(** [cons m e] adds the elements of tree [m] on the head of
301		enumeration [e]. *)
302
303		Fixpoint cons m e : enumeration :=
304		match m with
305		\| Leaf => e
306		\| Node l x d r h => cons l (More x d r e)
307		end.
308
309		(** One step of comparison of elements *)
310
311		Definition equal_more x1 d1 (cont:enumeration->bool) e2 :=
312		match e2 with
313		\| End => false
314		\| More x2 d2 r2 e2 =>
315		match X.compare x1 x2 with
316		\| Eq => cmp d1 d2 &&& cont (cons r2 e2)
317		\| _ => false
318		end
319		end.
320
321		(** Comparison of left tree, middle element, then right tree *)
322
323		Fixpoint equal_cont m1 (cont:enumeration->bool) e2 :=
324		match m1 with
325		\| Leaf => cont e2
326		\| Node l1 x1 d1 r1 _ =>
327		equal_cont l1 (equal_more x1 d1 (equal_cont r1 cont)) e2
328		end.
329
330		(** Initial continuation *)
331
332		Definition equal_end e2 := match e2 with End => true \| _ => false end.
333
334		(** The complete comparison *)
335
336		Definition equal m1 m2 := equal_cont m1 equal_end (cons m2 End).
337
338		End Elt.
339		Notation t := tree.
340		Notation "〚 l , b , r 〛" := (mktriple l b r) (at level 9).
341		Notation "t #l" := (t_left t) (at level 9, format "t '#l'").
342		Notation "t #o" := (t_opt t) (at level 9, format "t '#o'").
343		Notation "t #r" := (t_right t) (at level 9, format "t '#r'").
344
345
346		(** * Map *)
347
348		Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' :=
349		match m with
350		\| Leaf _ => Leaf _
351		\| Node l x d r h => Node (map f l) x (f d) (map f r) h
352		end.
353
354		(* * Mapi *)
355
356		Fixpoint mapi (elt elt' : Type)(f : key -> elt -> elt')(m : t elt) : t elt' :=
357		match m with
358		\| Leaf _ => Leaf _
359		\| Node l x d r h => Node (mapi f l) x (f x d) (mapi f r) h
360		end.
361
362		(** * Map with removal *)
363
364		Fixpoint mapo (elt elt' : Type)(f : key -> elt -> option elt')(m : t elt)
365		: t elt' :=
366		match m with
367		\| Leaf _ => Leaf _
368		\| Node l x d r h =>
369		match f x d with
370		\| Some d' => join (mapo f l) x d' (mapo f r)
371		\| None => concat (mapo f l) (mapo f r)
372		end
373		end.
374
375		(** * Generalized merge
376
377		Suggestion by B. Gregoire: a [merge] function with specialized
378		arguments that allows bypassing some tree traversal. Instead of one
379		[f0] of type [key -> option elt -> option elt' -> option elt''],
380		we ask here for:
381		- [f] which is a specialisation of [f0] when first option isn't [None]
382		- [mapl] treats a [tree elt] with [f0] when second option is [None]
383		- [mapr] treats a [tree elt'] with [f0] when first option is [None]
384
385		The idea is that [mapl] and [mapr] can be instantaneous (e.g.
386		the identity or some constant function).
387		*)
388
389		Section GMerge.
390		Variable elt elt' elt'' : Type.
391		Variable f : key -> elt -> option elt' -> option elt''.
392		Variable mapl : t elt -> t elt''.
393		Variable mapr : t elt' -> t elt''.
394
395		Fixpoint gmerge m1 m2 :=
396		match m1, m2 with
397		\| Leaf _, _ => mapr m2
398		\| _, Leaf _ => mapl m1
399		\| Node l1 x1 d1 r1 h1, _ =>
400		let (l2',o2,r2') := split x1 m2 in
401		match f x1 d1 o2 with
402		\| Some e => join (gmerge l1 l2') x1 e (gmerge r1 r2')
403		\| None => concat (gmerge l1 l2') (gmerge r1 r2')
404		end
405		end.
406
407		End GMerge.
408
409		(** * Merge
410
411		The [merge] function of the Map interface can be implemented
412		via [gmerge] and [mapo].
413		*)
414
415		Section Merge.
416		Variable elt elt' elt'' : Type.
417		Variable f : key -> option elt -> option elt' -> option elt''.
418
419		Definition merge : t elt -> t elt' -> t elt'' :=
420		gmerge
421		(fun k d o => f k (Some d) o)
422		(mapo (fun k d => f k (Some d) None))
423		(mapo (fun k d' => f k None (Some d'))).
424
425		End Merge.
426
427
428
429		(** * Invariants *)
430
431		Section Invariants.
432		Variable elt : Type.
433
434		( Occurrence in a tree *)
435
436		Inductive MapsTo (x : key)(e : elt) : t elt -> Prop :=
437		\| MapsRoot : forall l r h y,
438		X.eq x y -> MapsTo x e (Node l y e r h)
439		\| MapsLeft : forall l r h y e',
440		MapsTo x e l -> MapsTo x e (Node l y e' r h)
441		\| MapsRight : forall l r h y e',
442		MapsTo x e r -> MapsTo x e (Node l y e' r h).
443
444		Inductive In (x : key) : t elt -> Prop :=
445		\| InRoot : forall l r h y e,
446		X.eq x y -> In x (Node l y e r h)
447		\| InLeft : forall l r h y e',
448		In x l -> In x (Node l y e' r h)
449		\| InRight : forall l r h y e',
450		In x r -> In x (Node l y e' r h).
451
452		Definition In0 k m := exists e:elt, MapsTo k e m.
453
454		( Binary search trees *)
455
456		(** [Above x m] : [x] is strictly greater than any key in [m].
457		[Below x m] : [x] is strictly smaller than any key in [m]. *)
458
459		Inductive Above (x:key) : t elt -> Prop :=
460		\| AbLeaf : Above x (Leaf _)
461		\| AbNode l r h y e : Above x l -> X.lt y x -> Above x r ->
462		Above x (Node l y e r h).
463
464		Inductive Below (x:key) : t elt -> Prop :=
465		\| BeLeaf : Below x (Leaf _)
466		\| BeNode l r h y e : Below x l -> X.lt x y -> Below x r ->
467		Below x (Node l y e r h).
468
469		Definition Apart (m1 m2 : t elt) : Prop :=
470		forall x1 x2, In x1 m1 -> In x2 m2 -> X.lt x1 x2.
471
472		(** Alternative statements, equivalent with [LtTree] and [GtTree] *)
473
474		Definition lt_tree x m := forall y, In y m -> X.lt y x.
475		Definition gt_tree x m := forall y, In y m -> X.lt x y.
476
477		(** [Bst t] : [t] is a binary search tree *)
478
479		Inductive Bst : t elt -> Prop :=
480		\| BSLeaf : Bst (Leaf _)
481		\| BSNode : forall x e l r h, Bst l -> Bst r ->
482		Above x l -> Below x r -> Bst (Node l x e r h).
483
484		End Invariants.
485
486
487		(** * Correctness proofs, isolated in a sub-module *)
488
489		Module Proofs.
490		Module MX := OrderedTypeFacts X.
491		Module PX := KeyOrderedType X.
492		Module L := MMapList.Raw X.
493
494		Local Infix "∈" := In (at level 70).
495		Local Infix "==" := X.eq (at level 70).
496		Local Infix "<" := X.lt (at level 70).
497		Local Infix "<<" := Below (at level 70).
498		Local Infix ">>" := Above (at level 70).
499		Local Infix "<<<" := Apart (at level 70).
500
501		Scheme tree_ind := Induction for tree Sort Prop.
502		Scheme Bst_ind := Induction for Bst Sort Prop.
503		Scheme MapsTo_ind := Induction for MapsTo Sort Prop.
504		Scheme In_ind := Induction for In Sort Prop.
505		Scheme Above_ind := Induction for Above Sort Prop.
506		Scheme Below_ind := Induction for Below Sort Prop.
507
508		Functional Scheme mem_ind := Induction for mem Sort Prop.
509		Functional Scheme find_ind := Induction for find Sort Prop.
510		Functional Scheme bal_ind := Induction for bal Sort Prop.
511		Functional Scheme add_ind := Induction for add Sort Prop.
512		Functional Scheme remove_min_ind := Induction for remove_min Sort Prop.
513		Functional Scheme merge0_ind := Induction for merge0 Sort Prop.
514		Functional Scheme remove_ind := Induction for remove Sort Prop.
515		Functional Scheme concat_ind := Induction for concat Sort Prop.
516		Functional Scheme split_ind := Induction for split Sort Prop.
517		Functional Scheme mapo_ind := Induction for mapo Sort Prop.
518		Functional Scheme gmerge_ind := Induction for gmerge Sort Prop.
519
520		(** * Automation and dedicated tactics. *)
521
522		Local Hint Constructors tree MapsTo In Bst Above Below.
523		Local Hint Unfold lt_tree gt_tree Apart.
524		Local Hint Immediate MX.eq_sym.
525		Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans.
526
527		Tactic Notation "factornode" ident(s) :=
528		try clear s;
529		match goal with
530		\| \|- context [Node ?l ?x ?e ?r ?h] =>
531		set (s:=Node l x e r h) in *; clearbody s; clear l x e r h
532		\| _ : context [Node ?l ?x ?e ?r ?h] \|- _ =>
533		set (s:=Node l x e r h) in *; clearbody s; clear l x e r h
534		end.
535
536		(** A tactic for cleaning hypothesis after use of functional induction. *)
537
538		Ltac cleanf :=
539		match goal with
540		\| H : X.compare _ _ = Eq \|- _ =>
541		rewrite ?H; apply MX.compare_eq in H; cleanf
542		\| H : X.compare _ _ = Lt \|- _ =>
543		rewrite ?H; apply MX.compare_lt_iff in H; cleanf
544		\| H : X.compare _ _ = Gt \|- _ =>
545		rewrite ?H; apply MX.compare_gt_iff in H; cleanf
546		\| _ => idtac
547		end.
548
549
550		(** A tactic to repeat [inversion_clear] on all hyps of the
551		form [(f (Node ...))] *)
552
553		Ltac inv f :=
554		match goal with
555		\| H:f (Leaf _) \|- _ => inversion_clear H; inv f
556		\| H:f _ (Leaf _) \|- _ => inversion_clear H; inv f
557		\| H:f _ _ (Leaf _) \|- _ => inversion_clear H; inv f
558		\| H:f _ _ _ (Leaf _) \|- _ => inversion_clear H; inv f
559		\| H:f (Node _ _ _ _ _) \|- _ => inversion_clear H; inv f
560		\| H:f _ (Node _ _ _ _ _) \|- _ => inversion_clear H; inv f
561		\| H:f _ _ (Node _ _ _ _ _) \|- _ => inversion_clear H; inv f
562		\| H:f _ _ _ (Node _ _ _ _ _) \|- _ => inversion_clear H; inv f
563		\| _ => idtac
564		end.
565
566		Ltac inv_all f :=
567		match goal with
568		\| H: f _ \|- _ => inversion_clear H; inv f
569		\| H: f _ _ \|- _ => inversion_clear H; inv f
570		\| H: f _ _ _ \|- _ => inversion_clear H; inv f
571		\| H: f _ _ _ _ \|- _ => inversion_clear H; inv f
572		\| _ => idtac
573		end.
574
575		Ltac intuition_in := repeat (intuition; inv In; inv MapsTo).
576
577		(* Function/Functional Scheme can't deal with internal fix.
578		Let's do its job by hand: *)
579
580		Ltac join_tac l x d r :=
581		revert x d r;
582		induction l as [\| ll _ lx ld lr Hlr lh];
583		[ \| intros x d r; induction r as [\| rl Hrl rx rd rr _ rh]; unfold join;
584		[ \| destruct (rh+2 <? lh) eqn:LT;
585		[ match goal with \|- context [ bal ?u ?v ?w ?z ] =>
586		replace (bal u v w z)
587		with (bal ll lx ld (join lr x d (Node rl rx rd rr rh))); [ \| auto]
588		end
589		\| destruct (lh+2 <? rh) eqn:LT';
590		[ match goal with \|- context [ bal ?u ?v ?w ?z ] =>
591		replace (bal u v w z)
592		with (bal (join (Node ll lx ld lr lh) x d rl) rx rd rr); [ \| auto]
593		end
594		\| ] ] ] ]; intros.
595
596		Ltac cleansplit :=
597		simpl; cleanf; inv Bst;
598		match goal with
599		\| E:split _ _ = 〚 ?l, ?o, ?r 〛 \|- _ =>
600		change l with (〚l,o,r〛#l); rewrite <- ?E;
601		change o with (〚l,o,r〛#o); rewrite <- ?E;
602		change r with (〚l,o,r〛#r); rewrite <- ?E
603		\| _ => idtac
604		end.
605
606		(** * Basic results about [MapsTo], [In], [lt_tree], [gt_tree], [height] *)
607
608		(** Facts about [MapsTo] and [In]. *)
609
610		Lemma MapsTo_In {elt} k (e:elt) m : MapsTo k e m -> k ∈ m.
611		Proof.
612		induction 1; auto.
613		Qed.
614		Local Hint Resolve MapsTo_In.
615
616		Lemma In_MapsTo {elt} k m : k ∈ m -> exists (e:elt), MapsTo k e m.
617		Proof.
618		induction 1; try destruct IHIn as (e,He); exists e; auto.
619		Qed.
620
621		Lemma In_alt {elt} k (m:t elt) : In0 k m <-> k ∈ m.
622		Proof.
623		split.
624		intros (e,H); eauto.
625		unfold In0; apply In_MapsTo; auto.
626		Qed.
627
628		Lemma MapsTo_1 {elt} m x y (e:elt) :
629		x == y -> MapsTo x e m -> MapsTo y e m.
630		Proof.
631		induction m; simpl; intuition_in; eauto.
632		Qed.
633		Hint Immediate MapsTo_1.
634
635		Instance MapsTo_compat {elt} :
636		Proper (X.eq==>Logic.eq==>Logic.eq==>iff) (@MapsTo elt).
637		Proof.
638		intros x x' Hx e e' He m m' Hm. subst.
639		split; now apply MapsTo_1.
640		Qed.
641
642		Instance In_compat {elt} :
643		Proper (X.eq==>Logic.eq==>iff) (@In elt).
644		Proof.
645		intros x x' H m m' <-.
646		induction m; simpl; intuition_in; eauto.
647		Qed.
648
649		Lemma In_node_iff {elt} l x (e:elt) r h y :
650		y ∈ (Node l x e r h) <-> y ∈ l \/ y == x \/ y ∈ r.
651		Proof.
652		intuition_in.
653		Qed.
654
655		(** Results about [Above] and [Below] *)
656
657		Lemma above {elt} (m:t elt) x :
658		x >> m <-> forall y, y ∈ m -> y < x.
659		Proof.
660		split.
661		- induction 1; intuition_in; MX.order.
662		- induction m; constructor; auto.
663		Qed.
664
665		Lemma below {elt} (m:t elt) x :
666		x << m <-> forall y, y ∈ m -> x < y.
667		Proof.
668		split.
669		- induction 1; intuition_in; MX.order.
670		- induction m; constructor; auto.
671		Qed.
672
673		Lemma AboveLt {elt} (m:t elt) x y : x >> m -> y ∈ m -> y < x.
674		Proof.
675		rewrite above; intuition.
676		Qed.
677
678		Lemma BelowGt {elt} (m:t elt) x y : x << m -> y ∈ m -> x < y.
679		Proof.
680		rewrite below; intuition.
681		Qed.
682
683		Lemma Above_not_In {elt} (m:t elt) x : x >> m -> ~ x ∈ m.
684		Proof.
685		induction 1; intuition_in; MX.order.
686		Qed.
687
688		Lemma Below_not_In {elt} (m:t elt) x : x << m -> ~ x ∈ m.
689		Proof.
690		induction 1; intuition_in; MX.order.
691		Qed.
692
693		Lemma Above_trans {elt} (m:t elt) x y : x < y -> x >> m -> y >> m.
694		Proof.
695		induction 2; constructor; trivial; MX.order.
696		Qed.
697
698		Lemma Below_trans {elt} (m:t elt) x y : y < x -> x << m -> y << m.
699		Proof.
700		induction 2; constructor; trivial; MX.order.
701		Qed.
702
703		Local Hint Resolve
704		AboveLt Above_not_In Above_trans
705		BelowGt Below_not_In Below_trans.
706
707		(** Helper tactic concerning order of elements. *)
708
709		Ltac order := match goal with
710		\| U: _ >> ?m, V: _ ∈ ?m \|- _ =>
711		generalize (AboveLt U V); clear U; order
712		\| U: _ << ?m, V: _ ∈ ?m \|- _ =>
713		generalize (BelowGt U V); clear U; order
714		\| U: _ >> ?m, V: MapsTo _ _ ?m \|- _ =>
715		generalize (AboveLt U (MapsTo_In V)); clear U; order
716		\| U: _ << ?m, V: MapsTo _ _ ?m \|- _ =>
717		generalize (BelowGt U (MapsTo_In V)); clear U; order
718		\| _ => MX.order
719		end.
720
721		Lemma between {elt} (m m':t elt) x :
722		x >> m -> x << m' -> m <<< m'.
723		Proof.
724		intros H H' y y' Hy Hy'. order.
725		Qed.
726
727		Section Elt.
728		Variable elt:Type.
729		Implicit Types m r : t elt.
730
731		(** * Membership *)
732
733		Lemma find_1 m x e : Bst m -> MapsTo x e m -> find x m = Some e.
734		Proof.
735		functional induction (find x m); cleanf;
736		intros; inv Bst; intuition_in; order.
737		Qed.
738
739		Lemma find_2 m x e : find x m = Some e -> MapsTo x e m.
740		Proof.
741		functional induction (find x m); cleanf; subst; intros; auto.
742		- discriminate.
743		- injection H as ->. auto.
744		Qed.
745
746		Lemma find_spec m x e : Bst m ->
747		(find x m = Some e <-> MapsTo x e m).
748		Proof.
749		split; auto using find_1, find_2.
750		Qed.
751
752		Lemma find_in m x : find x m <> None -> x ∈ m.
753		Proof.
754		destruct (find x m) eqn:F; intros H.
755		- apply MapsTo_In with e. now apply find_2.
756		- now elim H.
757		Qed.
758
759		Lemma in_find m x : Bst m -> x ∈ m -> find x m <> None.
760		Proof.
761		intros H H'.
762		destruct (In_MapsTo H') as (d,Hd).
763		now rewrite (find_1 H Hd).
764		Qed.
765
766		Lemma find_in_iff m x : Bst m ->
767		(find x m <> None <-> x ∈ m).
768		Proof.
769		split; auto using find_in, in_find.
770		Qed.
771
772		Lemma not_find_iff m x : Bst m ->
773		(find x m = None <-> ~ x ∈ m).
774		Proof.
775		intros H. rewrite <- find_in_iff; trivial.
776		destruct (find x m); split; try easy. now destruct 1.
777		Qed.
778
779		Lemma eq_option_alt (o o':option elt) :
780		o=o' <-> (forall e, o=Some e <-> o'=Some e).
781		Proof.
782		split; intros.
783		- now subst.
784		- destruct o, o'; rewrite ?H; auto. symmetry; now apply H.
785		Qed.
786
787		Lemma find_mapsto_equiv : forall m m' x, Bst m -> Bst m' ->
788		(find x m = find x m' <->
789		(forall d, MapsTo x d m <-> MapsTo x d m')).
790		Proof.
791		intros m m' x Hm Hm'. rewrite eq_option_alt.
792		split; intros H d. now rewrite <- 2 find_spec. now rewrite 2 find_spec.
793		Qed.
794
795		Lemma find_in_equiv : forall m m' x, Bst m -> Bst m' ->
796		find x m = find x m' ->
797		(x ∈ m <-> x ∈ m').
798		Proof.
799		split; intros; apply find_in; [ rewrite <- H1 \| rewrite H1 ];
800		apply in_find; auto.
801		Qed.
802
803		Lemma find_compat m x x' : Bst m -> X.eq x x' -> find x m = find x' m.
804		Proof.
805		intros B E.
806		destruct (find x' m) eqn:H.
807		- apply find_1; trivial. rewrite E. now apply find_2.
808		- rewrite not_find_iff in *; trivial. now rewrite E.
809		Qed.
810
811		Lemma mem_spec m x : Bst m -> mem x m = true <-> x ∈ m.
812		Proof.
813		functional induction (mem x m); auto; intros; cleanf;
814		inv Bst; intuition_in; try discriminate; order.
815		Qed.
816
817		(** * Empty map *)
818
819		Lemma empty_bst : Bst (empty elt).
820		Proof.
821		constructor.
822		Qed.
823
824		Lemma empty_spec x : find x (empty elt) = None.
825		Proof.
826		reflexivity.
827		Qed.
828
829		(** * Emptyness test *)
830
831		Lemma is_empty_spec m : is_empty m = true <-> forall x, find x m = None.
832		Proof.
833		destruct m as [\|r x e l h]; simpl; split; try easy.
834		intros H. specialize (H x). now rewrite MX.compare_refl in H.
835		Qed.
836
837		(** * Helper functions *)
838
839		Lemma create_bst l x e r :
840		Bst l -> Bst r -> x >> l -> x << r -> Bst (create l x e r).
841		Proof.
842		unfold create; auto.
843		Qed.
844		Hint Resolve create_bst.
845
846		Lemma create_in l x e r y :
847		y ∈ (create l x e r) <-> y == x \/ y ∈ l \/ y ∈ r.
848		Proof.
849		unfold create; split; [ inversion_clear 1 \| ]; intuition.
850		Qed.
851
852		Lemma bal_bst l x e r : Bst l -> Bst r ->
853		x >> l -> x << r -> Bst (bal l x e r).
854		Proof.
855		functional induction (bal l x e r); intros; cleanf;
856		inv Bst; inv Above; inv Below;
857		repeat apply create_bst; auto; unfold create; constructor; eauto.
858		Qed.
859		Hint Resolve bal_bst.
860
861		Lemma bal_in l x e r y :
862		y ∈ (bal l x e r) <-> y == x \/ y ∈ l \/ y ∈ r.
863		Proof.
864		functional induction (bal l x e r); intros; cleanf;
865		rewrite !create_in; intuition_in.
866		Qed.
867
868		Lemma bal_mapsto l x e r y e' :
869		MapsTo y e' (bal l x e r) <-> MapsTo y e' (create l x e r).
870		Proof.
871		functional induction (bal l x e r); intros; cleanf;
872		unfold assert_false, create; intuition_in.
873		Qed.
874
875		Lemma bal_find l x e r y :
876		Bst l -> Bst r -> x >> l -> x << r ->
877		find y (bal l x e r) = find y (create l x e r).
878		Proof.
879		functional induction (bal l x e r); intros; cleanf; trivial;
880		inv Bst; inv Above; inv Below;
881		simpl; repeat case X.compare_spec; intuition; order.
882		Qed.
883
884		(** * Insertion *)
885
886		Lemma add_in m x y e :
887		y ∈ (add x e m) <-> y == x \/ y ∈ m.
888		Proof.
889		functional induction (add x e m); auto; intros; cleanf;
890		rewrite ?bal_in; intuition_in. setoid_replace y with x; auto.
891		Qed.
892
893		Lemma add_lt m x e y : y >> m -> x < y -> y >> add x e m.
894		Proof.
895		intros. apply above. intros z. rewrite add_in. destruct 1; order.
896		Qed.
897
898		Lemma add_gt m x e y : y << m -> y < x -> y << add x e m.
899		Proof.
900		intros. apply below. intros z. rewrite add_in. destruct 1; order.
901		Qed.
902
903		Lemma add_bst m x e : Bst m -> Bst (add x e m).
904		Proof.
905		functional induction (add x e m); intros; cleanf;
906		inv Bst; try apply bal_bst; auto using add_lt, add_gt.
907		Qed.
908		Hint Resolve add_lt add_gt add_bst.
909
910		Lemma add_spec1 m x e : Bst m -> find x (add x e m) = Some e.
911		Proof.
912		functional induction (add x e m); simpl; intros; cleanf; trivial.
913		- now rewrite MX.compare_refl.
914		- inv Bst. rewrite bal_find; auto.
915		simpl. case X.compare_spec; try order; auto.
916		- inv Bst. rewrite bal_find; auto.
917		simpl. case X.compare_spec; try order; auto.
918		Qed.
919
920		Lemma add_spec2 m x y e : Bst m -> ~ x == y ->
921		find y (add x e m) = find y m.
922		Proof.
923		functional induction (add x e m); simpl; intros; cleanf; trivial.
924		- case X.compare_spec; trivial; order.
925		- case X.compare_spec; trivial; order.
926		- inv Bst. rewrite bal_find by auto. simpl. now rewrite IHt.
927		- inv Bst. rewrite bal_find by auto. simpl. now rewrite IHt.
928		Qed.
929
930		Lemma add_find m x y e : Bst m ->
931		find y (add x e m) =
932		match X.compare y x with Eq => Some e \| _ => find y m end.
933		Proof.
934		intros.
935		case X.compare_spec; intros.
936		- apply find_spec; auto. rewrite H0. apply find_spec; auto.
937		now apply add_spec1.
938		- apply add_spec2; trivial; order.
939		- apply add_spec2; trivial; order.
940		Qed.
941
942		(** * Extraction of minimum binding *)
943
944		Definition RemoveMin m res :=
945		match m with
946		\| Leaf _ => False
947		\| Node l x e r h => remove_min l x e r = res
948		end.
949
950		Lemma RemoveMin_step l x e r h m' p :
951		RemoveMin (Node l x e r h) (m',p) ->
952		(l = Leaf _ /\ m' = r /\ p = (x,e) \/
953		exists m0, RemoveMin l (m0,p) /\ m' = bal m0 x e r).
954		Proof.
955		simpl. destruct l as [\|ll lx le lr lh]; simpl.
956		- intros [= -> ->]. now left.
957		- destruct (remove_min ll lx le lr) as (l',p').
958		intros [= <- <-]. right. now exists l'.
959		Qed.
960
961		Lemma remove_min_mapsto m m' p : RemoveMin m (m',p) ->
962		forall y e,
963		MapsTo y e m <-> (y == p#1 /\ e = p#2) \/ MapsTo y e m'.
964		Proof.
965		revert m'.
966		induction m as [\|l IH x d r _ h]; [destruct 1\|].
967		intros m' R. apply RemoveMin_step in R.
968		destruct R as [(->,(->,->))\|[m0 (R,->)]]; intros y e; simpl.
969		- intuition_in. subst. now constructor.
970		- rewrite bal_mapsto. unfold create. specialize (IH _ R y e).
971		intuition_in.
972		Qed.
973
974		Lemma remove_min_in m m' p : RemoveMin m (m',p) ->
975		forall y, y ∈ m <-> y == p#1 \/ y ∈ m'.
976		Proof.
977		revert m'.
978		induction m as [\|l IH x e r _ h]; [destruct 1\|].
979		intros m' R y. apply RemoveMin_step in R.
980		destruct R as [(->,(->,->))\|[m0 (R,->)]].
981		+ intuition_in.
982		+ rewrite bal_in, In_node_iff, (IH _ R); intuition.
983		Qed.
984
985		Lemma remove_min_lt m m' p : RemoveMin m (m',p) ->
986		forall y, y >> m -> y >> m'.
987		Proof.
988		intros R y L. apply above. intros z Hz.
989		apply (AboveLt L).
990		apply (remove_min_in R). now right.
991		Qed.
992
993		Lemma remove_min_gt m m' p : RemoveMin m (m',p) ->
994		Bst m -> p#1 << m'.
995		Proof.
996		revert m'.
997		induction m as [\|l IH x e r _ h]; [destruct 1\|].
998		intros m' R H. inv Bst. apply RemoveMin_step in R.
999		destruct R as [(_,(->,->))\|[m0 (R,->)]]; auto.
1000		assert (p#1 << m0) by now apply IH.
1001		assert (In p#1 l) by (apply (remove_min_in R); now left).
1002		apply below. intros z. rewrite bal_in.
1003		intuition_in; order.
1004		Qed.
1005
1006		Lemma remove_min_bst m m' p : RemoveMin m (m',p) ->
1007		Bst m -> Bst m'.
1008		Proof.
1009		revert m'.
1010		induction m as [\|l IH x e r _ h]; [destruct 1\|].
1011		intros m' R H. inv Bst. apply RemoveMin_step in R.
1012		destruct R as [(_,(->,->))\|[m0 (R,->)]]; auto.
1013		apply bal_bst; eauto using remove_min_lt.
1014		Qed.
1015
1016		Lemma remove_min_find m m' p : RemoveMin m (m',p) ->
1017		Bst m ->
1018		forall y,
1019		find y m =
1020		match X.compare y p#1 with
1021		\| Eq => Some p#2
1022		\| Lt => None
1023		\| Gt => find y m'
1024		end.
1025		Proof.
1026		revert m'.
1027		induction m as [\|l IH x e r _ h]; [destruct 1\|].
1028		intros m' R B y. inv Bst. apply RemoveMin_step in R.
1029		destruct R as [(->,(->,->))\|[m0 (R,->)]]; auto.
1030		assert (Bst m0) by now apply (remove_min_bst R).
1031		assert (p#1 << m0) by now apply (remove_min_gt R).
1032		assert (x >> m0) by now apply (remove_min_lt R).
1033		assert (In p#1 l) by (apply (remove_min_in R); now left).
1034		simpl in *.
1035		rewrite (IH _ R), bal_find by trivial. clear IH. simpl.
1036		do 2 case X.compare_spec; trivial; try order.
1037		Qed.
1038
1039		(** * Merging two trees *)
1040
1041		Ltac factor_remove_min m R := match goal with
1042		\| h:int, H:remove_min ?l ?x ?e ?r = ?p \|- _ =>
1043		assert (R:RemoveMin (Node l x e r h) p) by exact H;
1044		set (m:=Node l x e r h) in *; clearbody m; clear H l x e r
1045		end.
1046
1047		Lemma merge0_in m1 m2 y :
1048		y ∈ (merge0 m1 m2) <-> y ∈ m1 \/ y ∈ m2.
1049		Proof.
1050		functional induction (merge0 m1 m2); intros; try factornode m1.
1051		- intuition_in.
1052		- intuition_in.
1053		- factor_remove_min l R. rewrite bal_in, (remove_min_in R).
1054		simpl; intuition.
1055		Qed.
1056
1057		Lemma merge0_mapsto m1 m2 y e :
1058		MapsTo y e (merge0 m1 m2) <-> MapsTo y e m1 \/ MapsTo y e m2.
1059		Proof.
1060		functional induction (merge0 m1 m2); intros; try factornode m1.
1061		- intuition_in.
1062		- intuition_in.
1063		- factor_remove_min l R. rewrite bal_mapsto, (remove_min_mapsto R).
1064		simpl. unfold create; intuition_in. subst. now constructor.
1065		Qed.
1066
1067		Lemma merge0_bst m1 m2 : Bst m1 -> Bst m2 -> m1 <<< m2 ->
1068		Bst (merge0 m1 m2).
1069		Proof.
1070		functional induction (merge0 m1 m2); intros B1 B2 B12; trivial.
1071		factornode m1. factor_remove_min l R.
1072		apply bal_bst; auto.
1073		- eapply remove_min_bst; eauto.
1074		- apply above. intros z Hz. apply B12; trivial.
1075		rewrite (remove_min_in R). now left.
1076		- now apply (remove_min_gt R).
1077		Qed.
1078		Hint Resolve merge0_bst.
1079
1080		(** * Deletion *)
1081
1082		Lemma remove_in m x y : Bst m ->
1083		(y ∈ remove x m <-> ~ y == x /\ y ∈ m).
1084		Proof.
1085		functional induction (remove x m); simpl; intros; cleanf; inv Bst;
1086		rewrite ?merge0_in, ?bal_in, ?IHt; intuition_in; order.
1087		Qed.
1088
1089		Lemma remove_lt m x y : Bst m -> y >> m -> y >> remove x m.
1090		Proof.
1091		intros. apply above. intro. rewrite remove_in by trivial.
1092		destruct 1; order.
1093		Qed.
1094
1095		Lemma remove_gt m x y : Bst m -> y << m -> y << remove x m.
1096		Proof.
1097		intros. apply below. intro. rewrite remove_in by trivial.
1098		destruct 1; order.
1099		Qed.
1100
1101		Lemma remove_bst m x : Bst m -> Bst (remove x m).
1102		Proof.
1103		functional induction (remove x m); simpl; intros; cleanf; inv Bst.
1104		- trivial.
1105		- apply merge0_bst; eauto.
1106		- apply bal_bst; auto using remove_lt.
1107		- apply bal_bst; auto using remove_gt.
1108		Qed.
1109		Hint Resolve remove_bst remove_gt remove_lt.
1110
1111		Lemma remove_spec1 m x : Bst m -> find x (remove x m) = None.
1112		Proof.
1113		intros. apply not_find_iff; auto. rewrite remove_in; intuition.
1114		Qed.
1115
1116		Lemma remove_spec2 m x y : Bst m -> ~ x == y ->
1117		find y (remove x m) = find y m.
1118		Proof.
1119		functional induction (remove x m); simpl; intros; cleanf; inv Bst.
1120		- trivial.
1121		- case X.compare_spec; intros; try order;
1122		rewrite find_mapsto_equiv; auto.
1123		+ intros. rewrite merge0_mapsto; intuition; order.
1124		+ apply merge0_bst; auto. red; intros; transitivity y0; order.
1125		+ intros. rewrite merge0_mapsto; intuition; order.
1126		+ apply merge0_bst; auto. now apply between with y0.
1127		- rewrite bal_find by auto. simpl. case X.compare_spec; auto.
1128		- rewrite bal_find by auto. simpl. case X.compare_spec; auto.
1129		Qed.
1130
1131		(** * join *)
1132
1133		Lemma join_in l x d r y :
1134		y ∈ (join l x d r) <-> y == x \/ y ∈ l \/ y ∈ r.
1135		Proof.
1136		join_tac l x d r.
1137		- simpl join. rewrite add_in. intuition_in.
1138		- rewrite add_in. intuition_in.
1139		- rewrite bal_in, Hlr. clear Hlr Hrl. intuition_in.
1140		- rewrite bal_in, Hrl; clear Hlr Hrl; intuition_in.
1141		- apply create_in.
1142		Qed.
1143
1144		Lemma join_bst l x d r :
1145		Bst (create l x d r) -> Bst (join l x d r).
1146		Proof.
1147		join_tac l x d r; unfold create in *;
1148		inv Bst; inv Above; inv Below; auto.
1149		- simpl. auto.
1150		- apply bal_bst; auto.
1151		apply below. intro. rewrite join_in. intuition_in; order.
1152		- apply bal_bst; auto.
1153		apply above. intro. rewrite join_in. intuition_in; order.
1154		Qed.
1155		Hint Resolve join_bst.
1156
1157		Lemma join_find l x d r y :
1158		Bst (create l x d r) ->
1159		find y (join l x d r) = find y (create l x d r).
1160		Proof.
1161		unfold create at 1.
1162		join_tac l x d r; trivial.
1163		- simpl in *. inv Bst.
1164		rewrite add_find; trivial.
1165		case X.compare_spec; intros; trivial.
1166		apply not_find_iff; auto. intro. order.
1167		- clear Hlr. factornode l. simpl. inv Bst.
1168		rewrite add_find by auto.
1169		case X.compare_spec; intros; trivial.
1170		apply not_find_iff; auto. intro. order.
1171		- clear Hrl LT. factornode r. inv Bst; inv Above; inv Below.
1172		rewrite bal_find; auto; simpl.
1173		+ rewrite Hlr; auto; simpl.
1174		repeat (case X.compare_spec; trivial; try order).
1175		+ apply below. intro. rewrite join_in. intuition_in; order.
1176		- clear Hlr LT LT'. factornode l. inv Bst; inv Above; inv Below.
1177		rewrite bal_find; auto; simpl.
1178		+ rewrite Hrl; auto; simpl.
1179		repeat (case X.compare_spec; trivial; try order).
1180		+ apply above. intro. rewrite join_in. intuition_in; order.
1181		Qed.
1182
1183		(** * split *)
1184
1185		Lemma split_in_l0 m x y : y ∈ (split x m)#l -> y ∈ m.
1186		Proof.
1187		functional induction (split x m); cleansplit;
1188		rewrite ?join_in; intuition.
1189		Qed.
1190
1191		Lemma split_in_r0 m x y : y ∈ (split x m)#r -> y ∈ m.
1192		Proof.
1193		functional induction (split x m); cleansplit;
1194		rewrite ?join_in; intuition.
1195		Qed.
1196
1197		Lemma split_in_l m x y : Bst m ->
1198		(y ∈ (split x m)#l <-> y ∈ m /\ y < x).
1199		Proof.
1200		functional induction (split x m); intros; cleansplit;
1201		rewrite ?join_in, ?IHt; intuition_in; order.
1202		Qed.
1203
1204		Lemma split_in_r m x y : Bst m ->
1205		(y ∈ (split x m)#r <-> y ∈ m /\ x < y).
1206		Proof.
1207		functional induction (split x m); intros; cleansplit;
1208		rewrite ?join_in, ?IHt; intuition_in; order.
1209		Qed.
1210
1211		Lemma split_in_o m x : (split x m)#o = find x m.
1212		Proof.
1213		functional induction (split x m); intros; cleansplit; auto.
1214		Qed.
1215
1216		Lemma split_lt_l m x : Bst m -> x >> (split x m)#l.
1217		Proof.
1218		intro. apply above. intro. rewrite split_in_l; intuition; order.
1219		Qed.
1220
1221		Lemma split_lt_r m x y : y >> m -> y >> (split x m)#r.
1222		Proof.
1223		intro. apply above. intros z Hz. apply split_in_r0 in Hz. order.
1224		Qed.
1225
1226		Lemma split_gt_r m x : Bst m -> x << (split x m)#r.
1227		Proof.
1228		intro. apply below. intro. rewrite split_in_r; intuition; order.
1229		Qed.
1230
1231		Lemma split_gt_l m x y : y << m -> y << (split x m)#l.
1232		Proof.
1233		intro. apply below. intros z Hz. apply split_in_l0 in Hz. order.
1234		Qed.
1235		Hint Resolve split_lt_l split_lt_r split_gt_l split_gt_r.
1236
1237		Lemma split_bst_l m x : Bst m -> Bst (split x m)#l.
1238		Proof.
1239		functional induction (split x m); intros; cleansplit; intuition;
1240		auto using join_bst.
1241		Qed.
1242
1243		Lemma split_bst_r m x : Bst m -> Bst (split x m)#r.
1244		Proof.
1245		functional induction (split x m); intros; cleansplit; intuition;
1246		auto using join_bst.
1247		Qed.
1248		Hint Resolve split_bst_l split_bst_r.
1249
1250		Lemma split_find m x y : Bst m ->
1251		find y m = match X.compare y x with
1252		\| Eq => (split x m)#o
1253		\| Lt => find y (split x m)#l
1254		\| Gt => find y (split x m)#r
1255		end.
1256		Proof.
1257		functional induction (split x m); intros; cleansplit.
1258		- now case X.compare.
1259		- repeat case X.compare_spec; trivial; order.
1260		- simpl in *. rewrite join_find, IHt; auto.
1261		simpl. repeat case X.compare_spec; trivial; order.
1262		- rewrite join_find, IHt; auto.
1263		simpl; repeat case X.compare_spec; trivial; order.
1264		Qed.
1265
1266		(** * Concatenation *)
1267
1268		Lemma concat_in m1 m2 y :
1269		y ∈ (concat m1 m2) <-> y ∈ m1 \/ y ∈ m2.
1270		Proof.
1271		functional induction (concat m1 m2); intros; try factornode m1.
1272		- intuition_in.
1273		- intuition_in.
1274		- factor_remove_min m2 R.
1275		rewrite join_in, (remove_min_in R); simpl; intuition.
1276		Qed.
1277
1278		Lemma concat_bst m1 m2 : Bst m1 -> Bst m2 -> m1 <<< m2 ->
1279		Bst (concat m1 m2).
1280		Proof.
1281		functional induction (concat m1 m2); intros B1 B2 LT; auto;
1282		try factornode m1.
1283		factor_remove_min m2 R.
1284		apply join_bst, create_bst; auto.
1285		- now apply (remove_min_bst R).
1286		- apply above. intros y Hy. apply LT; trivial.
1287		rewrite (remove_min_in R); now left.
1288		- now apply (remove_min_gt R).
1289		Qed.
1290		Hint Resolve concat_bst.
1291
1292		Definition oelse {A} (o1 o2:option A) :=
1293		match o1 with
1294		\| Some x => Some x
1295		\| None => o2
1296		end.
1297
1298		Lemma concat_find m1 m2 y : Bst m1 -> Bst m2 -> m1 <<< m2 ->
1299		find y (concat m1 m2) = oelse (find y m2) (find y m1).
1300		Proof.
1301		functional induction (concat m1 m2); intros B1 B2 B; auto; try factornode m1.
1302		- destruct (find y m2); auto.
1303		- factor_remove_min m2 R.
1304		assert (xd#1 >> m1).
1305		{ apply above. intros z Hz. apply B; trivial.
1306		rewrite (remove_min_in R). now left. }
1307		rewrite join_find; simpl; auto.
1308		+ rewrite (remove_min_find R B2 y).
1309		case X.compare_spec; intros; auto.
1310		destruct (find y m2'); trivial.
1311		simpl. symmetry. apply not_find_iff; eauto.
1312		+ apply create_bst; auto.
1313		* now apply (remove_min_bst R).
1314		* now apply (remove_min_gt R).
1315		Qed.
1316
1317
1318		(** * Elements *)
1319
1320		Notation eqk := (PX.eqk (elt:= elt)).
1321		Notation eqke := (PX.eqke (elt:= elt)).
1322		Notation ltk := (PX.ltk (elt:= elt)).
1323
1324		Lemma bindings_aux_mapsto : forall (s:t elt) acc x e,
1325		InA eqke (x,e) (bindings_aux acc s) <-> MapsTo x e s \/ InA eqke (x,e) acc.
1326		Proof.
1327		induction s as [ \| l Hl x e r Hr h ]; simpl; auto.
1328		intuition.
1329		inversion H0.
1330		intros.
1331		rewrite Hl.
1332		destruct (Hr acc x0 e0); clear Hl Hr.
1333		intuition; inversion_clear H3; intuition.
1334		compute in H0. destruct H0; simpl in *; subst; intuition.
1335		Qed.
1336
1337		Lemma bindings_mapsto : forall (s:t elt) x e,
1338		InA eqke (x,e) (bindings s) <-> MapsTo x e s.
1339		Proof.
1340		intros; generalize (bindings_aux_mapsto s nil x e); intuition.
1341		inversion_clear H0.
1342		Qed.
1343
1344		Lemma bindings_in : forall (s:t elt) x, L.PX.In x (bindings s) <-> x ∈ s.
1345		Proof.
1346		intros.
1347		unfold L.PX.In.
1348		rewrite <- In_alt; unfold In0.
1349		split; intros (y,H); exists y.
1350		- now rewrite <- bindings_mapsto.
1351		- unfold L.PX.MapsTo; now rewrite bindings_mapsto.
1352		Qed.
1353
1354		Lemma bindings_aux_sort : forall (s:t elt) acc,
1355		Bst s -> sort ltk acc ->
1356		(forall x e y, InA eqke (x,e) acc -> y ∈ s -> y < x) ->
1357		sort ltk (bindings_aux acc s).
1358		Proof.
1359		induction s as [ \| l Hl y e r Hr h]; simpl; intuition.
1360		inv Bst.
1361		apply Hl; auto.
1362		- constructor.
1363		+ apply Hr; eauto.
1364		+ clear Hl Hr.
1365		apply InA_InfA with (eqA:=eqke); auto with *.
1366		intros (y',e') Hy'.
1367		apply bindings_aux_mapsto in Hy'. compute. intuition; eauto.
1368		- clear Hl Hr. intros x e' y' Hx Hy'.
1369		inversion_clear Hx.
1370		+ compute in H. destruct H; simpl in *. order.
1371		+ apply bindings_aux_mapsto in H. intuition eauto.
1372		Qed.
1373
1374		Lemma bindings_sort : forall s : t elt, Bst s -> sort ltk (bindings s).
1375		Proof.
1376		intros; unfold bindings; apply bindings_aux_sort; auto.
1377		intros; inversion H0.
1378		Qed.
1379		Hint Resolve bindings_sort.
1380
1381		Lemma bindings_nodup : forall s : t elt, Bst s -> NoDupA eqk (bindings s).
1382		Proof.
1383		intros; apply PX.Sort_NoDupA; auto.
1384		Qed.
1385
1386		Lemma bindings_aux_cardinal m acc :
1387		(length acc + cardinal m)%nat = length (bindings_aux acc m).
1388		Proof.
1389		revert acc. induction m; simpl; intuition.
1390		rewrite <- IHm1; simpl.
1391		rewrite <- IHm2. rewrite Nat.add_succ_r, <- Nat.add_assoc.
1392		f_equal. f_equal. apply Nat.add_comm.
1393		Qed.
1394
1395		Lemma bindings_cardinal m : cardinal m = length (bindings m).
1396		Proof.
1397		exact (bindings_aux_cardinal m nil).
1398		Qed.
1399
1400		Lemma bindings_app :
1401		forall (s:t elt) acc, bindings_aux acc s = bindings s ++ acc.
1402		Proof.
1403		induction s; simpl; intros; auto.
1404		rewrite IHs1, IHs2.
1405		unfold bindings; simpl.
1406		rewrite 2 IHs1, IHs2, !app_nil_r, !app_ass; auto.
1407		Qed.
1408
1409		Lemma bindings_node :
1410		forall (t1 t2:t elt) x e z l,
1411		bindings t1 ++ (x,e) :: bindings t2 ++ l =
1412		bindings (Node t1 x e t2 z) ++ l.
1413		Proof.
1414		unfold bindings; simpl; intros.
1415		rewrite !bindings_app, !app_nil_r, !app_ass; auto.
1416		Qed.
1417
1418		(** * Fold *)
1419
1420		Definition fold' {A} (f : key -> elt -> A -> A)(s : t elt) :=
1421		L.fold f (bindings s).
1422
1423		Lemma fold_equiv_aux {A} (s : t elt) (f : key -> elt -> A -> A) (a : A) acc :
1424		L.fold f (bindings_aux acc s) a = L.fold f acc (fold f s a).
1425		Proof.
1426		revert a acc.
1427		induction s; simpl; trivial.
1428		intros. rewrite IHs1. simpl. apply IHs2.
1429		Qed.
1430
1431		Lemma fold_equiv {A} (s : t elt) (f : key -> elt -> A -> A) (a : A) :
1432		fold f s a = fold' f s a.
1433		Proof.
1434		unfold fold', bindings. now rewrite fold_equiv_aux.
1435		Qed.
1436
1437		Lemma fold_spec (s:t elt)(Hs:Bst s){A}(i:A)(f : key -> elt -> A -> A) :
1438		fold f s i = fold_left (fun a p => f p#1 p#2 a) (bindings s) i.
1439		Proof.
1440		rewrite fold_equiv. unfold fold'. now rewrite L.fold_spec.
1441		Qed.
1442
1443		(** * Comparison *)
1444
1445		(** [flatten_e e] returns the list of bindings of the enumeration [e]
1446		i.e. the list of bindings actually compared *)
1447
1448		Fixpoint flatten_e (e : enumeration elt) : list (key*elt) := match e with
1449		\| End _ => nil
1450		\| More x e t r => (x,e) :: bindings t ++ flatten_e r
1451		end.
1452
1453		Lemma flatten_e_bindings :
1454		forall (l:t elt) r x d z e,
1455		bindings l ++ flatten_e (More x d r e) =
1456		bindings (Node l x d r z) ++ flatten_e e.
1457		Proof.
1458		intros; apply bindings_node.
1459		Qed.
1460
1461		Lemma cons_1 : forall (s:t elt) e,
1462		flatten_e (cons s e) = bindings s ++ flatten_e e.
1463		Proof.
1464		induction s; auto; intros.
1465		simpl flatten_e; rewrite IHs1; apply flatten_e_bindings; auto.
1466		Qed.
1467
1468		(** Proof of correction for the comparison *)
1469
1470		Variable cmp : elt->elt->bool.
1471
1472		Definition IfEq b l1 l2 := L.equal cmp l1 l2 = b.
1473
1474		Lemma cons_IfEq : forall b x1 x2 d1 d2 l1 l2,
1475		X.eq x1 x2 -> cmp d1 d2 = true ->
1476		IfEq b l1 l2 ->
1477		IfEq b ((x1,d1)::l1) ((x2,d2)::l2).
1478		Proof.
1479		unfold IfEq; destruct b; simpl; intros; case X.compare_spec; simpl;
1480		try rewrite H0; auto; order.
1481		Qed.
1482
1483		Lemma equal_end_IfEq : forall e2,
1484		IfEq (equal_end e2) nil (flatten_e e2).
1485		Proof.
1486		destruct e2; red; auto.
1487		Qed.
1488
1489		Lemma equal_more_IfEq :
1490		forall x1 d1 (cont:enumeration elt -> bool) x2 d2 r2 e2 l,
1491		IfEq (cont (cons r2 e2)) l (bindings r2 ++ flatten_e e2) ->
1492		IfEq (equal_more cmp x1 d1 cont (More x2 d2 r2 e2)) ((x1,d1)::l)
1493		(flatten_e (More x2 d2 r2 e2)).
1494		Proof.
1495		unfold IfEq; simpl; intros; destruct X.compare; simpl; auto.
1496		rewrite <-andb_lazy_alt; f_equal; auto.
1497		Qed.
1498
1499		Lemma equal_cont_IfEq : forall m1 cont e2 l,
1500		(forall e, IfEq (cont e) l (flatten_e e)) ->
1501		IfEq (equal_cont cmp m1 cont e2) (bindings m1 ++ l) (flatten_e e2).
1502		Proof.
1503		induction m1 as [\|l1 Hl1 x1 d1 r1 Hr1 h1]; intros; auto.
1504		rewrite <- bindings_node; simpl.
1505		apply Hl1; auto.
1506		clear e2; intros [\|x2 d2 r2 e2].
1507		simpl; red; auto.
1508		apply equal_more_IfEq.
1509		rewrite <- cons_1; auto.
1510		Qed.
1511
1512		Lemma equal_IfEq : forall (m1 m2:t elt),
1513		IfEq (equal cmp m1 m2) (bindings m1) (bindings m2).
1514		Proof.
1515		intros; unfold equal.
1516		rewrite <- (app_nil_r (bindings m1)).
1517		replace (bindings m2) with (flatten_e (cons m2 (End _)))
1518		by (rewrite cons_1; simpl; rewrite app_nil_r; auto).
1519		apply equal_cont_IfEq.
1520		intros.
1521		apply equal_end_IfEq; auto.
1522		Qed.
1523
1524		Definition Equivb m m' :=
1525		(forall k, In k m <-> In k m') /\
1526		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).
1527
1528		Lemma Equivb_bindings : forall s s',
1529		Equivb s s' <-> L.Equivb cmp (bindings s) (bindings s').
1530		Proof.
1531		unfold Equivb, L.Equivb; split; split; intros.
1532		do 2 rewrite bindings_in; firstorder.
1533		destruct H.
1534		apply (H2 k); rewrite <- bindings_mapsto; auto.
1535		do 2 rewrite <- bindings_in; firstorder.
1536		destruct H.
1537		apply (H2 k); unfold L.PX.MapsTo; rewrite bindings_mapsto; auto.
1538		Qed.
1539
1540		Lemma equal_Equivb : forall (s s': t elt), Bst s -> Bst s' ->
1541		(equal cmp s s' = true <-> Equivb s s').
1542		Proof.
1543		intros s s' B B'.
1544		rewrite Equivb_bindings, <- equal_IfEq.
1545		split; [apply L.equal_2\|apply L.equal_1]; auto.
1546		Qed.
1547
1548		End Elt.
1549
1550		Section Map.
1551		Variable elt elt' : Type.
1552		Variable f : elt -> elt'.
1553
1554		Lemma map_spec m x :
1555		find x (map f m) = option_map f (find x m).
1556		Proof.
1557		induction m; simpl; trivial. case X.compare_spec; auto.
1558		Qed.
1559
1560		Lemma map_in m x : x ∈ (map f m) <-> x ∈ m.
1561		Proof.
1562		induction m; simpl; intuition_in.
1563		Qed.
1564
1565		Lemma map_bst m : Bst m -> Bst (map f m).
1566		Proof.
1567		induction m; simpl; auto. intros; inv Bst; constructor; auto.
1568		- apply above. intro. rewrite map_in. intros. order.
1569		- apply below. intro. rewrite map_in. intros. order.
1570		Qed.
1571
1572		End Map.
1573		Section Mapi.
1574		Variable elt elt' : Type.
1575		Variable f : key -> elt -> elt'.
1576
1577		Lemma mapi_spec m x :
1578		exists y:key,
1579		X.eq y x /\ find x (mapi f m) = option_map (f y) (find x m).
1580		Proof.
1581		induction m; simpl.
1582		- now exists x.
1583		- case X.compare_spec; simpl; auto. intros. now exists k.
1584		Qed.
1585
1586		Lemma mapi_in m x : x ∈ (mapi f m) <-> x ∈ m.
1587		Proof.
1588		induction m; simpl; intuition_in.
1589		Qed.
1590
1591		Lemma mapi_bst m : Bst m -> Bst (mapi f m).
1592		Proof.
1593		induction m; simpl; auto. intros; inv Bst; constructor; auto.
1594		- apply above. intro. rewrite mapi_in. intros. order.
1595		- apply below. intro. rewrite mapi_in. intros. order.
1596		Qed.
1597
1598		End Mapi.
1599
1600		Section Mapo.
1601		Variable elt elt' : Type.
1602		Variable f : key -> elt -> option elt'.
1603
1604		Lemma mapo_in m x :
1605		x ∈ (mapo f m) ->
1606		exists y d, X.eq y x /\ MapsTo x d m /\ f y d <> None.
1607		Proof.
1608		functional induction (mapo f m); simpl; auto; intro H.
1609		- inv In.
1610		- rewrite join_in in H; destruct H as [H\|[H\|H]].
1611		+ exists x0, d. do 2 (split; auto). congruence.
1612		+ destruct (IHt H) as (y & e & ? & ? & ?). exists y, e. auto.
1613		+ destruct (IHt0 H) as (y & e & ? & ? & ?). exists y, e. auto.
1614		- rewrite concat_in in H; destruct H as [H\|H].
1615		+ destruct (IHt H) as (y & e & ? & ? & ?). exists y, e. auto.
1616		+ destruct (IHt0 H) as (y & e & ? & ? & ?). exists y, e. auto.
1617		Qed.
1618
1619		Lemma mapo_lt m x : x >> m -> x >> mapo f m.
1620		Proof.
1621		intros H. apply above. intros y Hy.
1622		destruct (mapo_in Hy) as (y' & e & ? & ? & ?). order.
1623		Qed.
1624
1625		Lemma mapo_gt m x : x << m -> x << mapo f m.
1626		Proof.
1627		intros H. apply below. intros y Hy.
1628		destruct (mapo_in Hy) as (y' & e & ? & ? & ?). order.
1629		Qed.
1630		Hint Resolve mapo_lt mapo_gt.
1631
1632		Lemma mapo_bst m : Bst m -> Bst (mapo f m).
1633		Proof.
1634		functional induction (mapo f m); simpl; auto; intro H; inv Bst.
1635		- apply join_bst, create_bst; auto.
1636		- apply concat_bst; auto. apply between with x; auto.
1637		Qed.
1638		Hint Resolve mapo_bst.
1639
1640		Ltac nonify e :=
1641		replace e with (@None elt) by
1642		(symmetry; rewrite not_find_iff; auto; intro; order).
1643
1644		Definition obind {A B} (o:option A) (f:A->option B) :=
1645		match o with Some a => f a \| None => None end.
1646
1647		Lemma mapo_find m x :
1648		Bst m ->
1649		exists y, X.eq y x /\
1650		find x (mapo f m) = obind (find x m) (f y).
1651		Proof.
1652		functional induction (mapo f m); simpl; auto; intros B;
1653		inv Bst.
1654		- now exists x.
1655		- rewrite join_find; auto.
1656		+ simpl. case X.compare_spec; simpl; intros.
1657		* now exists x0.
1658		* destruct IHt as (y' & ? & ?); auto.
1659		exists y'; split; trivial.
1660		* destruct IHt0 as (y' & ? & ?); auto.
1661		exists y'; split; trivial.
1662		+ constructor; auto using mapo_lt, mapo_gt.
1663		- rewrite concat_find; auto.
1664		+ destruct IHt0 as (y' & ? & ->); auto.
1665		destruct IHt as (y'' & ? & ->); auto.
1666		case X.compare_spec; simpl; intros.
1667		* nonify (find x r). nonify (find x l). simpl. now exists x0.
1668		* nonify (find x r). now exists y''.
1669		* nonify (find x l). exists y'. split; trivial.
1670		destruct (find x r); simpl; trivial.
1671		now destruct (f y' e).
1672		+ apply between with x0; auto.
1673		Qed.
1674
1675		End Mapo.
1676
1677		Section Gmerge.
1678		Variable elt elt' elt'' : Type.
1679		Variable f0 : key -> option elt -> option elt' -> option elt''.
1680		Variable f : key -> elt -> option elt' -> option elt''.
1681		Variable mapl : t elt -> t elt''.
1682		Variable mapr : t elt' -> t elt''.
1683		Hypothesis f0_f : forall x d o, f x d o = f0 x (Some d) o.
1684		Hypothesis mapl_bst : forall m, Bst m -> Bst (mapl m).
1685		Hypothesis mapr_bst : forall m', Bst m' -> Bst (mapr m').
1686		Hypothesis mapl_f0 : forall x m, Bst m ->
1687		exists y, X.eq y x /\
1688		find x (mapl m) = obind (find x m) (fun d => f0 y (Some d) None).
1689		Hypothesis mapr_f0 : forall x m, Bst m ->
1690		exists y, X.eq y x /\
1691		find x (mapr m) = obind (find x m) (fun d => f0 y None (Some d)).
1692
1693		Notation gmerge := (gmerge f mapl mapr).
1694
1695		Lemma gmerge_in m m' y : Bst m -> Bst m' ->
1696		y ∈ (gmerge m m') -> y ∈ m \/ y ∈ m'.
1697		Proof.
1698		functional induction (gmerge m m'); intros B1 B2 H;
1699		try factornode m2; inv Bst.
1700		- right. apply find_in.
1701		generalize (in_find (mapr_bst B2) H).
1702		destruct (@mapr_f0 y m2) as (y' & ? & ->); trivial.
1703		intros A B. rewrite B in A. now elim A.
1704		- left. apply find_in.
1705		generalize (in_find (mapl_bst B1) H).
1706		destruct (@mapl_f0 y m2) as (y' & ? & ->); trivial.
1707		intros A B. rewrite B in A. now elim A.
1708		- rewrite join_in in *. revert IHt1 IHt0 H. cleansplit.
1709		generalize (split_bst_l x1 B2) (split_bst_r x1 B2).
1710		rewrite split_in_r, split_in_l; intuition_in.
1711		- rewrite concat_in in *. revert IHt1 IHt0 H; cleansplit.
1712		generalize (split_bst_l x1 B2) (split_bst_r x1 B2).
1713		rewrite split_in_r, split_in_l; intuition_in.
1714		Qed.
1715
1716		Lemma gmerge_lt m m' x : Bst m -> Bst m' ->
1717		x >> m -> x >> m' -> x >> gmerge m m'.
1718		Proof.
1719		intros. apply above. intros y Hy.
1720		apply gmerge_in in Hy; intuition_in; order.
1721		Qed.
1722
1723		Lemma gmerge_gt m m' x : Bst m -> Bst m' ->
1724		x << m -> x << m' -> x << gmerge m m'.
1725		Proof.
1726		intros. apply below. intros y Hy.
1727		apply gmerge_in in Hy; intuition_in; order.
1728		Qed.
1729		Hint Resolve gmerge_lt gmerge_gt.
1730		Hint Resolve split_bst_l split_bst_r split_lt_l split_gt_r.
1731
1732		Lemma gmerge_bst m m' : Bst m -> Bst m' -> Bst (gmerge m m').
1733		Proof.
1734		functional induction (gmerge m m'); intros B1 B2; auto;
1735		factornode m2; inv Bst;
1736		(apply join_bst, create_bst \|\| apply concat_bst);
1737		revert IHt1 IHt0; cleansplit; intuition.
1738		apply between with x1; auto.
1739		Qed.
1740		Hint Resolve gmerge_bst.
1741
1742		Lemma oelse_none_r {A} (o:option A) : oelse o None = o.
1743		Proof. now destruct o. Qed.
1744
1745		Ltac nonify e :=
1746		let E := fresh "E" in
1747		assert (E : e = None);
1748		[ rewrite not_find_iff; auto; intro U;
1749		try apply gmerge_in in U; intuition_in; order
1750		\| rewrite E; clear E ].
1751
1752		Lemma gmerge_find m m' x : Bst m -> Bst m' ->
1753		In x m \/ In x m' ->
1754		exists y, X.eq y x /\
1755		find x (gmerge m m') = f0 y (find x m) (find x m').
1756		Proof.
1757		functional induction (gmerge m m'); intros B1 B2 H;
1758		try factornode m2; inv Bst.
1759		- destruct H; [ intuition_in \| ].
1760		destruct (@mapr_f0 x m2) as (y,(Hy,E)); trivial.
1761		exists y; split; trivial.
1762		rewrite E. simpl. apply in_find in H; trivial.
1763		destruct (find x m2); simpl; intuition.
1764		- destruct H; [ \| intuition_in ].
1765		destruct (@mapl_f0 x m2) as (y,(Hy,E)); trivial.
1766		exists y; split; trivial.
1767		rewrite E. simpl. apply in_find in H; trivial.
1768		destruct (find x m2); simpl; intuition.
1769		- generalize (split_bst_l x1 B2) (split_bst_r x1 B2).
1770		rewrite (split_find x1 x B2).
1771		rewrite e1 in ; simpl in . intros.
1772		rewrite join_find by (cleansplit; constructor; auto).
1773		simpl. case X.compare_spec; intros.
1774		+ exists x1. split; auto. now rewrite <- e3, f0_f.
1775		+ apply IHt1; auto. clear IHt1 IHt0.
1776		cleansplit; rewrite split_in_l; trivial.
1777		intuition_in; order.
1778		+ apply IHt0; auto. clear IHt1 IHt0.
1779		cleansplit; rewrite split_in_r; trivial.
1780		intuition_in; order.
1781		- generalize (split_bst_l x1 B2) (split_bst_r x1 B2).
1782		rewrite (split_find x1 x B2).
1783		pose proof (split_lt_l x1 B2).
1784		pose proof (split_gt_r x1 B2).
1785		rewrite e1 in ; simpl in . intros.
1786		rewrite concat_find by (try apply between with x1; auto).
1787		case X.compare_spec; intros.
1788		+ clear IHt0 IHt1.
1789		exists x1. split; auto. rewrite <- f0_f, e2.
1790		nonify (find x (gmerge r1 r2')).
1791		nonify (find x (gmerge l1 l2')). trivial.
1792		+ nonify (find x (gmerge r1 r2')).
1793		simpl. apply IHt1; auto. clear IHt1 IHt0.
1794		intuition_in; try order.
1795		right. cleansplit. now apply split_in_l.
1796		+ nonify (find x (gmerge l1 l2')). simpl.
1797		rewrite oelse_none_r.
1798		apply IHt0; auto. clear IHt1 IHt0.
1799		intuition_in; try order.
1800		right. cleansplit. now apply split_in_r.
1801		Qed.
1802
1803		End Gmerge.
1804
1805		Section Merge.
1806		Variable elt elt' elt'' : Type.
1807		Variable f : key -> option elt -> option elt' -> option elt''.
1808
1809		Lemma merge_bst m m' : Bst m -> Bst m' -> Bst (merge f m m').
1810		Proof.
1811		unfold merge; intros.
1812		apply gmerge_bst with f;
1813		auto using mapo_bst, mapo_find.
1814		Qed.
1815
1816		Lemma merge_spec1 m m' x : Bst m -> Bst m' ->
1817		In x m \/ In x m' ->
1818		exists y, X.eq y x /\
1819		find x (merge f m m') = f y (find x m) (find x m').
1820		Proof.
1821		unfold merge; intros.
1822		edestruct (gmerge_find (f0:=f)) as (y,(Hy,E));
1823		eauto using mapo_bst.
1824		- reflexivity.
1825		- intros. now apply mapo_find.
1826		- intros. now apply mapo_find.
1827		Qed.
1828
1829		Lemma merge_spec2 m m' x : Bst m -> Bst m' ->
1830		In x (merge f m m') -> In x m \/ In x m'.
1831		Proof.
1832		unfold merge; intros.
1833		eapply gmerge_in with (f0:=f); try eassumption;
1834		auto using mapo_bst, mapo_find.
1835		Qed.
1836
1837		End Merge.
1838		End Proofs.
1839		End Raw.
1840
1841		(** * Encapsulation
1842
1843		Now, in order to really provide a functor implementing [S], we
1844		need to encapsulate everything into a type of balanced binary search trees. *)
1845
1846		Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X.
1847
1848		Module E := X.
1849		Module Raw := Raw I X.
1850		Import Raw.Proofs.
1851
1852		Record tree (elt:Type) :=
1853		Mk {this :> Raw.tree elt; is_bst : Raw.Bst this}.
1854
1855		Definition t := tree.
1856		Definition key := E.t.
1857
1858		Section Elt.
1859		Variable elt elt' elt'': Type.
1860
1861		Implicit Types m : t elt.
1862		Implicit Types x y : key.
1863		Implicit Types e : elt.
1864
1865		Definition empty : t elt := Mk (empty_bst elt).
1866		Definition is_empty m : bool := Raw.is_empty m.(this).
1867		Definition add x e m : t elt := Mk (add_bst x e m.(is_bst)).
1868		Definition remove x m : t elt := Mk (remove_bst x m.(is_bst)).
1869		Definition mem x m : bool := Raw.mem x m.(this).
1870		Definition find x m : option elt := Raw.find x m.(this).
1871		Definition map f m : t elt' := Mk (map_bst f m.(is_bst)).
1872		Definition mapi (f:key->elt->elt') m : t elt' :=
1873		Mk (mapi_bst f m.(is_bst)).
1874		Definition merge f m (m':t elt') : t elt'' :=
1875		Mk (merge_bst f m.(is_bst) m'.(is_bst)).
1876		Definition bindings m : list (key*elt) := Raw.bindings m.(this).
1877		Definition cardinal m := Raw.cardinal m.(this).
1878		Definition fold {A} (f:key->elt->A->A) m i := Raw.fold (A:=A) f m.(this) i.
1879		Definition equal cmp m m' : bool := Raw.equal cmp m.(this) m'.(this).
1880
1881		Definition MapsTo x e m : Prop := Raw.MapsTo x e m.(this).
1882		Definition In x m : Prop := Raw.In0 x m.(this).
1883
1884		Definition eq_key : (keyelt) -> (keyelt) -> Prop := @PX.eqk elt.
1885		Definition eq_key_elt : (keyelt) -> (keyelt) -> Prop := @PX.eqke elt.
1886		Definition lt_key : (keyelt) -> (keyelt) -> Prop := @PX.ltk elt.
1887
1888		Instance MapsTo_compat :
1889		Proper (E.eq==>Logic.eq==>Logic.eq==>iff) MapsTo.
1890		Proof.
1891		intros k k' Hk e e' He m m' Hm. unfold MapsTo; simpl.
1892		now rewrite Hk, He, Hm.
1893		Qed.
1894
1895		Lemma find_spec m x e : find x m = Some e <-> MapsTo x e m.
1896		Proof. apply find_spec. apply is_bst. Qed.
1897
1898		Lemma mem_spec m x : mem x m = true <-> In x m.
1899		Proof.
1900		unfold In, mem; rewrite In_alt. apply mem_spec. apply is_bst.
1901		Qed.
1902
1903		Lemma empty_spec x : find x empty = None.
1904		Proof. apply empty_spec. Qed.
1905
1906		Lemma is_empty_spec m : is_empty m = true <-> forall x, find x m = None.
1907		Proof. apply is_empty_spec. Qed.
1908
1909		Lemma add_spec1 m x e : find x (add x e m) = Some e.
1910		Proof. apply add_spec1. apply is_bst. Qed.
1911		Lemma add_spec2 m x y e : ~ E.eq x y -> find y (add x e m) = find y m.
1912		Proof. apply add_spec2. apply is_bst. Qed.
1913
1914		Lemma remove_spec1 m x : find x (remove x m) = None.
1915		Proof. apply remove_spec1. apply is_bst. Qed.
1916		Lemma remove_spec2 m x y : ~E.eq x y -> find y (remove x m) = find y m.
1917		Proof. apply remove_spec2. apply is_bst. Qed.
1918
1919		Lemma bindings_spec1 m x e :
1920		InA eq_key_elt (x,e) (bindings m) <-> MapsTo x e m.
1921		Proof. apply bindings_mapsto. Qed.
1922
1923		Lemma bindings_spec2 m : sort lt_key (bindings m).
1924		Proof. apply bindings_sort. apply is_bst. Qed.
1925
1926		Lemma bindings_spec2w m : NoDupA eq_key (bindings m).
1927		Proof. apply bindings_nodup. apply is_bst. Qed.
1928
1929		Lemma fold_spec m {A} (i : A) (f : key -> elt -> A -> A) :
1930		fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.
1931		Proof. apply fold_spec. apply is_bst. Qed.
1932
1933		Lemma cardinal_spec m : cardinal m = length (bindings m).
1934		Proof. apply bindings_cardinal. Qed.
1935
1936		Definition Equal m m' := forall y, find y m = find y m'.
1937		Definition Equiv (eq_elt:elt->elt->Prop) m m' :=
1938		(forall k, In k m <-> In k m') /\
1939		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e').
1940		Definition Equivb cmp := Equiv (Cmp cmp).
1941
1942		Lemma Equivb_Equivb cmp m m' :
1943		Equivb cmp m m' <-> Raw.Proofs.Equivb cmp m m'.
1944		Proof.
1945		unfold Equivb, Equiv, Raw.Proofs.Equivb, In. intuition.
1946		generalize (H0 k); do 2 rewrite In_alt; intuition.
1947		generalize (H0 k); do 2 rewrite In_alt; intuition.
1948		generalize (H0 k); do 2 rewrite <- In_alt; intuition.
1949		generalize (H0 k); do 2 rewrite <- In_alt; intuition.
1950		Qed.
1951
1952		Lemma equal_spec m m' cmp :
1953		equal cmp m m' = true <-> Equivb cmp m m'.
1954		Proof. rewrite Equivb_Equivb. apply equal_Equivb; apply is_bst. Qed.
1955
1956		End Elt.
1957
1958		Lemma map_spec {elt elt'} (f:elt->elt') m x :
1959		find x (map f m) = option_map f (find x m).
1960		Proof. apply map_spec. Qed.
1961
1962		Lemma mapi_spec {elt elt'} (f:key->elt->elt') m x :
1963		exists y:key, E.eq y x /\ find x (mapi f m) = option_map (f y) (find x m).
1964		Proof. apply mapi_spec. Qed.
1965
1966		Lemma merge_spec1 {elt elt' elt''}
1967		(f:key->option elt->option elt'->option elt'') m m' x :
1968		In x m \/ In x m' ->
1969		exists y:key, E.eq y x /\
1970		find x (merge f m m') = f y (find x m) (find x m').
1971		Proof.
1972		unfold In. rewrite !In_alt. apply merge_spec1; apply is_bst.
1973		Qed.
1974
1975		Lemma merge_spec2 {elt elt' elt''}
1976		(f:key -> option elt->option elt'->option elt'') m m' x :
1977		In x (merge f m m') -> In x m \/ In x m'.
1978		Proof.
1979		unfold In. rewrite !In_alt. apply merge_spec2; apply is_bst.
1980		Qed.
1981
1982		End IntMake.
1983
1984
1985		Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <:
1986		Sord with Module Data := D
1987		with Module MapS.E := X.
1988
1989		Module Data := D.
1990		Module Import MapS := IntMake(I)(X).
1991		Module LO := MMapList.Make_ord(X)(D).
1992		Module R := Raw.
1993		Module P := Raw.Proofs.
1994
1995		Definition t := MapS.t D.t.
1996
1997		Definition cmp e e' :=
1998		match D.compare e e' with Eq => true \| _ => false end.
1999
2000		(** One step of comparison of bindings *)
2001
2002		Definition compare_more x1 d1 (cont:R.enumeration D.t -> comparison) e2 :=
2003		match e2 with
2004		\| R.End _ => Gt
2005		\| R.More x2 d2 r2 e2 =>
2006		match X.compare x1 x2 with
2007		\| Eq => match D.compare d1 d2 with
2008		\| Eq => cont (R.cons r2 e2)
2009		\| Lt => Lt
2010		\| Gt => Gt
2011		end
2012		\| Lt => Lt
2013		\| Gt => Gt
2014		end
2015		end.
2016
2017		(** Comparison of left tree, middle element, then right tree *)
2018
2019		Fixpoint compare_cont s1 (cont:R.enumeration D.t -> comparison) e2 :=
2020		match s1 with
2021		\| R.Leaf _ => cont e2
2022		\| R.Node l1 x1 d1 r1 _ =>
2023		compare_cont l1 (compare_more x1 d1 (compare_cont r1 cont)) e2
2024		end.
2025
2026		(** Initial continuation *)
2027
2028		Definition compare_end (e2:R.enumeration D.t) :=
2029		match e2 with R.End _ => Eq \| _ => Lt end.
2030
2031		(** The complete comparison *)
2032
2033		Definition compare m1 m2 :=
2034		compare_cont m1.(this) compare_end (R.cons m2 .(this) (Raw.End _)).
2035
2036		(** Correctness of this comparison *)
2037
2038		Definition Cmp c :=
2039		match c with
2040		\| Eq => LO.eq_list
2041		\| Lt => LO.lt_list
2042		\| Gt => (fun l1 l2 => LO.lt_list l2 l1)
2043		end.
2044
2045		Lemma cons_Cmp c x1 x2 d1 d2 l1 l2 :
2046		X.eq x1 x2 -> D.eq d1 d2 ->
2047		Cmp c l1 l2 -> Cmp c ((x1,d1)::l1) ((x2,d2)::l2).
2048		Proof.
2049		destruct c; simpl; intros; case X.compare_spec; auto; try P.MX.order.
2050		intros. right. split; auto. now symmetry.
2051		Qed.
2052		Hint Resolve cons_Cmp.
2053
2054		Lemma compare_end_Cmp e2 :
2055		Cmp (compare_end e2) nil (P.flatten_e e2).
2056		Proof.
2057		destruct e2; simpl; auto.
2058		Qed.
2059
2060		Lemma compare_more_Cmp x1 d1 cont x2 d2 r2 e2 l :
2061		Cmp (cont (R.cons r2 e2)) l (R.bindings r2 ++ P.flatten_e e2) ->
2062		Cmp (compare_more x1 d1 cont (R.More x2 d2 r2 e2)) ((x1,d1)::l)
2063		(P.flatten_e (R.More x2 d2 r2 e2)).
2064		Proof.
2065		simpl; case X.compare_spec; simpl;
2066		try case D.compare_spec; simpl; auto;
2067		case X.compare_spec; try P.MX.order; auto.
2068		Qed.
2069
2070		Lemma compare_cont_Cmp : forall s1 cont e2 l,
2071		(forall e, Cmp (cont e) l (P.flatten_e e)) ->
2072		Cmp (compare_cont s1 cont e2) (R.bindings s1 ++ l) (P.flatten_e e2).
2073		Proof.
2074		induction s1 as [\|l1 Hl1 x1 d1 r1 Hr1 h1] using P.tree_ind;
2075		intros; auto.
2076		rewrite <- P.bindings_node; simpl.
2077		apply Hl1; auto. clear e2. intros [\|x2 d2 r2 e2].
2078		simpl; auto.
2079		apply compare_more_Cmp.
2080		rewrite <- P.cons_1; auto.
2081		Qed.
2082
2083		Lemma compare_Cmp m1 m2 :
2084		Cmp (compare m1 m2) (bindings m1) (bindings m2).
2085		Proof.
2086		destruct m1 as (s1,H1), m2 as (s2,H2).
2087		unfold compare, bindings; simpl.
2088		rewrite <- (app_nil_r (R.bindings s1)).
2089		replace (R.bindings s2) with (P.flatten_e (R.cons s2 (R.End _))) by
2090		(rewrite P.cons_1; simpl; rewrite app_nil_r; auto).
2091		auto using compare_cont_Cmp, compare_end_Cmp.
2092		Qed.
2093
2094		Definition eq (m1 m2 : t) := LO.eq_list (bindings m1) (bindings m2).
2095		Definition lt (m1 m2 : t) := LO.lt_list (bindings m1) (bindings m2).
2096
2097		Lemma compare_spec m1 m2 : CompSpec eq lt m1 m2 (compare m1 m2).
2098		Proof.
2099		assert (H := compare_Cmp m1 m2).
2100		unfold Cmp in H.
2101		destruct (compare m1 m2); auto.
2102		Qed.
2103
2104		(* Proofs about [eq] and [lt] *)
2105
2106		Definition sbindings (m1 : t) :=
2107		LO.MapS.Mk (P.bindings_sort m1.(is_bst)).
2108
2109		Definition seq (m1 m2 : t) := LO.eq (sbindings m1) (sbindings m2).
2110		Definition slt (m1 m2 : t) := LO.lt (sbindings m1) (sbindings m2).
2111
2112		Lemma eq_seq : forall m1 m2, eq m1 m2 <-> seq m1 m2.
2113		Proof.
2114		unfold eq, seq, sbindings, bindings, LO.eq; intuition.
2115		Qed.
2116
2117		Lemma lt_slt : forall m1 m2, lt m1 m2 <-> slt m1 m2.
2118		Proof.
2119		unfold lt, slt, sbindings, bindings, LO.lt; intuition.
2120		Qed.
2121
2122		Lemma eq_spec m m' : eq m m' <-> Equivb cmp m m'.
2123		Proof.
2124		rewrite eq_seq; unfold seq.
2125		rewrite Equivb_Equivb.
2126		rewrite P.Equivb_bindings. apply LO.eq_spec.
2127		Qed.
2128
2129		Instance eq_equiv : Equivalence eq.
2130		Proof.
2131		constructor; red; [intros x\|intros x y\| intros x y z];
2132		rewrite !eq_seq; apply LO.eq_equiv.
2133		Qed.
2134
2135		Instance lt_compat : Proper (eq ==> eq ==> iff) lt.
2136		Proof.
2137		intros m1 m2 H1 m1' m2' H2. rewrite !lt_slt. rewrite eq_seq in *.
2138		now apply LO.lt_compat.
2139		Qed.
2140
2141		Instance lt_strorder : StrictOrder lt.
2142		Proof.
2143		constructor; red; [intros x; red\|intros x y z];
2144		rewrite !lt_slt; apply LO.lt_strorder.
2145		Qed.
2146
2147		End IntMake_ord.
2148
2149		(* For concrete use inside Coq, we propose an instantiation of [Int] by [Z]. *)
2150
2151		Module Make (X: OrderedType) <: S with Module E := X
2152		:=IntMake(Z_as_Int)(X).
2153
2154		Module Make_ord (X: OrderedType)(D: OrderedType)
2155		<: Sord with Module Data := D
2156		with Module MapS.E := X
2157		:=IntMake_ord(Z_as_Int)(X)(D).

+0

-2434

~~theories/MMaps/MMapFacts.v~~ less more

0		(***********************************************************************)
1		(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
3		(* \VV/ *************************************************************)
4		(* // * This file is distributed under the terms of the *)
5		(* * GNU Lesser General Public License Version 2.1 *)
6		(***********************************************************************)
7
8		(** * Finite maps library *)
9
10		(** This functor derives additional facts from [MMapInterface.S]. These
11		facts are mainly the specifications of [MMapInterface.S] written using
12		different styles: equivalence and boolean equalities.
13		*)
14
15		Require Import Bool Equalities Orders OrdersFacts OrdersLists.
16		Require Import Morphisms Permutation SetoidPermutation.
17		Require Export MMapInterface.
18		Set Implicit Arguments.
19		Unset Strict Implicit.
20
21		Lemma eq_bool_alt b b' : b=b' <-> (b=true <-> b'=true).
22		Proof.
23		destruct b, b'; intuition.
24		Qed.
25
26		Lemma eq_option_alt {elt}(o o':option elt) :
27		o=o' <-> (forall e, o=Some e <-> o'=Some e).
28		Proof.
29		split; intros.
30		- now subst.
31		- destruct o, o'; rewrite ?H; auto.
32		symmetry; now apply H.
33		Qed.
34
35		Lemma option_map_some {A B}(f:A->B) o :
36		option_map f o <> None <-> o <> None.
37		Proof.
38		destruct o; simpl. now split. split; now destruct 1.
39		Qed.
40
41		(** * Properties about weak maps *)
42
43		Module WProperties_fun (E:DecidableType)(Import M:WSfun E).
44
45		Definition Empty {elt}(m : t elt) := forall x e, ~MapsTo x e m.
46
47		(** A few things about E.eq *)
48
49		Lemma eq_refl x : E.eq x x. Proof. apply E.eq_equiv. Qed.
50		Lemma eq_sym x y : E.eq x y -> E.eq y x. Proof. apply E.eq_equiv. Qed.
51		Lemma eq_trans x y z : E.eq x y -> E.eq y z -> E.eq x z.
52		Proof. apply E.eq_equiv. Qed.
53		Hint Immediate eq_refl eq_sym : map.
54		Hint Resolve eq_trans eq_equivalence E.eq_equiv : map.
55
56		Definition eqb x y := if E.eq_dec x y then true else false.
57
58		Lemma eqb_eq x y : eqb x y = true <-> E.eq x y.
59		Proof.
60		unfold eqb; case E.eq_dec; now intuition.
61		Qed.
62
63		Lemma eqb_sym x y : eqb x y = eqb y x.
64		Proof.
65		apply eq_bool_alt. rewrite !eqb_eq. split; apply E.eq_equiv.
66		Qed.
67
68		(** Initial results about MapsTo and In *)
69
70		Lemma mapsto_fun {elt} m x (e e':elt) :
71		MapsTo x e m -> MapsTo x e' m -> e=e'.
72		Proof.
73		rewrite <- !find_spec. congruence.
74		Qed.
75
76		Lemma in_find {elt} (m : t elt) x : In x m <-> find x m <> None.
77		Proof.
78		unfold In. split.
79		- intros (e,H). rewrite <-find_spec in H. congruence.
80		- destruct (find x m) as [e\|] eqn:H.
81		+ exists e. now apply find_spec.
82		+ now destruct 1.
83		Qed.
84
85		Lemma not_in_find {elt} (m : t elt) x : ~In x m <-> find x m = None.
86		Proof.
87		rewrite in_find. split; auto.
88		intros; destruct (find x m); trivial. now destruct H.
89		Qed.
90
91		Notation in_find_iff := in_find (only parsing).
92		Notation not_find_in_iff := not_in_find (only parsing).
93
94		(** * [Equal] is a setoid equality. *)
95
96		Infix "==" := Equal (at level 30).
97
98		Lemma Equal_refl {elt} (m : t elt) : m == m.
99		Proof. red; reflexivity. Qed.
100
101		Lemma Equal_sym {elt} (m m' : t elt) : m == m' -> m' == m.
102		Proof. unfold Equal; auto. Qed.
103
104		Lemma Equal_trans {elt} (m m' m'' : t elt) :
105		m == m' -> m' == m'' -> m == m''.
106		Proof. unfold Equal; congruence. Qed.
107
108		Instance Equal_equiv {elt} : Equivalence (@Equal elt).
109		Proof.
110		constructor; [exact Equal_refl \| exact Equal_sym \| exact Equal_trans].
111		Qed.
112
113		Arguments Equal {elt} m m'.
114
115		Instance MapsTo_m {elt} :
116		Proper (E.eq==>Logic.eq==>Equal==>iff) (@MapsTo elt).
117		Proof.
118		intros k k' Hk e e' <- m m' Hm. rewrite <- Hk.
119		now rewrite <- !find_spec, Hm.
120		Qed.
121
122		Instance In_m {elt} :
123		Proper (E.eq==>Equal==>iff) (@In elt).
124		Proof.
125		intros k k' Hk m m' Hm. unfold In.
126		split; intros (e,H); exists e; revert H;
127		now rewrite Hk, <- !find_spec, Hm.
128		Qed.
129
130		Instance find_m {elt} : Proper (E.eq==>Equal==>Logic.eq) (@find elt).
131		Proof.
132		intros k k' Hk m m' <-.
133		rewrite eq_option_alt. intros. now rewrite !find_spec, Hk.
134		Qed.
135
136		Instance mem_m {elt} : Proper (E.eq==>Equal==>Logic.eq) (@mem elt).
137		Proof.
138		intros k k' Hk m m' Hm. now rewrite eq_bool_alt, !mem_spec, Hk, Hm.
139		Qed.
140
141		Instance Empty_m {elt} : Proper (Equal==>iff) (@Empty elt).
142		Proof.
143		intros m m' Hm. unfold Empty. now setoid_rewrite Hm.
144		Qed.
145
146		Instance is_empty_m {elt} : Proper (Equal ==> Logic.eq) (@is_empty elt).
147		Proof.
148		intros m m' Hm. rewrite eq_bool_alt, !is_empty_spec.
149		now setoid_rewrite Hm.
150		Qed.
151
152		Instance add_m {elt} : Proper (E.eq==>Logic.eq==>Equal==>Equal) (@add elt).
153		Proof.
154		intros k k' Hk e e' <- m m' Hm y.
155		destruct (E.eq_dec k y) as [H\|H].
156		- rewrite <-H, add_spec1. now rewrite Hk, add_spec1.
157		- rewrite !add_spec2; trivial. now rewrite <- Hk.
158		Qed.
159
160		Instance remove_m {elt} : Proper (E.eq==>Equal==>Equal) (@remove elt).
161		Proof.
162		intros k k' Hk m m' Hm y.
163		destruct (E.eq_dec k y) as [H\|H].
164		- rewrite <-H, remove_spec1. now rewrite Hk, remove_spec1.
165		- rewrite !remove_spec2; trivial. now rewrite <- Hk.
166		Qed.
167
168		Instance map_m {elt elt'} :
169		Proper ((Logic.eq==>Logic.eq)==>Equal==>Equal) (@map elt elt').
170		Proof.
171		intros f f' Hf m m' Hm y. rewrite !map_spec, Hm.
172		destruct (find y m'); simpl; trivial. f_equal. now apply Hf.
173		Qed.
174
175		Instance mapi_m {elt elt'} :
176		Proper ((E.eq==>Logic.eq==>Logic.eq)==>Equal==>Equal) (@mapi elt elt').
177		Proof.
178		intros f f' Hf m m' Hm y.
179		destruct (mapi_spec f m y) as (x,(Hx,->)).
180		destruct (mapi_spec f' m' y) as (x',(Hx',->)).
181		rewrite <- Hm. destruct (find y m); trivial. simpl.
182		f_equal. apply Hf; trivial. now rewrite Hx, Hx'.
183		Qed.
184
185		Instance merge_m {elt elt' elt''} :
186		Proper ((E.eq==>Logic.eq==>Logic.eq==>Logic.eq)==>Equal==>Equal==>Equal)
187		(@merge elt elt' elt'').
188		Proof.
189		intros f f' Hf m1 m1' Hm1 m2 m2' Hm2 y.
190		destruct (find y m1) as [e1\|] eqn:H1.
191		- apply find_spec in H1.
192		assert (H : In y m1 \/ In y m2) by (left; now exists e1).
193		destruct (merge_spec1 f H) as (y1,(Hy1,->)).
194		rewrite Hm1,Hm2 in H.
195		destruct (merge_spec1 f' H) as (y2,(Hy2,->)).
196		rewrite <- Hm1, <- Hm2. apply Hf; trivial. now transitivity y.
197		- destruct (find y m2) as [e2\|] eqn:H2.
198		+ apply find_spec in H2.
199		assert (H : In y m1 \/ In y m2) by (right; now exists e2).
200		destruct (merge_spec1 f H) as (y1,(Hy1,->)).
201		rewrite Hm1,Hm2 in H.
202		destruct (merge_spec1 f' H) as (y2,(Hy2,->)).
203		rewrite <- Hm1, <- Hm2. apply Hf; trivial. now transitivity y.
204		+ apply not_in_find in H1. apply not_in_find in H2.
205		assert (H : ~In y (merge f m1 m2)).
206		{ intro H. apply merge_spec2 in H. intuition. }
207		apply not_in_find in H. rewrite H.
208		symmetry. apply not_in_find. intro H'.
209		apply merge_spec2 in H'. rewrite <- Hm1, <- Hm2 in H'.
210		intuition.
211		Qed.
212
213		(* Later: compatibility for cardinal, fold, ... *)
214
215		( Earlier specifications (cf. FMaps) *)
216
217		Section OldSpecs.
218		Variable elt: Type.
219		Implicit Type m: t elt.
220		Implicit Type x y z: key.
221		Implicit Type e: elt.
222
223		Lemma MapsTo_1 m x y e : E.eq x y -> MapsTo x e m -> MapsTo y e m.
224		Proof.
225		now intros ->.
226		Qed.
227
228		Lemma find_1 m x e : MapsTo x e m -> find x m = Some e.
229		Proof. apply find_spec. Qed.
230
231		Lemma find_2 m x e : find x m = Some e -> MapsTo x e m.
232		Proof. apply find_spec. Qed.
233
234		Lemma mem_1 m x : In x m -> mem x m = true.
235		Proof. apply mem_spec. Qed.
236
237		Lemma mem_2 m x : mem x m = true -> In x m.
238		Proof. apply mem_spec. Qed.
239
240		Lemma empty_1 : Empty (@empty elt).
241		Proof.
242		intros x e. now rewrite <- find_spec, empty_spec.
243		Qed.
244
245		Lemma is_empty_1 m : Empty m -> is_empty m = true.
246		Proof.
247		unfold Empty; rewrite is_empty_spec. setoid_rewrite <- find_spec.
248		intros H x. specialize (H x).
249		destruct (find x m) as [e\|]; trivial.
250		now destruct (H e).
251		Qed.
252
253		Lemma is_empty_2 m : is_empty m = true -> Empty m.
254		Proof.
255		rewrite is_empty_spec. intros H x e. now rewrite <- find_spec, H.
256		Qed.
257
258		Lemma add_1 m x y e : E.eq x y -> MapsTo y e (add x e m).
259		Proof.
260		intros <-. rewrite <-find_spec. apply add_spec1.
261		Qed.
262
263		Lemma add_2 m x y e e' :
264		~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
265		Proof.
266		intro. now rewrite <- !find_spec, add_spec2.
267		Qed.
268
269		Lemma add_3 m x y e e' :
270		~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
271		Proof.
272		intro. rewrite <- !find_spec, add_spec2; trivial.
273		Qed.
274
275		Lemma remove_1 m x y : E.eq x y -> ~ In y (remove x m).
276		Proof.
277		intros <-. apply not_in_find. apply remove_spec1.
278		Qed.
279
280		Lemma remove_2 m x y e :
281		~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
282		Proof.
283		intro. now rewrite <- !find_spec, remove_spec2.
284		Qed.
285
286		Lemma remove_3bis m x y e :
287		find y (remove x m) = Some e -> find y m = Some e.
288		Proof.
289		destruct (E.eq_dec x y) as [<-\|H].
290		- now rewrite remove_spec1.
291		- now rewrite remove_spec2.
292		Qed.
293
294		Lemma remove_3 m x y e : MapsTo y e (remove x m) -> MapsTo y e m.
295		Proof.
296		rewrite <-!find_spec. apply remove_3bis.
297		Qed.
298
299		Lemma bindings_1 m x e :
300		MapsTo x e m -> InA eq_key_elt (x,e) (bindings m).
301		Proof. apply bindings_spec1. Qed.
302
303		Lemma bindings_2 m x e :
304		InA eq_key_elt (x,e) (bindings m) -> MapsTo x e m.
305		Proof. apply bindings_spec1. Qed.
306
307		Lemma bindings_3w m : NoDupA eq_key (bindings m).
308		Proof. apply bindings_spec2w. Qed.
309
310		Lemma cardinal_1 m : cardinal m = length (bindings m).
311		Proof. apply cardinal_spec. Qed.
312
313		Lemma fold_1 m (A : Type) (i : A) (f : key -> elt -> A -> A) :
314		fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.
315		Proof. apply fold_spec. Qed.
316
317		Lemma equal_1 m m' cmp : Equivb cmp m m' -> equal cmp m m' = true.
318		Proof. apply equal_spec. Qed.
319
320		Lemma equal_2 m m' cmp : equal cmp m m' = true -> Equivb cmp m m'.
321		Proof. apply equal_spec. Qed.
322
323		End OldSpecs.
324
325		Lemma map_1 {elt elt'}(m: t elt)(x:key)(e:elt)(f:elt->elt') :
326		MapsTo x e m -> MapsTo x (f e) (map f m).
327		Proof.
328		rewrite <- !find_spec, map_spec. now intros ->.
329		Qed.
330
331		Lemma map_2 {elt elt'}(m: t elt)(x:key)(f:elt->elt') :
332		In x (map f m) -> In x m.
333		Proof.
334		rewrite !in_find, map_spec. apply option_map_some.
335		Qed.
336
337		Lemma mapi_1 {elt elt'}(m: t elt)(x:key)(e:elt)(f:key->elt->elt') :
338		MapsTo x e m ->
339		exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m).
340		Proof.
341		destruct (mapi_spec f m x) as (y,(Hy,Eq)).
342		intro H. exists y; split; trivial.
343		rewrite <-find_spec in *. now rewrite Eq, H.
344		Qed.
345
346		Lemma mapi_2 {elt elt'}(m: t elt)(x:key)(f:key->elt->elt') :
347		In x (mapi f m) -> In x m.
348		Proof.
349		destruct (mapi_spec f m x) as (y,(Hy,Eq)).
350		rewrite !in_find. intro H; contradict H. now rewrite Eq, H.
351		Qed.
352
353		(** The ancestor [map2] of the current [merge] was dealing with functions
354		on datas only, not on keys. *)
355
356		Definition map2 {elt elt' elt''} (f:option elt->option elt'->option elt'')
357		:= merge (fun _ => f).
358
359		Lemma map2_1 {elt elt' elt''}(m: t elt)(m': t elt')
360		(x:key)(f:option elt->option elt'->option elt'') :
361		In x m \/ In x m' ->
362		find x (map2 f m m') = f (find x m) (find x m').
363		Proof.
364		intros. unfold map2.
365		now destruct (merge_spec1 (fun _ => f) H) as (y,(_,->)).
366		Qed.
367
368		Lemma map2_2 {elt elt' elt''}(m: t elt)(m': t elt')
369		(x:key)(f:option elt->option elt'->option elt'') :
370		In x (map2 f m m') -> In x m \/ In x m'.
371		Proof. apply merge_spec2. Qed.
372
373		Hint Immediate MapsTo_1 mem_2 is_empty_2
374		map_2 mapi_2 add_3 remove_3 find_2 : map.
375		Hint Resolve mem_1 is_empty_1 is_empty_2 add_1 add_2 remove_1
376		remove_2 find_1 fold_1 map_1 mapi_1 mapi_2 : map.
377
378		( Specifications written using equivalences *)
379
380		Section IffSpec.
381		Variable elt: Type.
382		Implicit Type m: t elt.
383		Implicit Type x y z: key.
384		Implicit Type e: elt.
385
386		Lemma in_iff m x y : E.eq x y -> (In x m <-> In y m).
387		Proof. now intros ->. Qed.
388
389		Lemma mapsto_iff m x y e : E.eq x y -> (MapsTo x e m <-> MapsTo y e m).
390		Proof. now intros ->. Qed.
391
392		Lemma mem_in_iff m x : In x m <-> mem x m = true.
393		Proof. symmetry. apply mem_spec. Qed.
394
395		Lemma not_mem_in_iff m x : ~In x m <-> mem x m = false.
396		Proof.
397		rewrite mem_in_iff; destruct (mem x m); intuition.
398		Qed.
399
400		Lemma mem_find m x : mem x m = true <-> find x m <> None.
401		Proof.
402		rewrite <- mem_in_iff. apply in_find.
403		Qed.
404
405		Lemma not_mem_find m x : mem x m = false <-> find x m = None.
406		Proof.
407		rewrite <- not_mem_in_iff. apply not_in_find.
408		Qed.
409
410		Lemma In_dec m x : { In x m } + { ~ In x m }.
411		Proof.
412		generalize (mem_in_iff m x).
413		destruct (mem x m); [left\|right]; intuition.
414		Qed.
415
416		Lemma find_mapsto_iff m x e : MapsTo x e m <-> find x m = Some e.
417		Proof. symmetry. apply find_spec. Qed.
418
419		Lemma equal_iff m m' cmp : Equivb cmp m m' <-> equal cmp m m' = true.
420		Proof. symmetry. apply equal_spec. Qed.
421
422		Lemma empty_mapsto_iff x e : MapsTo x e empty <-> False.
423		Proof.
424		rewrite <- find_spec, empty_spec. now split.
425		Qed.
426
427		Lemma not_in_empty x : ~In x (@empty elt).
428		Proof.
429		intros (e,H). revert H. apply empty_mapsto_iff.
430		Qed.
431
432		Lemma empty_in_iff x : In x (@empty elt) <-> False.
433		Proof.
434		split; [ apply not_in_empty \| destruct 1 ].
435		Qed.
436
437		Lemma is_empty_iff m : Empty m <-> is_empty m = true.
438		Proof. split; [apply is_empty_1 \| apply is_empty_2 ]. Qed.
439
440		Lemma add_mapsto_iff m x y e e' :
441		MapsTo y e' (add x e m) <->
442		(E.eq x y /\ e=e') \/
443		(~E.eq x y /\ MapsTo y e' m).
444		Proof.
445		split.
446		- intros H. destruct (E.eq_dec x y); [left\|right]; split; trivial.
447		+ symmetry. apply (mapsto_fun H); auto with map.
448		+ now apply add_3 with x e.
449		- destruct 1 as [(H,H')\|(H,H')]; subst; auto with map.
450		Qed.
451
452		Lemma add_mapsto_new m x y e e' : ~In x m ->
453		MapsTo y e' (add x e m) <-> (E.eq x y /\ e=e') \/ MapsTo y e' m.
454		Proof.
455		intros.
456		rewrite add_mapsto_iff. intuition.
457		right; split; trivial. contradict H. exists e'. now rewrite H.
458		Qed.
459
460		Lemma in_add m x y e : In y m -> In y (add x e m).
461		Proof.
462		destruct (E.eq_dec x y) as [<-\|H'].
463		- now rewrite !in_find, add_spec1.
464		- now rewrite !in_find, add_spec2.
465		Qed.
466
467		Lemma add_in_iff m x y e : In y (add x e m) <-> E.eq x y \/ In y m.
468		Proof.
469		split.
470		- intros H. destruct (E.eq_dec x y); [now left\|right].
471		rewrite in_find, add_spec2 in H; trivial. now apply in_find.
472		- intros [<-\|H].
473		+ exists e. now apply add_1.
474		+ now apply in_add.
475		Qed.
476
477		Lemma add_neq_mapsto_iff m x y e e' :
478		~ E.eq x y -> (MapsTo y e' (add x e m) <-> MapsTo y e' m).
479		Proof.
480		split; [apply add_3\|apply add_2]; auto.
481		Qed.
482
483		Lemma add_neq_in_iff m x y e :
484		~ E.eq x y -> (In y (add x e m) <-> In y m).
485		Proof.
486		split; intros (e',H0); exists e'.
487		- now apply add_3 with x e.
488		- now apply add_2.
489		Qed.
490
491		Lemma remove_mapsto_iff m x y e :
492		MapsTo y e (remove x m) <-> ~E.eq x y /\ MapsTo y e m.
493		Proof.
494		split; [split\|destruct 1].
495		- intro E. revert H. now rewrite <-E, <- find_spec, remove_spec1.
496		- now apply remove_3 with x.
497		- now apply remove_2.
498		Qed.
499
500		Lemma remove_in_iff m x y : In y (remove x m) <-> ~E.eq x y /\ In y m.
501		Proof.
502		unfold In; split; [ intros (e,H) \| intros (E,(e,H)) ].
503		- apply remove_mapsto_iff in H. destruct H; split; trivial.
504		now exists e.
505		- exists e. now apply remove_2.
506		Qed.
507
508		Lemma remove_neq_mapsto_iff : forall m x y e,
509		~ E.eq x y -> (MapsTo y e (remove x m) <-> MapsTo y e m).
510		Proof.
511		split; [apply remove_3\|apply remove_2]; auto.
512		Qed.
513
514		Lemma remove_neq_in_iff : forall m x y,
515		~ E.eq x y -> (In y (remove x m) <-> In y m).
516		Proof.
517		split; intros (e',H0); exists e'.
518		- now apply remove_3 with x.
519		- now apply remove_2.
520		Qed.
521
522		Lemma bindings_mapsto_iff m x e :
523		MapsTo x e m <-> InA eq_key_elt (x,e) (bindings m).
524		Proof. symmetry. apply bindings_spec1. Qed.
525
526		Lemma bindings_in_iff m x :
527		In x m <-> exists e, InA eq_key_elt (x,e) (bindings m).
528		Proof.
529		unfold In; split; intros (e,H); exists e; now apply bindings_spec1.
530		Qed.
531
532		End IffSpec.
533
534		Lemma map_mapsto_iff {elt elt'} m x b (f : elt -> elt') :
535		MapsTo x b (map f m) <-> exists a, b = f a /\ MapsTo x a m.
536		Proof.
537		rewrite <-find_spec, map_spec. setoid_rewrite <- find_spec.
538		destruct (find x m); simpl; split.
539		- injection 1. now exists e.
540		- intros (a,(->,H)). now injection H as ->.
541		- discriminate.
542		- intros (a,(_,H)); discriminate.
543		Qed.
544
545		Lemma map_in_iff {elt elt'} m x (f : elt -> elt') :
546		In x (map f m) <-> In x m.
547		Proof.
548		rewrite !in_find, map_spec. apply option_map_some.
549		Qed.
550
551		Lemma mapi_in_iff {elt elt'} m x (f:key->elt->elt') :
552		In x (mapi f m) <-> In x m.
553		Proof.
554		rewrite !in_find. destruct (mapi_spec f m x) as (y,(_,->)).
555		apply option_map_some.
556		Qed.
557
558		(** Unfortunately, we don't have simple equivalences for [mapi]
559		and [MapsTo]. The only correct one needs compatibility of [f]. *)
560
561		Lemma mapi_inv {elt elt'} m x b (f : key -> elt -> elt') :
562		MapsTo x b (mapi f m) ->
563		exists a y, E.eq y x /\ b = f y a /\ MapsTo x a m.
564		Proof.
565		rewrite <- find_spec. setoid_rewrite <- find_spec.
566		destruct (mapi_spec f m x) as (y,(E,->)).
567		destruct (find x m); simpl.
568		- injection 1 as <-. now exists e, y.
569		- discriminate.
570		Qed.
571
572		Lemma mapi_spec' {elt elt'} (f:key->elt->elt') :
573		Proper (E.eq==>Logic.eq==>Logic.eq) f ->
574		forall m x,
575		find x (mapi f m) = option_map (f x) (find x m).
576		Proof.
577		intros. destruct (mapi_spec f m x) as (y,(Hy,->)).
578		destruct (find x m); simpl; trivial.
579		now rewrite Hy.
580		Qed.
581
582		Lemma mapi_1bis {elt elt'} m x e (f:key->elt->elt') :
583		Proper (E.eq==>Logic.eq==>Logic.eq) f ->
584		MapsTo x e m -> MapsTo x (f x e) (mapi f m).
585		Proof.
586		intros. destruct (mapi_1 f H0) as (y,(->,H2)). trivial.
587		Qed.
588
589		Lemma mapi_mapsto_iff {elt elt'} m x b (f:key->elt->elt') :
590		Proper (E.eq==>Logic.eq==>Logic.eq) f ->
591		(MapsTo x b (mapi f m) <-> exists a, b = f x a /\ MapsTo x a m).
592		Proof.
593		rewrite <-find_spec. setoid_rewrite <-find_spec.
594		intros Pr. rewrite mapi_spec' by trivial.
595		destruct (find x m); simpl; split.
596		- injection 1 as <-. now exists e.
597		- intros (a,(->,H)). now injection H as <-.
598		- discriminate.
599		- intros (a,(_,H)). discriminate.
600		Qed.
601
602		(** Things are even worse for [merge] : we don't try to state any
603		equivalence, see instead boolean results below. *)
604
605		(** Useful tactic for simplifying expressions like
606		[In y (add x e (remove z m))] *)
607
608		Ltac map_iff :=
609		repeat (progress (
610		rewrite add_mapsto_iff \|\| rewrite add_in_iff \|\|
611		rewrite remove_mapsto_iff \|\| rewrite remove_in_iff \|\|
612		rewrite empty_mapsto_iff \|\| rewrite empty_in_iff \|\|
613		rewrite map_mapsto_iff \|\| rewrite map_in_iff \|\|
614		rewrite mapi_in_iff)).
615
616		( Specifications written using boolean predicates *)
617
618		Section BoolSpec.
619
620		Lemma mem_find_b {elt}(m:t elt)(x:key) :
621		mem x m = if find x m then true else false.
622		Proof.
623		apply eq_bool_alt. rewrite mem_find. destruct (find x m).
624		- now split.
625		- split; (discriminate \|\| now destruct 1).
626		Qed.
627
628		Variable elt elt' elt'' : Type.
629		Implicit Types m : t elt.
630		Implicit Types x y z : key.
631		Implicit Types e : elt.
632
633		Lemma mem_b m x y : E.eq x y -> mem x m = mem y m.
634		Proof. now intros ->. Qed.
635
636		Lemma find_o m x y : E.eq x y -> find x m = find y m.
637		Proof. now intros ->. Qed.
638
639		Lemma empty_o x : find x (@empty elt) = None.
640		Proof. apply empty_spec. Qed.
641
642		Lemma empty_a x : mem x (@empty elt) = false.
643		Proof. apply not_mem_find. apply empty_spec. Qed.
644
645		Lemma add_eq_o m x y e :
646		E.eq x y -> find y (add x e m) = Some e.
647		Proof.
648		intros <-. apply add_spec1.
649		Qed.
650
651		Lemma add_neq_o m x y e :
652		~ E.eq x y -> find y (add x e m) = find y m.
653		Proof. apply add_spec2. Qed.
654		Hint Resolve add_neq_o : map.
655
656		Lemma add_o m x y e :
657		find y (add x e m) = if E.eq_dec x y then Some e else find y m.
658		Proof.
659		destruct (E.eq_dec x y); auto with map.
660		Qed.
661
662		Lemma add_eq_b m x y e :
663		E.eq x y -> mem y (add x e m) = true.
664		Proof.
665		intros <-. apply mem_spec, add_in_iff. now left.
666		Qed.
667
668		Lemma add_neq_b m x y e :
669		~E.eq x y -> mem y (add x e m) = mem y m.
670		Proof.
671		intros. now rewrite !mem_find_b, add_neq_o.
672		Qed.
673
674		Lemma add_b m x y e :
675		mem y (add x e m) = eqb x y \|\| mem y m.
676		Proof.
677		rewrite !mem_find_b, add_o. unfold eqb.
678		now destruct (E.eq_dec x y).
679		Qed.
680
681		Lemma remove_eq_o m x y :
682		E.eq x y -> find y (remove x m) = None.
683		Proof. intros ->. apply remove_spec1. Qed.
684
685		Lemma remove_neq_o m x y :
686		~ E.eq x y -> find y (remove x m) = find y m.
687		Proof. apply remove_spec2. Qed.
688
689		Hint Resolve remove_eq_o remove_neq_o : map.
690
691		Lemma remove_o m x y :
692		find y (remove x m) = if E.eq_dec x y then None else find y m.
693		Proof.
694		destruct (E.eq_dec x y); auto with map.
695		Qed.
696
697		Lemma remove_eq_b m x y :
698		E.eq x y -> mem y (remove x m) = false.
699		Proof.
700		intros <-. now rewrite mem_find_b, remove_eq_o.
701		Qed.
702
703		Lemma remove_neq_b m x y :
704		~ E.eq x y -> mem y (remove x m) = mem y m.
705		Proof.
706		intros. now rewrite !mem_find_b, remove_neq_o.
707		Qed.
708
709		Lemma remove_b m x y :
710		mem y (remove x m) = negb (eqb x y) && mem y m.
711		Proof.
712		rewrite !mem_find_b, remove_o; unfold eqb.
713		now destruct (E.eq_dec x y).
714		Qed.
715
716		Lemma map_o m x (f:elt->elt') :
717		find x (map f m) = option_map f (find x m).
718		Proof. apply map_spec. Qed.
719
720		Lemma map_b m x (f:elt->elt') :
721		mem x (map f m) = mem x m.
722		Proof.
723		rewrite !mem_find_b, map_o. now destruct (find x m).
724		Qed.
725
726		Lemma mapi_b m x (f:key->elt->elt') :
727		mem x (mapi f m) = mem x m.
728		Proof.
729		apply eq_bool_alt; rewrite !mem_spec. apply mapi_in_iff.
730		Qed.
731
732		Lemma mapi_o m x (f:key->elt->elt') :
733		Proper (E.eq==>Logic.eq==>Logic.eq) f ->
734		find x (mapi f m) = option_map (f x) (find x m).
735		Proof. intros; now apply mapi_spec'. Qed.
736
737		Lemma merge_spec1' (f:key->option elt->option elt'->option elt'') :
738		Proper (E.eq==>Logic.eq==>Logic.eq==>Logic.eq) f ->
739		forall (m:t elt)(m':t elt') x,
740		In x m \/ In x m' ->
741		find x (merge f m m') = f x (find x m) (find x m').
742		Proof.
743		intros Hf m m' x H.
744		now destruct (merge_spec1 f H) as (y,(->,->)).
745		Qed.
746
747		Lemma merge_spec1_none (f:key->option elt->option elt'->option elt'') :
748		(forall x, f x None None = None) ->
749		forall (m: t elt)(m': t elt') x,
750		exists y, E.eq y x /\ find x (merge f m m') = f y (find x m) (find x m').
751		Proof.
752		intros Hf m m' x.
753		destruct (find x m) as [e\|] eqn:Hm.
754		- assert (H : In x m \/ In x m') by (left; exists e; now apply find_spec).
755		destruct (merge_spec1 f H) as (y,(Hy,->)).
756		exists y; split; trivial. now rewrite Hm.
757		- destruct (find x m') as [e\|] eqn:Hm'.
758		+ assert (H : In x m \/ In x m') by (right; exists e; now apply find_spec).
759		destruct (merge_spec1 f H) as (y,(Hy,->)).
760		exists y; split; trivial. now rewrite Hm, Hm'.
761		+ exists x. split. reflexivity. rewrite Hf.
762		apply not_in_find. intro H.
763		apply merge_spec2 in H. apply not_in_find in Hm. apply not_in_find in Hm'.
764		intuition.
765		Qed.
766
767		Lemma merge_spec1'_none (f:key->option elt->option elt'->option elt'') :
768		Proper (E.eq==>Logic.eq==>Logic.eq==>Logic.eq) f ->
769		(forall x, f x None None = None) ->
770		forall (m: t elt)(m': t elt') x,
771		find x (merge f m m') = f x (find x m) (find x m').
772		Proof.
773		intros Hf Hf' m m' x.
774		now destruct (merge_spec1_none Hf' m m' x) as (y,(->,->)).
775		Qed.
776
777		Lemma bindings_o : forall m x,
778		find x m = findA (eqb x) (bindings m).
779		Proof.
780		intros. rewrite eq_option_alt. intro e.
781		rewrite <- find_mapsto_iff, bindings_mapsto_iff.
782		unfold eqb.
783		rewrite <- findA_NoDupA; dintuition; try apply bindings_3w; eauto.
784		Qed.
785
786		Lemma bindings_b : forall m x,
787		mem x m = existsb (fun p => eqb x (fst p)) (bindings m).
788		Proof.
789		intros.
790		apply eq_bool_alt.
791		rewrite mem_spec, bindings_in_iff, existsb_exists.
792		split.
793		- intros (e,H).
794		rewrite InA_alt in H.
795		destruct H as ((k,e'),((H1,H2),H')); simpl in *; subst e'.
796		exists (k, e); split; trivial. simpl. now apply eqb_eq.
797		- intros ((k,e),(H,H')); simpl in *. apply eqb_eq in H'.
798		exists e. rewrite InA_alt. exists (k,e). now repeat split.
799		Qed.
800
801		End BoolSpec.
802
803		Section Equalities.
804		Variable elt:Type.
805
806		(** A few basic equalities *)
807
808		Lemma eq_empty (m: t elt) : m == empty <-> is_empty m = true.
809		Proof.
810		unfold Equal. rewrite is_empty_spec. now setoid_rewrite empty_spec.
811		Qed.
812
813		Lemma add_id (m: t elt) x e : add x e m == m <-> find x m = Some e.
814		Proof.
815		split.
816		- intros H. rewrite <- (H x). apply add_spec1.
817		- intros H y. rewrite !add_o. now destruct E.eq_dec as [<-\|E].
818		Qed.
819
820		Lemma add_add_1 (m: t elt) x e :
821		add x e (add x e m) == add x e m.
822		Proof.
823		intros y. rewrite !add_o. destruct E.eq_dec; auto.
824		Qed.
825
826		Lemma add_add_2 (m: t elt) x x' e e' :
827		~E.eq x x' -> add x e (add x' e' m) == add x' e' (add x e m).
828		Proof.
829		intros H y. rewrite !add_o.
830		do 2 destruct E.eq_dec; auto.
831		elim H. now transitivity y.
832		Qed.
833
834		Lemma remove_id (m: t elt) x : remove x m == m <-> ~In x m.
835		Proof.
836		rewrite not_in_find. split.
837		- intros H. rewrite <- (H x). apply remove_spec1.
838		- intros H y. rewrite !remove_o. now destruct E.eq_dec as [<-\|E].
839		Qed.
840
841		Lemma remove_remove_1 (m: t elt) x :
842		remove x (remove x m) == remove x m.
843		Proof.
844		intros y. rewrite !remove_o. destruct E.eq_dec; auto.
845		Qed.
846
847		Lemma remove_remove_2 (m: t elt) x x' :
848		remove x (remove x' m) == remove x' (remove x m).
849		Proof.
850		intros y. rewrite !remove_o. do 2 destruct E.eq_dec; auto.
851		Qed.
852
853		Lemma remove_add_1 (m: t elt) x e :
854		remove x (add x e m) == remove x m.
855		Proof.
856		intro y. rewrite !remove_o, !add_o. now destruct E.eq_dec.
857		Qed.
858
859		Lemma remove_add_2 (m: t elt) x x' e :
860		~E.eq x x' -> remove x' (add x e m) == add x e (remove x' m).
861		Proof.
862		intros H y. rewrite !remove_o, !add_o.
863		do 2 destruct E.eq_dec; auto.
864		- elim H; now transitivity y.
865		- symmetry. now apply remove_eq_o.
866		- symmetry. now apply remove_neq_o.
867		Qed.
868
869		Lemma add_remove_1 (m: t elt) x e :
870		add x e (remove x m) == add x e m.
871		Proof.
872		intro y. rewrite !add_o, !remove_o. now destruct E.eq_dec.
873		Qed.
874
875		(** Another characterisation of [Equal] *)
876
877		Lemma Equal_mapsto_iff : forall m1 m2 : t elt,
878		m1 == m2 <-> (forall k e, MapsTo k e m1 <-> MapsTo k e m2).
879		Proof.
880		intros m1 m2. split; [intros Heq k e\|intros Hiff].
881		rewrite 2 find_mapsto_iff, Heq. split; auto.
882		intro k. rewrite eq_option_alt. intro e.
883		rewrite <- 2 find_mapsto_iff; auto.
884		Qed.
885
886		(** * Relations between [Equal], [Equiv] and [Equivb]. *)
887
888		(** First, [Equal] is [Equiv] with Leibniz on elements. *)
889
890		Lemma Equal_Equiv : forall (m m' : t elt),
891		m == m' <-> Equiv Logic.eq m m'.
892		Proof.
893		intros. rewrite Equal_mapsto_iff. split; intros.
894		- split.
895		+ split; intros (e,Hin); exists e; [rewrite <- H\|rewrite H]; auto.
896		+ intros; apply mapsto_fun with m k; auto; rewrite H; auto.
897		- split; intros H'.
898		+ destruct H.
899		assert (Hin : In k m') by (rewrite <- H; exists e; auto).
900		destruct Hin as (e',He').
901		rewrite (H0 k e e'); auto.
902		+ destruct H.
903		assert (Hin : In k m) by (rewrite H; exists e; auto).
904		destruct Hin as (e',He').
905		rewrite <- (H0 k e' e); auto.
906		Qed.
907
908		(** [Equivb] and [Equiv] and equivalent when [eq_elt] and [cmp]
909		are related. *)
910
911		Section Cmp.
912		Variable eq_elt : elt->elt->Prop.
913		Variable cmp : elt->elt->bool.
914
915		Definition compat_cmp :=
916		forall e e', cmp e e' = true <-> eq_elt e e'.
917
918		Lemma Equiv_Equivb : compat_cmp ->
919		forall m m', Equiv eq_elt m m' <-> Equivb cmp m m'.
920		Proof.
921		unfold Equivb, Equiv, Cmp; intuition.
922		red in H; rewrite H; eauto.
923		red in H; rewrite <-H; eauto.
924		Qed.
925		End Cmp.
926
927		(** Composition of the two last results: relation between [Equal]
928		and [Equivb]. *)
929
930		Lemma Equal_Equivb : forall cmp,
931		(forall e e', cmp e e' = true <-> e = e') ->
932		forall (m m':t elt), m == m' <-> Equivb cmp m m'.
933		Proof.
934		intros; rewrite Equal_Equiv.
935		apply Equiv_Equivb; auto.
936		Qed.
937
938		Lemma Equal_Equivb_eqdec :
939		forall eq_elt_dec : (forall e e', { e = e' } + { e <> e' }),
940		let cmp := fun e e' => if eq_elt_dec e e' then true else false in
941		forall (m m':t elt), m == m' <-> Equivb cmp m m'.
942		Proof.
943		intros; apply Equal_Equivb.
944		unfold cmp; clear cmp; intros.
945		destruct eq_elt_dec; now intuition.
946		Qed.
947
948		End Equalities.
949
950		(** * Results about [fold], [bindings], induction principles... *)
951
952		Section Elt.
953		Variable elt:Type.
954
955		Definition Add x (e:elt) m m' := m' == (add x e m).
956
957		Notation eqke := (@eq_key_elt elt).
958		Notation eqk := (@eq_key elt).
959
960		Instance eqk_equiv : Equivalence eqk.
961		Proof. unfold eq_key. destruct E.eq_equiv. constructor; eauto. Qed.
962
963		Instance eqke_equiv : Equivalence eqke.
964		Proof.
965		unfold eq_key_elt; split; repeat red; intuition; simpl in *;
966		etransitivity; eauto.
967		Qed.
968
969		(** Complements about InA, NoDupA and findA *)
970
971		Lemma InA_eqke_eqk k k' e e' l :
972		E.eq k k' -> InA eqke (k,e) l -> InA eqk (k',e') l.
973		Proof.
974		intros Hk. rewrite 2 InA_alt.
975		intros ((k'',e'') & (Hk'',He'') & H); simpl in *; subst e''.
976		exists (k'',e); split; auto. red; simpl. now transitivity k.
977		Qed.
978
979		Lemma NoDupA_incl {A} (R R':relation A) :
980		(forall x y, R x y -> R' x y) ->
981		forall l, NoDupA R' l -> NoDupA R l.
982		Proof.
983		intros Incl.
984		induction 1 as [ \| a l E _ IH ]; constructor; auto.
985		contradict E. revert E. rewrite 2 InA_alt. firstorder.
986		Qed.
987
988		Lemma NoDupA_eqk_eqke l : NoDupA eqk l -> NoDupA eqke l.
989		Proof.
990		apply NoDupA_incl. now destruct 1.
991		Qed.
992
993		Lemma findA_rev l k : NoDupA eqk l ->
994		findA (eqb k) l = findA (eqb k) (rev l).
995		Proof.
996		intros H. apply eq_option_alt. intros e. unfold eqb.
997		rewrite <- !findA_NoDupA, InA_rev; eauto with map. reflexivity.
998		change (NoDupA eqk (rev l)). apply NoDupA_rev; auto using eqk_equiv.
999		Qed.
1000
1001		(** * Bindings *)
1002
1003		Lemma bindings_Empty (m:t elt) : Empty m <-> bindings m = nil.
1004		Proof.
1005		unfold Empty. split; intros H.
1006		- assert (H' : forall a, ~ List.In a (bindings m)).
1007		{ intros (k,e) H'. apply (H k e).
1008		rewrite bindings_mapsto_iff, InA_alt.
1009		exists (k,e); repeat split; auto with map. }
1010		destruct (bindings m) as [\|p l]; trivial.
1011		destruct (H' p); simpl; auto.
1012		- intros x e. rewrite bindings_mapsto_iff, InA_alt.
1013		rewrite H. now intros (y,(E,H')).
1014		Qed.
1015
1016		Lemma bindings_empty : bindings (@empty elt) = nil.
1017		Proof.
1018		rewrite <-bindings_Empty; apply empty_1.
1019		Qed.
1020
1021		(** * Conversions between maps and association lists. *)
1022
1023		Definition uncurry {U V W : Type} (f : U -> V -> W) : U*V -> W :=
1024		fun p => f (fst p) (snd p).
1025
1026		Definition of_list :=
1027		List.fold_right (uncurry (@add _)) (@empty elt).
1028
1029		Definition to_list := bindings.
1030
1031		Lemma of_list_1 : forall l k e,
1032		NoDupA eqk l ->
1033		(MapsTo k e (of_list l) <-> InA eqke (k,e) l).
1034		Proof.
1035		induction l as [\|(k',e') l IH]; simpl; intros k e Hnodup.
1036		- rewrite empty_mapsto_iff, InA_nil; intuition.
1037		- unfold uncurry; simpl.
1038		inversion_clear Hnodup as [\| ? ? Hnotin Hnodup'].
1039		specialize (IH k e Hnodup'); clear Hnodup'.
1040		rewrite add_mapsto_iff, InA_cons, <- IH.
1041		unfold eq_key_elt at 1; simpl.
1042		split; destruct 1 as [H\|H]; try (intuition;fail).
1043		destruct (E.eq_dec k k'); [left\|right]; split; auto with map.
1044		contradict Hnotin.
1045		apply InA_eqke_eqk with k e; intuition.
1046		Qed.
1047
1048		Lemma of_list_1b : forall l k,
1049		NoDupA eqk l ->
1050		find k (of_list l) = findA (eqb k) l.
1051		Proof.
1052		induction l as [\|(k',e') l IH]; simpl; intros k Hnodup.
1053		apply empty_o.
1054		unfold uncurry; simpl.
1055		inversion_clear Hnodup as [\| ? ? Hnotin Hnodup'].
1056		specialize (IH k Hnodup'); clear Hnodup'.
1057		rewrite add_o, IH, eqb_sym. unfold eqb; now destruct E.eq_dec.
1058		Qed.
1059
1060		Lemma of_list_2 : forall l, NoDupA eqk l ->
1061		equivlistA eqke l (to_list (of_list l)).
1062		Proof.
1063		intros l Hnodup (k,e).
1064		rewrite <- bindings_mapsto_iff, of_list_1; intuition.
1065		Qed.
1066
1067		Lemma of_list_3 : forall s, Equal (of_list (to_list s)) s.
1068		Proof.
1069		intros s k.
1070		rewrite of_list_1b, bindings_o; auto.
1071		apply bindings_3w.
1072		Qed.
1073
1074		(** * Fold *)
1075
1076		(** Alternative specification via [fold_right] *)
1077
1078		Lemma fold_spec_right m (A:Type)(i:A)(f : key -> elt -> A -> A) :
1079		fold f m i = List.fold_right (uncurry f) i (rev (bindings m)).
1080		Proof.
1081		rewrite fold_1. symmetry. apply fold_left_rev_right.
1082		Qed.
1083
1084		( Induction principles about fold contributed by S. Lescuyer *)
1085
1086		(** In the following lemma, the step hypothesis is deliberately restricted
1087		to the precise map m we are considering. *)
1088
1089		Lemma fold_rec :
1090		forall (A:Type)(P : t elt -> A -> Type)(f : key -> elt -> A -> A),
1091		forall (i:A)(m:t elt),
1092		(forall m, Empty m -> P m i) ->
1093		(forall k e a m' m'', MapsTo k e m -> ~In k m' ->
1094		Add k e m' m'' -> P m' a -> P m'' (f k e a)) ->
1095		P m (fold f m i).
1096		Proof.
1097		intros A P f i m Hempty Hstep.
1098		rewrite fold_spec_right.
1099		set (F:=uncurry f).
1100		set (l:=rev (bindings m)).
1101		assert (Hstep' : forall k e a m' m'', InA eqke (k,e) l -> ~In k m' ->
1102		Add k e m' m'' -> P m' a -> P m'' (F (k,e) a)).
1103		{
1104		intros k e a m' m'' H ? ? ?; eapply Hstep; eauto.
1105		revert H; unfold l; rewrite InA_rev, bindings_mapsto_iff; auto with *. }
1106		assert (Hdup : NoDupA eqk l).
1107		{ unfold l. apply NoDupA_rev; try red; unfold eq_key ; eauto with *.
1108		apply bindings_3w. }
1109		assert (Hsame : forall k, find k m = findA (eqb k) l).
1110		{ intros k. unfold l. rewrite bindings_o, findA_rev; auto.
1111		apply bindings_3w. }
1112		clearbody l. clearbody F. clear Hstep f. revert m Hsame. induction l.
1113		- (* empty *)
1114		intros m Hsame; simpl.
1115		apply Hempty. intros k e.
1116		rewrite find_mapsto_iff, Hsame; simpl; discriminate.
1117		- (* step *)
1118		intros m Hsame; destruct a as (k,e); simpl.
1119		apply Hstep' with (of_list l); auto.
1120		+ rewrite InA_cons; left; red; auto with map.
1121		+ inversion_clear Hdup. contradict H. destruct H as (e',He').
1122		apply InA_eqke_eqk with k e'; auto with map.
1123		rewrite <- of_list_1; auto.
1124		+ intro k'. rewrite Hsame, add_o, of_list_1b. simpl.
1125		rewrite eqb_sym. unfold eqb. now destruct E.eq_dec.
1126		inversion_clear Hdup; auto with map.
1127		+ apply IHl.
1128		* intros; eapply Hstep'; eauto.
1129		* inversion_clear Hdup; auto.
1130		* intros; apply of_list_1b. inversion_clear Hdup; auto.
1131		Qed.
1132
1133		(** Same, with [empty] and [add] instead of [Empty] and [Add]. In this
1134		case, [P] must be compatible with equality of sets *)
1135
1136		Theorem fold_rec_bis :
1137		forall (A:Type)(P : t elt -> A -> Type)(f : key -> elt -> A -> A),
1138		forall (i:A)(m:t elt),
1139		(forall m m' a, Equal m m' -> P m a -> P m' a) ->
1140		(P empty i) ->
1141		(forall k e a m', MapsTo k e m -> ~In k m' ->
1142		P m' a -> P (add k e m') (f k e a)) ->
1143		P m (fold f m i).
1144		Proof.
1145		intros A P f i m Pmorphism Pempty Pstep.
1146		apply fold_rec; intros.
1147		apply Pmorphism with empty; auto. intro k. rewrite empty_o.
1148		case_eq (find k m0); auto; intros e'; rewrite <- find_mapsto_iff.
1149		intro H'; elim (H k e'); auto.
1150		apply Pmorphism with (add k e m'); try intro; auto.
1151		Qed.
1152
1153		Lemma fold_rec_nodep :
1154		forall (A:Type)(P : A -> Type)(f : key -> elt -> A -> A)(i:A)(m:t elt),
1155		P i -> (forall k e a, MapsTo k e m -> P a -> P (f k e a)) ->
1156		P (fold f m i).
1157		Proof.
1158		intros; apply fold_rec_bis with (P:=fun _ => P); auto.
1159		Qed.
1160
1161		(** [fold_rec_weak] is a weaker principle than [fold_rec_bis] :
1162		the step hypothesis must here be applicable anywhere.
1163		At the same time, it looks more like an induction principle,
1164		and hence can be easier to use. *)
1165
1166		Lemma fold_rec_weak :
1167		forall (A:Type)(P : t elt -> A -> Type)(f : key -> elt -> A -> A)(i:A),
1168		(forall m m' a, Equal m m' -> P m a -> P m' a) ->
1169		P empty i ->
1170		(forall k e a m, ~In k m -> P m a -> P (add k e m) (f k e a)) ->
1171		forall m, P m (fold f m i).
1172		Proof.
1173		intros; apply fold_rec_bis; auto.
1174		Qed.
1175
1176		Lemma fold_rel :
1177		forall (A B:Type)(R : A -> B -> Type)
1178		(f : key -> elt -> A -> A)(g : key -> elt -> B -> B)(i : A)(j : B)
1179		(m : t elt),
1180		R i j ->
1181		(forall k e a b, MapsTo k e m -> R a b -> R (f k e a) (g k e b)) ->
1182		R (fold f m i) (fold g m j).
1183		Proof.
1184		intros A B R f g i j m Rempty Rstep.
1185		rewrite 2 fold_spec_right. set (l:=rev (bindings m)).
1186		assert (Rstep' : forall k e a b, InA eqke (k,e) l ->
1187		R a b -> R (f k e a) (g k e b)).
1188		{ intros; apply Rstep; auto.
1189		rewrite bindings_mapsto_iff, <- InA_rev; auto with map. }
1190		clearbody l; clear Rstep m.
1191		induction l; simpl; auto.
1192		apply Rstep'; auto.
1193		destruct a; simpl; rewrite InA_cons; left; red; auto with map.
1194		Qed.
1195
1196		(** From the induction principle on [fold], we can deduce some general
1197		induction principles on maps. *)
1198
1199		Lemma map_induction :
1200		forall P : t elt -> Type,
1201		(forall m, Empty m -> P m) ->
1202		(forall m m', P m -> forall x e, ~In x m -> Add x e m m' -> P m') ->
1203		forall m, P m.
1204		Proof.
1205		intros. apply (@fold_rec _ (fun s _ => P s) (fun _ _ _ => tt) tt m); eauto.
1206		Qed.
1207
1208		Lemma map_induction_bis :
1209		forall P : t elt -> Type,
1210		(forall m m', Equal m m' -> P m -> P m') ->
1211		P empty ->
1212		(forall x e m, ~In x m -> P m -> P (add x e m)) ->
1213		forall m, P m.
1214		Proof.
1215		intros.
1216		apply (@fold_rec_bis _ (fun s _ => P s) (fun _ _ _ => tt) tt m); eauto.
1217		Qed.
1218
1219		(** [fold] can be used to reconstruct the same initial set. *)
1220
1221		Lemma fold_identity : forall m : t elt, Equal (fold (@add _) m empty) m.
1222		Proof.
1223		intros.
1224		apply fold_rec with (P:=fun m acc => Equal acc m); auto with map.
1225		intros m' Heq k'.
1226		rewrite empty_o.
1227		case_eq (find k' m'); auto; intros e'; rewrite <- find_mapsto_iff.
1228		intro; elim (Heq k' e'); auto.
1229		intros k e a m' m'' _ _ Hadd Heq k'.
1230		red in Heq. rewrite Hadd, 2 add_o, Heq; auto.
1231		Qed.
1232
1233		Section Fold_More.
1234
1235		( Additional properties of fold *)
1236
1237		(** When a function [f] is compatible and allows transpositions, we can
1238		compute [fold f] in any order. *)
1239
1240		Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA).
1241
1242		Lemma fold_Empty (f:key->elt->A->A) :
1243		forall m i, Empty m -> eqA (fold f m i) i.
1244		Proof.
1245		intros. apply fold_rec_nodep with (P:=fun a => eqA a i).
1246		reflexivity.
1247		intros. elim (H k e); auto.
1248		Qed.
1249
1250		Lemma fold_init (f:key->elt->A->A) :
1251		Proper (E.eq==>eq==>eqA==>eqA) f ->
1252		forall m i i', eqA i i' -> eqA (fold f m i) (fold f m i').
1253		Proof.
1254		intros Hf m i i' Hi. apply fold_rel with (R:=eqA); auto.
1255		intros. now apply Hf.
1256		Qed.
1257
1258		(** Transpositions of f (a.k.a diamond property).
1259		Could we swap two sequential calls to f, i.e. do we have:
1260
1261		f k e (f k' e' a) == f k' e' (f k e a)
1262
1263		First, we do no need this equation for all keys, but only
1264		when k and k' aren't equal, as suggested by Pierre Castéran.
1265		Think for instance of [f] being [M.add] : in general, we don't have
1266		[M.add k e (M.add k e' m) == M.add k e' (M.add k e m)].
1267		Fortunately, we will never encounter this situation during a real
1268		[fold], since the keys received by this [fold] are unique.
1269		NB: without this condition, this condition would be
1270		[SetoidList.transpose2].
1271
1272		Secondly, instead of the equation above, we now use a statement
1273		with more basic equalities, allowing to prove [fold_commutes] even
1274		when [f] isn't a morphism.
1275		NB: When [f] is a morphism, [Diamond f] gives back the equation above.
1276		*)
1277
1278		Definition Diamond (f:key->elt->A->A) :=
1279		forall k k' e e' a b b', ~E.eq k k' ->
1280		eqA (f k e a) b -> eqA (f k' e' a) b' -> eqA (f k e b') (f k' e' b).
1281
1282		Lemma fold_commutes (f:key->elt->A->A) :
1283		Diamond f ->
1284		forall i m k e, ~In k m ->
1285		eqA (fold f m (f k e i)) (f k e (fold f m i)).
1286		Proof.
1287		intros Hf i m k e H.
1288		apply fold_rel with (R:= fun a b => eqA a (f k e b)); auto.
1289		- reflexivity.
1290		- intros k' e' b a Hm E.
1291		apply Hf with a; try easy.
1292		contradict H; rewrite <- H. now exists e'.
1293		Qed.
1294
1295		Hint Resolve NoDupA_eqk_eqke NoDupA_rev bindings_3w : map.
1296
1297		Lemma fold_Proper (f:key->elt->A->A) :
1298		Proper (E.eq==>eq==>eqA==>eqA) f ->
1299		Diamond f ->
1300		Proper (Equal==>eqA==>eqA) (fold f).
1301		Proof.
1302		intros Hf Hf' m1 m2 Hm i j Hi.
1303		rewrite 2 fold_spec_right.
1304		assert (NoDupA eqk (rev (bindings m1))) by (auto with * ).
1305		assert (NoDupA eqk (rev (bindings m2))) by (auto with * ).
1306		apply fold_right_equivlistA_restr2 with (R:=complement eqk)(eqA:=eqke)
1307		; auto with *.
1308		- intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; simpl in *. now apply Hf.
1309		- unfold complement, eq_key, eq_key_elt; repeat red. intuition eauto with map.
1310		- intros (k,e) (k',e') z z' h h'; unfold eq_key, uncurry;simpl; auto.
1311		rewrite h'. eapply Hf'; now eauto.
1312		- rewrite <- NoDupA_altdef; auto.
1313		- intros (k,e).
1314		rewrite 2 InA_rev, <- 2 bindings_mapsto_iff, 2 find_mapsto_iff, Hm;
1315		auto with *.
1316		Qed.
1317
1318		Lemma fold_Equal (f:key->elt->A->A) :
1319		Proper (E.eq==>eq==>eqA==>eqA) f ->
1320		Diamond f ->
1321		forall m1 m2 i,
1322		Equal m1 m2 ->
1323		eqA (fold f m1 i) (fold f m2 i).
1324		Proof.
1325		intros. now apply fold_Proper.
1326		Qed.
1327
1328		Lemma fold_Add (f:key->elt->A->A) :
1329		Proper (E.eq==>eq==>eqA==>eqA) f ->
1330		Diamond f ->
1331		forall m1 m2 k e i, ~In k m1 -> Add k e m1 m2 ->
1332		eqA (fold f m2 i) (f k e (fold f m1 i)).
1333		Proof.
1334		intros Hf Hf' m1 m2 k e i Hm1 Hm2.
1335		rewrite 2 fold_spec_right.
1336		set (f':=uncurry f).
1337		change (f k e (fold_right f' i (rev (bindings m1))))
1338		with (f' (k,e) (fold_right f' i (rev (bindings m1)))).
1339		assert (NoDupA eqk (rev (bindings m1))) by (auto with * ).
1340		assert (NoDupA eqk (rev (bindings m2))) by (auto with * ).
1341		apply fold_right_add_restr with
1342		(R:=complement eqk)(eqA:=eqke); auto with *.
1343		- intros (k1,e1) (k2,e2) (Hk,He) a a' Ha; unfold f'; simpl in *. now apply Hf.
1344		- unfold complement, eq_key_elt, eq_key; repeat red; intuition eauto with map.
1345		- intros (k1,e1) (k2,e2) z1 z2; unfold eq_key, f', uncurry; simpl.
1346		eapply Hf'; now eauto.
1347		- rewrite <- NoDupA_altdef; auto.
1348		- rewrite InA_rev, <- bindings_mapsto_iff by (auto with * ). firstorder.
1349		- intros (a,b).
1350		rewrite InA_cons, 2 InA_rev, <- 2 bindings_mapsto_iff,
1351		2 find_mapsto_iff by (auto with * ).
1352		unfold eq_key_elt; simpl.
1353		rewrite Hm2, !find_spec, add_mapsto_new; intuition.
1354		Qed.
1355
1356		Lemma fold_add (f:key->elt->A->A) :
1357		Proper (E.eq==>eq==>eqA==>eqA) f ->
1358		Diamond f ->
1359		forall m k e i, ~In k m ->
1360		eqA (fold f (add k e m) i) (f k e (fold f m i)).
1361		Proof.
1362		intros. now apply fold_Add.
1363		Qed.
1364
1365		End Fold_More.
1366
1367		(** * Cardinal *)
1368
1369		Lemma cardinal_fold (m : t elt) :
1370		cardinal m = fold (fun _ _ => S) m 0.
1371		Proof.
1372		rewrite cardinal_1, fold_1.
1373		symmetry; apply fold_left_length; auto.
1374		Qed.
1375
1376		Lemma cardinal_Empty : forall m : t elt,
1377		Empty m <-> cardinal m = 0.
1378		Proof.
1379		intros.
1380		rewrite cardinal_1, bindings_Empty.
1381		destruct (bindings m); intuition; discriminate.
1382		Qed.
1383
1384		Lemma Equal_cardinal (m m' : t elt) :
1385		Equal m m' -> cardinal m = cardinal m'.
1386		Proof.
1387		intro. rewrite 2 cardinal_fold.
1388		apply fold_Equal with (eqA:=eq); try congruence; auto with map.
1389		Qed.
1390
1391		Lemma cardinal_0 (m : t elt) : Empty m -> cardinal m = 0.
1392		Proof.
1393		intros; rewrite <- cardinal_Empty; auto.
1394		Qed.
1395
1396		Lemma cardinal_S m m' x e :
1397		~ In x m -> Add x e m m' -> cardinal m' = S (cardinal m).
1398		Proof.
1399		intros. rewrite 2 cardinal_fold.
1400		change S with ((fun _ _ => S) x e).
1401		apply fold_Add with (eqA:=eq); try congruence; auto with map.
1402		Qed.
1403
1404		Lemma cardinal_inv_1 : forall m : t elt,
1405		cardinal m = 0 -> Empty m.
1406		Proof.
1407		intros; rewrite cardinal_Empty; auto.
1408		Qed.
1409		Hint Resolve cardinal_inv_1 : map.
1410
1411		Lemma cardinal_inv_2 :
1412		forall m n, cardinal m = S n -> { p : key*elt \| MapsTo (fst p) (snd p) m }.
1413		Proof.
1414		intros; rewrite M.cardinal_spec in *.
1415		generalize (bindings_mapsto_iff m).
1416		destruct (bindings m); try discriminate.
1417		exists p; auto.
1418		rewrite H0; destruct p; simpl; auto.
1419		constructor; red; auto with map.
1420		Qed.
1421
1422		Lemma cardinal_inv_2b :
1423		forall m, cardinal m <> 0 -> { p : key*elt \| MapsTo (fst p) (snd p) m }.
1424		Proof.
1425		intros.
1426		generalize (@cardinal_inv_2 m); destruct cardinal.
1427		elim H;auto.
1428		eauto.
1429		Qed.
1430
1431		Lemma not_empty_mapsto (m : t elt) :
1432		~Empty m -> exists k e, MapsTo k e m.
1433		Proof.
1434		intro.
1435		destruct (@cardinal_inv_2b m) as ((k,e),H').
1436		contradict H. now apply cardinal_inv_1.
1437		exists k; now exists e.
1438		Qed.
1439
1440		Lemma not_empty_in (m:t elt) :
1441		~Empty m -> exists k, In k m.
1442		Proof.
1443		intro. destruct (not_empty_mapsto H) as (k,Hk).
1444		now exists k.
1445		Qed.
1446
1447		(** * Additional notions over maps *)
1448
1449		Definition Disjoint (m m' : t elt) :=
1450		forall k, ~(In k m /\ In k m').
1451
1452		Definition Partition (m m1 m2 : t elt) :=
1453		Disjoint m1 m2 /\
1454		(forall k e, MapsTo k e m <-> MapsTo k e m1 \/ MapsTo k e m2).
1455
1456		(** * Emulation of some functions lacking in the interface *)
1457
1458		Definition filter (f : key -> elt -> bool)(m : t elt) :=
1459		fold (fun k e m => if f k e then add k e m else m) m empty.
1460
1461		Definition for_all (f : key -> elt -> bool)(m : t elt) :=
1462		fold (fun k e b => if f k e then b else false) m true.
1463
1464		Definition exists_ (f : key -> elt -> bool)(m : t elt) :=
1465		fold (fun k e b => if f k e then true else b) m false.
1466
1467		Definition partition (f : key -> elt -> bool)(m : t elt) :=
1468		(filter f m, filter (fun k e => negb (f k e)) m).
1469
1470		(** [update] adds to [m1] all the bindings of [m2]. It can be seen as
1471		an [union] operator which gives priority to its 2nd argument
1472		in case of binding conflit. *)
1473
1474		Definition update (m1 m2 : t elt) := fold (@add _) m2 m1.
1475
1476		(** [restrict] keeps from [m1] only the bindings whose key is in [m2].
1477		It can be seen as an [inter] operator, with priority to its 1st argument
1478		in case of binding conflit. *)
1479
1480		Definition restrict (m1 m2 : t elt) := filter (fun k _ => mem k m2) m1.
1481
1482		(** [diff] erases from [m1] all bindings whose key is in [m2]. *)
1483
1484		Definition diff (m1 m2 : t elt) := filter (fun k _ => negb (mem k m2)) m1.
1485
1486		(** Properties of these abbreviations *)
1487
1488		Lemma filter_iff (f : key -> elt -> bool) :
1489		Proper (E.eq==>eq==>eq) f ->
1490		forall m k e,
1491		MapsTo k e (filter f m) <-> MapsTo k e m /\ f k e = true.
1492		Proof.
1493		unfold filter.
1494		set (f':=fun k e m => if f k e then add k e m else m).
1495		intros Hf m. pattern m, (fold f' m empty). apply fold_rec.
1496
1497		- intros m' Hm' k e. rewrite empty_mapsto_iff. intuition.
1498		elim (Hm' k e); auto.
1499
1500		- intros k e acc m1 m2 Hke Hn Hadd IH k' e'.
1501		change (Equal m2 (add k e m1)) in Hadd; rewrite Hadd.
1502		unfold f'; simpl.
1503		rewrite add_mapsto_new by trivial.
1504		case_eq (f k e); intros Hfke; simpl;
1505		rewrite ?add_mapsto_iff, IH; clear IH; intuition.
1506		+ rewrite <- Hfke; apply Hf; auto with map.
1507		+ right. repeat split; trivial. contradict Hn. rewrite Hn. now exists e'.
1508		+ assert (f k e = f k' e') by (apply Hf; auto). congruence.
1509		Qed.
1510
1511		Lemma for_all_filter f m :
1512		for_all f m = is_empty (filter (fun k e => negb (f k e)) m).
1513		Proof.
1514		unfold for_all, filter.
1515		eapply fold_rel with (R:=fun x y => x = is_empty y).
1516		- symmetry. apply is_empty_iff. apply empty_1.
1517		- intros; subst. destruct (f k e); simpl; trivial.
1518		symmetry. apply not_true_is_false. rewrite is_empty_spec.
1519		intros H'. specialize (H' k). now rewrite add_spec1 in H'.
1520		Qed.
1521
1522		Lemma exists_filter f m :
1523		exists_ f m = negb (is_empty (filter f m)).
1524		Proof.
1525		unfold for_all, filter.
1526		eapply fold_rel with (R:=fun x y => x = negb (is_empty y)).
1527		- symmetry. rewrite negb_false_iff. apply is_empty_iff. apply empty_1.
1528		- intros; subst. destruct (f k e); simpl; trivial.
1529		symmetry. rewrite negb_true_iff. apply not_true_is_false.
1530		rewrite is_empty_spec.
1531		intros H'. specialize (H' k). now rewrite add_spec1 in H'.
1532		Qed.
1533
1534		Lemma for_all_iff f m :
1535		Proper (E.eq==>eq==>eq) f ->
1536		(for_all f m = true <-> (forall k e, MapsTo k e m -> f k e = true)).
1537		Proof.
1538		intros Hf.
1539		rewrite for_all_filter.
1540		rewrite <- is_empty_iff. unfold Empty.
1541		split; intros H k e; specialize (H k e);
1542		rewrite filter_iff in * by solve_proper; intuition.
1543		- destruct (f k e); auto.
1544		- now rewrite H0 in H2.
1545		Qed.
1546
1547		Lemma exists_iff f m :
1548		Proper (E.eq==>eq==>eq) f ->
1549		(exists_ f m = true <->
1550		(exists k e, MapsTo k e m /\ f k e = true)).
1551		Proof.
1552		intros Hf.
1553		rewrite exists_filter. rewrite negb_true_iff.
1554		rewrite <- not_true_iff_false, <- is_empty_iff.
1555		split.
1556		- intros H. apply not_empty_mapsto in H. now setoid_rewrite filter_iff in H.
1557		- unfold Empty. setoid_rewrite filter_iff; trivial. firstorder.
1558		Qed.
1559
1560		Lemma Disjoint_alt : forall m m',
1561		Disjoint m m' <->
1562		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> False).
1563		Proof.
1564		unfold Disjoint; split.
1565		intros H k v v' H1 H2.
1566		apply H with k; split.
1567		exists v; trivial.
1568		exists v'; trivial.
1569		intros H k ((v,Hv),(v',Hv')).
1570		eapply H; eauto.
1571		Qed.
1572
1573		Section Partition.
1574		Variable f : key -> elt -> bool.
1575		Hypothesis Hf : Proper (E.eq==>eq==>eq) f.
1576
1577		Lemma partition_iff_1 : forall m m1 k e,
1578		m1 = fst (partition f m) ->
1579		(MapsTo k e m1 <-> MapsTo k e m /\ f k e = true).
1580		Proof.
1581		unfold partition; simpl; intros. subst m1.
1582		apply filter_iff; auto.
1583		Qed.
1584
1585		Lemma partition_iff_2 : forall m m2 k e,
1586		m2 = snd (partition f m) ->
1587		(MapsTo k e m2 <-> MapsTo k e m /\ f k e = false).
1588		Proof.
1589		unfold partition; simpl; intros. subst m2.
1590		rewrite filter_iff.
1591		split; intros (H,H'); split; auto.
1592		destruct (f k e); simpl in *; auto.
1593		rewrite H'; auto.
1594		repeat red; intros. f_equal. apply Hf; auto.
1595		Qed.
1596
1597		Lemma partition_Partition : forall m m1 m2,
1598		partition f m = (m1,m2) -> Partition m m1 m2.
1599		Proof.
1600		intros. split.
1601		rewrite Disjoint_alt. intros k e e'.
1602		rewrite (@partition_iff_1 m m1), (@partition_iff_2 m m2)
1603		by (rewrite H; auto).
1604		intros (U,V) (W,Z). rewrite <- (mapsto_fun U W) in Z; congruence.
1605		intros k e.
1606		rewrite (@partition_iff_1 m m1), (@partition_iff_2 m m2)
1607		by (rewrite H; auto).
1608		destruct (f k e); intuition.
1609		Qed.
1610
1611		End Partition.
1612
1613		Lemma Partition_In : forall m m1 m2 k,
1614		Partition m m1 m2 -> In k m -> {In k m1}+{In k m2}.
1615		Proof.
1616		intros m m1 m2 k Hm Hk.
1617		destruct (In_dec m1 k) as [H\|H]; [left\|right]; auto.
1618		destruct Hm as (Hm,Hm').
1619		destruct Hk as (e,He); rewrite Hm' in He; destruct He.
1620		elim H; exists e; auto.
1621		exists e; auto.
1622		Defined.
1623
1624		Lemma Disjoint_sym : forall m1 m2, Disjoint m1 m2 -> Disjoint m2 m1.
1625		Proof.
1626		intros m1 m2 H k (H1,H2). elim (H k); auto.
1627		Qed.
1628
1629		Lemma Partition_sym : forall m m1 m2,
1630		Partition m m1 m2 -> Partition m m2 m1.
1631		Proof.
1632		intros m m1 m2 (H,H'); split.
1633		apply Disjoint_sym; auto.
1634		intros; rewrite H'; intuition.
1635		Qed.
1636
1637		Lemma Partition_Empty : forall m m1 m2, Partition m m1 m2 ->
1638		(Empty m <-> (Empty m1 /\ Empty m2)).
1639		Proof.
1640		intros m m1 m2 (Hdisj,Heq). split.
1641		intro He.
1642		split; intros k e Hke; elim (He k e); rewrite Heq; auto.
1643		intros (He1,He2) k e Hke. rewrite Heq in Hke. destruct Hke.
1644		elim (He1 k e); auto.
1645		elim (He2 k e); auto.
1646		Qed.
1647
1648		Lemma Partition_Add :
1649		forall m m' x e , ~In x m -> Add x e m m' ->
1650		forall m1 m2, Partition m' m1 m2 ->
1651		exists m3, (Add x e m3 m1 /\ Partition m m3 m2 \/
1652		Add x e m3 m2 /\ Partition m m1 m3).
1653		Proof.
1654		unfold Partition. intros m m' x e Hn Hadd m1 m2 (Hdisj,Hor).
1655		assert (Heq : Equal m (remove x m')).
1656		{ change (Equal m' (add x e m)) in Hadd. rewrite Hadd.
1657		intro k. rewrite remove_o, add_o.
1658		destruct E.eq_dec as [He\|Hne]; auto.
1659		rewrite <- He, <- not_find_in_iff; auto. }
1660		assert (H : MapsTo x e m').
1661		{ change (Equal m' (add x e m)) in Hadd; rewrite Hadd.
1662		apply add_1; auto with map. }
1663		rewrite Hor in H; destruct H.
1664
1665		- (* first case : x in m1 *)
1666		exists (remove x m1); left. split; [\|split].
1667		+ (* add *)
1668		change (Equal m1 (add x e (remove x m1))).
1669		intro k.
1670		rewrite add_o, remove_o.
1671		destruct E.eq_dec as [He\|Hne]; auto.
1672		rewrite <- He; apply find_1; auto.
1673		+ (* disjoint *)
1674		intros k (H1,H2). elim (Hdisj k). split; auto.
1675		rewrite remove_in_iff in H1; destruct H1; auto.
1676		+ (* mapsto *)
1677		intros k' e'.
1678		rewrite Heq, 2 remove_mapsto_iff, Hor.
1679		intuition.
1680		elim (Hdisj x); split; [exists e\|exists e']; auto.
1681		apply MapsTo_1 with k'; auto with map.
1682
1683		- (* second case : x in m2 *)
1684		exists (remove x m2); right. split; [\|split].
1685		+ (* add *)
1686		change (Equal m2 (add x e (remove x m2))).
1687		intro k.
1688		rewrite add_o, remove_o.
1689		destruct E.eq_dec as [He\|Hne]; auto.
1690		rewrite <- He; apply find_1; auto.
1691		+ (* disjoint *)
1692		intros k (H1,H2). elim (Hdisj k). split; auto.
1693		rewrite remove_in_iff in H2; destruct H2; auto.
1694		+ (* mapsto *)
1695		intros k' e'.
1696		rewrite Heq, 2 remove_mapsto_iff, Hor.
1697		intuition.
1698		elim (Hdisj x); split; [exists e'\|exists e]; auto.
1699		apply MapsTo_1 with k'; auto with map.
1700		Qed.
1701
1702		Lemma Partition_fold :
1703		forall (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA)(f:key->elt->A->A),
1704		Proper (E.eq==>eq==>eqA==>eqA) f ->
1705		Diamond eqA f ->
1706		forall m m1 m2 i,
1707		Partition m m1 m2 ->
1708		eqA (fold f m i) (fold f m1 (fold f m2 i)).
1709		Proof.
1710		intros A eqA st f Comp Tra.
1711		induction m as [m Hm\|m m' IH k e Hn Hadd] using map_induction.
1712
1713		- intros m1 m2 i Hp. rewrite (fold_Empty (eqA:=eqA)); auto.
1714		rewrite (Partition_Empty Hp) in Hm. destruct Hm.
1715		rewrite 2 (fold_Empty (eqA:=eqA)); auto. reflexivity.
1716
1717		- intros m1 m2 i Hp.
1718		destruct (Partition_Add Hn Hadd Hp) as (m3,[(Hadd',Hp')\|(Hadd',Hp')]).
1719		+ (* fst case: m3 is (k,e)::m1 *)
1720		assert (~In k m3).
1721		{ contradict Hn. destruct Hn as (e',He').
1722		destruct Hp' as (Hp1,Hp2). exists e'. rewrite Hp2; auto. }
1723		transitivity (f k e (fold f m i)).
1724		apply fold_Add with (eqA:=eqA); auto.
1725		symmetry.
1726		transitivity (f k e (fold f m3 (fold f m2 i))).
1727		apply fold_Add with (eqA:=eqA); auto.
1728		apply Comp; auto with map.
1729		symmetry; apply IH; auto.
1730		+ (* snd case: m3 is (k,e)::m2 *)
1731		assert (~In k m3).
1732		{ contradict Hn. destruct Hn as (e',He').
1733		destruct Hp' as (Hp1,Hp2). exists e'. rewrite Hp2; auto. }
1734		assert (~In k m1).
1735		{ contradict Hn. destruct Hn as (e',He').
1736		destruct Hp' as (Hp1,Hp2). exists e'. rewrite Hp2; auto. }
1737		transitivity (f k e (fold f m i)).
1738		apply fold_Add with (eqA:=eqA); auto.
1739		transitivity (f k e (fold f m1 (fold f m3 i))).
1740		apply Comp; auto using IH with map.
1741		transitivity (fold f m1 (f k e (fold f m3 i))).
1742		symmetry.
1743		apply fold_commutes with (eqA:=eqA); auto.
1744		apply fold_init with (eqA:=eqA); auto.
1745		symmetry.
1746		apply fold_Add with (eqA:=eqA); auto.
1747		Qed.
1748
1749		Lemma Partition_cardinal : forall m m1 m2, Partition m m1 m2 ->
1750		cardinal m = cardinal m1 + cardinal m2.
1751		Proof.
1752		intros.
1753		rewrite (cardinal_fold m), (cardinal_fold m1).
1754		set (f:=fun (_:key)(_:elt)=>S).
1755		setoid_replace (fold f m 0) with (fold f m1 (fold f m2 0)).
1756		rewrite <- cardinal_fold.
1757		apply fold_rel with (R:=fun u v => u = v + cardinal m2); simpl; auto.
1758		apply Partition_fold with (eqA:=eq); compute; auto with map. congruence.
1759		Qed.
1760
1761		Lemma Partition_partition : forall m m1 m2, Partition m m1 m2 ->
1762		let f := fun k (_:elt) => mem k m1 in
1763		Equal m1 (fst (partition f m)) /\ Equal m2 (snd (partition f m)).
1764		Proof.
1765		intros m m1 m2 Hm f.
1766		assert (Hf : Proper (E.eq==>eq==>eq) f).
1767		intros k k' Hk e e' _; unfold f; rewrite Hk; auto.
1768		set (m1':= fst (partition f m)).
1769		set (m2':= snd (partition f m)).
1770		split; rewrite Equal_mapsto_iff; intros k e.
1771		rewrite (@partition_iff_1 f Hf m m1') by auto.
1772		unfold f.
1773		rewrite <- mem_in_iff.
1774		destruct Hm as (Hm,Hm').
1775		rewrite Hm'.
1776		intuition.
1777		exists e; auto.
1778		elim (Hm k); split; auto; exists e; auto.
1779		rewrite (@partition_iff_2 f Hf m m2') by auto.
1780		unfold f.
1781		rewrite <- not_mem_in_iff.
1782		destruct Hm as (Hm,Hm').
1783		rewrite Hm'.
1784		intuition.
1785		elim (Hm k); split; auto; exists e; auto.
1786		elim H1; exists e; auto.
1787		Qed.
1788
1789		Lemma update_mapsto_iff : forall m m' k e,
1790		MapsTo k e (update m m') <->
1791		(MapsTo k e m' \/ (MapsTo k e m /\ ~In k m')).
1792		Proof.
1793		unfold update.
1794		intros m m'.
1795		pattern m', (fold (@add _) m' m). apply fold_rec.
1796
1797		- intros m0 Hm0 k e.
1798		assert (~In k m0) by (intros (e0,He0); apply (Hm0 k e0); auto).
1799		intuition.
1800		elim (Hm0 k e); auto.
1801
1802		- intros k e m0 m1 m2 _ Hn Hadd IH k' e'.
1803		change (Equal m2 (add k e m1)) in Hadd.
1804		rewrite Hadd, 2 add_mapsto_iff, IH, add_in_iff. clear IH. intuition.
1805		Qed.
1806
1807		Lemma update_dec : forall m m' k e, MapsTo k e (update m m') ->
1808		{ MapsTo k e m' } + { MapsTo k e m /\ ~In k m'}.
1809		Proof.
1810		intros m m' k e H. rewrite update_mapsto_iff in H.
1811		destruct (In_dec m' k) as [H'\|H']; [left\|right]; intuition.
1812		elim H'; exists e; auto.
1813		Defined.
1814
1815		Lemma update_in_iff : forall m m' k,
1816		In k (update m m') <-> In k m \/ In k m'.
1817		Proof.
1818		intros m m' k. split.
1819		intros (e,H); rewrite update_mapsto_iff in H.
1820		destruct H; [right\|left]; exists e; intuition.
1821		destruct (In_dec m' k) as [H\|H].
1822		destruct H as (e,H). intros _; exists e.
1823		rewrite update_mapsto_iff; left; auto.
1824		destruct 1 as [H'\|H']; [\|elim H; auto].
1825		destruct H' as (e,H'). exists e.
1826		rewrite update_mapsto_iff; right; auto.
1827		Qed.
1828
1829		Lemma diff_mapsto_iff : forall m m' k e,
1830		MapsTo k e (diff m m') <-> MapsTo k e m /\ ~In k m'.
1831		Proof.
1832		intros m m' k e.
1833		unfold diff.
1834		rewrite filter_iff.
1835		intuition.
1836		rewrite mem_1 in *; auto; discriminate.
1837		intros ? ? Hk _ _ _; rewrite Hk; auto.
1838		Qed.
1839
1840		Lemma diff_in_iff : forall m m' k,
1841		In k (diff m m') <-> In k m /\ ~In k m'.
1842		Proof.
1843		intros m m' k. split.
1844		intros (e,H); rewrite diff_mapsto_iff in H.
1845		destruct H; split; auto. exists e; auto.
1846		intros ((e,H),H'); exists e; rewrite diff_mapsto_iff; auto.
1847		Qed.
1848
1849		Lemma restrict_mapsto_iff : forall m m' k e,
1850		MapsTo k e (restrict m m') <-> MapsTo k e m /\ In k m'.
1851		Proof.
1852		intros m m' k e.
1853		unfold restrict.
1854		rewrite filter_iff.
1855		intuition.
1856		intros ? ? Hk _ _ _; rewrite Hk; auto.
1857		Qed.
1858
1859		Lemma restrict_in_iff : forall m m' k,
1860		In k (restrict m m') <-> In k m /\ In k m'.
1861		Proof.
1862		intros m m' k. split.
1863		intros (e,H); rewrite restrict_mapsto_iff in H.
1864		destruct H; split; auto. exists e; auto.
1865		intros ((e,H),H'); exists e; rewrite restrict_mapsto_iff; auto.
1866		Qed.
1867
1868		(** specialized versions analyzing only keys (resp. bindings) *)
1869
1870		Definition filter_dom (f : key -> bool) := filter (fun k _ => f k).
1871		Definition filter_range (f : elt -> bool) := filter (fun _ => f).
1872		Definition for_all_dom (f : key -> bool) := for_all (fun k _ => f k).
1873		Definition for_all_range (f : elt -> bool) := for_all (fun _ => f).
1874		Definition exists_dom (f : key -> bool) := exists_ (fun k _ => f k).
1875		Definition exists_range (f : elt -> bool) := exists_ (fun _ => f).
1876		Definition partition_dom (f : key -> bool) := partition (fun k _ => f k).
1877		Definition partition_range (f : elt -> bool) := partition (fun _ => f).
1878
1879		End Elt.
1880
1881		Instance cardinal_m {elt} : Proper (Equal ==> Logic.eq) (@cardinal elt).
1882		Proof. intros m m'. apply Equal_cardinal. Qed.
1883
1884		Instance Disjoint_m {elt} : Proper (Equal ==> Equal ==> iff) (@Disjoint elt).
1885		Proof.
1886		intros m1 m1' Hm1 m2 m2' Hm2. unfold Disjoint. split; intros.
1887		rewrite <- Hm1, <- Hm2; auto.
1888		rewrite Hm1, Hm2; auto.
1889		Qed.
1890
1891		Instance Partition_m {elt} :
1892		Proper (Equal ==> Equal ==> Equal ==> iff) (@Partition elt).
1893		Proof.
1894		intros m1 m1' Hm1 m2 m2' Hm2 m3 m3' Hm3. unfold Partition.
1895		rewrite <- Hm2, <- Hm3.
1896		split; intros (H,H'); split; auto; intros.
1897		rewrite <- Hm1, <- Hm2, <- Hm3; auto.
1898		rewrite Hm1, Hm2, Hm3; auto.
1899		Qed.
1900
1901		(*
1902		Instance filter_m0 {elt} (f:key->elt->bool) :
1903		Proper (E.eq==>Logic.eq==>Logic.eq) f ->
1904		Proper (Equal==>Equal) (filter f).
1905		Proof.
1906		intros Hf m m' Hm. apply Equal_mapsto_iff. intros.
1907		now rewrite !filter_iff, Hm.
1908		Qed.
1909		*)
1910
1911		Instance filter_m {elt} :
1912		Proper ((E.eq==>Logic.eq==>Logic.eq)==>Equal==>Equal) (@filter elt).
1913		Proof.
1914		intros f f' Hf m m' Hm. unfold filter.
1915		rewrite 2 fold_spec_right.
1916		set (l := rev (bindings m)).
1917		set (l' := rev (bindings m')).
1918		set (op := fun (f:key->elt->bool) =>
1919		uncurry (fun k e acc => if f k e then add k e acc else acc)).
1920		change (Equal (fold_right (op f) empty l) (fold_right (op f') empty l')).
1921		assert (Hl : NoDupA eq_key l).
1922		{ apply NoDupA_rev. apply eqk_equiv. apply bindings_spec2w. }
1923		assert (Hl' : NoDupA eq_key l').
1924		{ apply NoDupA_rev. apply eqk_equiv. apply bindings_spec2w. }
1925		assert (H : PermutationA eq_key_elt l l').
1926		{ apply NoDupA_equivlistA_PermutationA.
1927		- apply eqke_equiv.
1928		- now apply NoDupA_eqk_eqke.
1929		- now apply NoDupA_eqk_eqke.
1930		- intros (k,e); unfold l, l'. rewrite 2 InA_rev, 2 bindings_spec1.
1931		rewrite Equal_mapsto_iff in Hm. apply Hm. }
1932		destruct (PermutationA_decompose (eqke_equiv _) H) as (l0,(P,E)).
1933		transitivity (fold_right (op f) empty l0).
1934		- apply fold_right_equivlistA_restr2
1935		with (eqA:=Logic.eq)(R:=complement eq_key); auto with *.
1936		+ intros p p' <- acc acc' Hacc.
1937		destruct p as (k,e); unfold op, uncurry; simpl.
1938		destruct (f k e); now rewrite Hacc.
1939		+ intros (k,e) (k',e') z z'.
1940		unfold op, complement, uncurry, eq_key; simpl.
1941		intros Hk Hz.
1942		destruct (f k e), (f k' e'); rewrite <- Hz; try reflexivity.
1943		now apply add_add_2.
1944		+ apply NoDupA_incl with eq_key; trivial. intros; subst; now red.
1945		+ apply PermutationA_preserves_NoDupA with l; auto with *.
1946		apply Permutation_PermutationA; auto with *.
1947		apply NoDupA_incl with eq_key; trivial. intros; subst; now red.
1948		+ apply NoDupA_altdef. apply NoDupA_rev. apply eqk_equiv.
1949		apply bindings_spec2w.
1950		+ apply PermutationA_equivlistA; auto with *.
1951		apply Permutation_PermutationA; auto with *.
1952		- clearbody l'. clear l Hl Hl' H P m m' Hm.
1953		induction E.
1954		+ reflexivity.
1955		+ simpl. destruct x as (k,e), x' as (k',e').
1956		unfold op, uncurry at 1 3; simpl.
1957		destruct H; simpl in *. rewrite <- (Hf _ _ H _ _ H0).
1958		destruct (f k e); trivial. now f_equiv.
1959		Qed.
1960
1961		Instance for_all_m {elt} :
1962		Proper ((E.eq==>Logic.eq==>Logic.eq)==>Equal==>Logic.eq) (@for_all elt).
1963		Proof.
1964		intros f f' Hf m m' Hm. rewrite 2 for_all_filter.
1965		(* Strange: we cannot rewrite Hm here... *)
1966		f_equiv. f_equiv; trivial.
1967		intros k k' Hk e e' He. f_equal. now apply Hf.
1968		Qed.
1969
1970		Instance exists_m {elt} :
1971		Proper ((E.eq==>Logic.eq==>Logic.eq)==>Equal==>Logic.eq) (@exists_ elt).
1972		Proof.
1973		intros f f' Hf m m' Hm. rewrite 2 exists_filter.
1974		f_equal. now apply is_empty_m, filter_m.
1975		Qed.
1976
1977		Fact diamond_add {elt} : Diamond Equal (@add elt).
1978		Proof.
1979		intros k k' e e' a b b' Hk <- <-. now apply add_add_2.
1980		Qed.
1981
1982		Instance update_m {elt} : Proper (Equal ==> Equal ==> Equal) (@update elt).
1983		Proof.
1984		intros m1 m1' Hm1 m2 m2' Hm2.
1985		unfold update.
1986		apply fold_Proper; auto using diamond_add with *.
1987		Qed.
1988
1989		Instance restrict_m {elt} : Proper (Equal==>Equal==>Equal) (@restrict elt).
1990		Proof.
1991		intros m1 m1' Hm1 m2 m2' Hm2 y.
1992		unfold restrict.
1993		apply eq_option_alt. intros e.
1994		rewrite !find_spec, !filter_iff, Hm1, Hm2. reflexivity.
1995		clear. intros x x' Hx e e' He. now rewrite Hx.
1996		clear. intros x x' Hx e e' He. now rewrite Hx.
1997		Qed.
1998
1999		Instance diff_m {elt} : Proper (Equal==>Equal==>Equal) (@diff elt).
2000		Proof.
2001		intros m1 m1' Hm1 m2 m2' Hm2 y.
2002		unfold diff.
2003		apply eq_option_alt. intros e.
2004		rewrite !find_spec, !filter_iff, Hm1, Hm2. reflexivity.
2005		clear. intros x x' Hx e e' He. now rewrite Hx.
2006		clear. intros x x' Hx e e' He. now rewrite Hx.
2007		Qed.
2008
2009		End WProperties_fun.
2010
2011		(** * Same Properties for self-contained weak maps and for full maps *)
2012
2013		Module WProperties (M:WS) := WProperties_fun M.E M.
2014		Module Properties := WProperties.
2015
2016		(** * Properties specific to maps with ordered keys *)
2017
2018		Module OrdProperties (M:S).
2019		Module Import ME := OrderedTypeFacts M.E.
2020		Module Import O:=KeyOrderedType M.E.
2021		Module Import P:=Properties M.
2022		Import M.
2023
2024		Section Elt.
2025		Variable elt:Type.
2026
2027		Definition Above x (m:t elt) := forall y, In y m -> E.lt y x.
2028		Definition Below x (m:t elt) := forall y, In y m -> E.lt x y.
2029
2030		Section Bindings.
2031
2032		Lemma sort_equivlistA_eqlistA : forall l l' : list (key*elt),
2033		sort ltk l -> sort ltk l' -> equivlistA eqke l l' -> eqlistA eqke l l'.
2034		Proof.
2035		apply SortA_equivlistA_eqlistA; eauto with *.
2036		Qed.
2037
2038		Ltac klean := unfold O.eqke, O.ltk, RelCompFun in ; simpl in .
2039		Ltac keauto := klean; intuition; eauto.
2040
2041		Definition gtb (p p':key*elt) :=
2042		match E.compare (fst p) (fst p') with Gt => true \| _ => false end.
2043		Definition leb p := fun p' => negb (gtb p p').
2044
2045		Definition bindings_lt p m := List.filter (gtb p) (bindings m).
2046		Definition bindings_ge p m := List.filter (leb p) (bindings m).
2047
2048		Lemma gtb_1 : forall p p', gtb p p' = true <-> ltk p' p.
2049		Proof.
2050		intros (x,e) (y,e'); unfold gtb; klean.
2051		case E.compare_spec; intuition; try discriminate; ME.order.
2052		Qed.
2053
2054		Lemma leb_1 : forall p p', leb p p' = true <-> ~ltk p' p.
2055		Proof.
2056		intros (x,e) (y,e'); unfold leb, gtb; klean.
2057		case E.compare_spec; intuition; try discriminate; ME.order.
2058		Qed.
2059
2060		Instance gtb_compat : forall p, Proper (eqke==>eq) (gtb p).
2061		Proof.
2062		red; intros (x,e) (a,e') (b,e'') H; red in H; simpl in *; destruct H.
2063		generalize (gtb_1 (x,e) (a,e'))(gtb_1 (x,e) (b,e''));
2064		destruct (gtb (x,e) (a,e')); destruct (gtb (x,e) (b,e'')); klean; auto.
2065		- intros. symmetry; rewrite H2. rewrite <-H, <-H1; auto.
2066		- intros. rewrite H1. rewrite H, <- H2; auto.
2067		Qed.
2068
2069		Instance leb_compat : forall p, Proper (eqke==>eq) (leb p).
2070		Proof.
2071		intros x a b H. unfold leb; f_equal; apply gtb_compat; auto.
2072		Qed.
2073
2074		Hint Resolve gtb_compat leb_compat bindings_spec2 : map.
2075
2076		Lemma bindings_split : forall p m,
2077		bindings m = bindings_lt p m ++ bindings_ge p m.
2078		Proof.
2079		unfold bindings_lt, bindings_ge, leb; intros.
2080		apply filter_split with (eqA:=eqk) (ltA:=ltk); eauto with *.
2081		intros; destruct x; destruct y; destruct p.
2082		rewrite gtb_1 in H; klean.
2083		apply not_true_iff_false in H0. rewrite gtb_1 in H0. klean. ME.order.
2084		Qed.
2085
2086		Lemma bindings_Add : forall m m' x e, ~In x m -> Add x e m m' ->
2087		eqlistA eqke (bindings m')
2088		(bindings_lt (x,e) m ++ (x,e):: bindings_ge (x,e) m).
2089		Proof.
2090		intros; unfold bindings_lt, bindings_ge.
2091		apply sort_equivlistA_eqlistA; auto with *.
2092		- apply (@SortA_app _ eqke); auto with *.
2093		+ apply (@filter_sort _ eqke); auto with *; keauto.
2094		+ constructor; auto with map.
2095		* apply (@filter_sort _ eqke); auto with *; keauto.
2096		* rewrite (@InfA_alt _ eqke); auto with *; try (keauto; fail).
2097		{ intros.
2098		rewrite filter_InA in H1; auto with *; destruct H1.
2099		rewrite leb_1 in H2.
2100		destruct y; klean.
2101		rewrite <- bindings_mapsto_iff in H1.
2102		assert (~E.eq x t0).
2103		{ contradict H.
2104		exists e0; apply MapsTo_1 with t0; auto.
2105		ME.order. }
2106		ME.order. }
2107		{ apply (@filter_sort _ eqke); auto with *; keauto. }
2108		+ intros.
2109		rewrite filter_InA in H1; auto with *; destruct H1.
2110		rewrite gtb_1 in H3.
2111		destruct y; destruct x0; klean.
2112		inversion_clear H2.
2113		* red in H4; klean; destruct H4; simpl in *. ME.order.
2114		* rewrite filter_InA in H4; auto with *; destruct H4.
2115		rewrite leb_1 in H4. klean; ME.order.
2116		- intros (k,e').
2117		rewrite InA_app_iff, InA_cons, 2 filter_InA,
2118		<-2 bindings_mapsto_iff, leb_1, gtb_1,
2119		find_mapsto_iff, (H0 k), <- find_mapsto_iff,
2120		add_mapsto_iff by (auto with * ).
2121		change (eqke (k,e') (x,e)) with (E.eq k x /\ e' = e).
2122		klean.
2123		split.
2124		+ intros [(->,->)\|(Hk,Hm)].
2125		* right; now left.
2126		* destruct (lt_dec k x); intuition.
2127		+ intros [(Hm,LT)\|[(->,->)\|(Hm,EQ)]].
2128		* right; split; trivial; ME.order.
2129		* now left.
2130		* destruct (eq_dec x k) as [Hk\|Hk].
2131		elim H. exists e'. now rewrite Hk.
2132		right; auto.
2133		Qed.
2134
2135		Lemma bindings_Add_Above : forall m m' x e,
2136		Above x m -> Add x e m m' ->
2137		eqlistA eqke (bindings m') (bindings m ++ (x,e)::nil).
2138		Proof.
2139		intros.
2140		apply sort_equivlistA_eqlistA; auto with *.
2141		apply (@SortA_app _ eqke); auto with *.
2142		intros.
2143		inversion_clear H2.
2144		destruct x0; destruct y.
2145		rewrite <- bindings_mapsto_iff in H1.
2146		destruct H3; klean.
2147		rewrite H2.
2148		apply H; firstorder.
2149		inversion H3.
2150		red; intros a; destruct a.
2151		rewrite InA_app_iff, InA_cons, InA_nil, <- 2 bindings_mapsto_iff,
2152		find_mapsto_iff, (H0 t0), <- find_mapsto_iff,
2153		add_mapsto_iff by (auto with *).
2154		change (eqke (t0,e0) (x,e)) with (E.eq t0 x /\ e0 = e).
2155		intuition.
2156		destruct (E.eq_dec x t0) as [Heq\|Hneq]; auto.
2157		exfalso.
2158		assert (In t0 m) by (exists e0; auto).
2159		generalize (H t0 H1).
2160		ME.order.
2161		Qed.
2162
2163		Lemma bindings_Add_Below : forall m m' x e,
2164		Below x m -> Add x e m m' ->
2165		eqlistA eqke (bindings m') ((x,e)::bindings m).
2166		Proof.
2167		intros.
2168		apply sort_equivlistA_eqlistA; auto with *.
2169		change (sort ltk (((x,e)::nil) ++ bindings m)).
2170		apply (@SortA_app _ eqke); auto with *.
2171		intros.
2172		inversion_clear H1.
2173		destruct y; destruct x0.
2174		rewrite <- bindings_mapsto_iff in H2.
2175		destruct H3; klean.
2176		rewrite H1.
2177		apply H; firstorder.
2178		inversion H3.
2179		red; intros a; destruct a.
2180		rewrite InA_cons, <- 2 bindings_mapsto_iff,
2181		find_mapsto_iff, (H0 t0), <- find_mapsto_iff,
2182		add_mapsto_iff by (auto with * ).
2183		change (eqke (t0,e0) (x,e)) with (E.eq t0 x /\ e0 = e).
2184		intuition.
2185		destruct (E.eq_dec x t0) as [Heq\|Hneq]; auto.
2186		exfalso.
2187		assert (In t0 m) by (exists e0; auto).
2188		generalize (H t0 H1).
2189		ME.order.
2190		Qed.
2191
2192		Lemma bindings_Equal_eqlistA : forall (m m': t elt),
2193		Equal m m' -> eqlistA eqke (bindings m) (bindings m').
2194		Proof.
2195		intros.
2196		apply sort_equivlistA_eqlistA; auto with *.
2197		red; intros.
2198		destruct x; do 2 rewrite <- bindings_mapsto_iff.
2199		do 2 rewrite find_mapsto_iff; rewrite H; split; auto.
2200		Qed.
2201
2202		End Bindings.
2203
2204		Section Min_Max_Elt.
2205
2206		(** We emulate two [max_elt] and [min_elt] functions. *)
2207
2208		Fixpoint max_elt_aux (l:list (key*elt)) := match l with
2209		\| nil => None
2210		\| (x,e)::nil => Some (x,e)
2211		\| (x,e)::l => max_elt_aux l
2212		end.
2213		Definition max_elt m := max_elt_aux (bindings m).
2214
2215		Lemma max_elt_Above :
2216		forall m x e, max_elt m = Some (x,e) -> Above x (remove x m).
2217		Proof.
2218		red; intros.
2219		rewrite remove_in_iff in H0.
2220		destruct H0.
2221		rewrite bindings_in_iff in H1.
2222		destruct H1.
2223		unfold max_elt in *.
2224		generalize (bindings_spec2 m).
2225		revert x e H y x0 H0 H1.
2226		induction (bindings m).
2227		simpl; intros; try discriminate.
2228		intros.
2229		destruct a; destruct l; simpl in *.
2230		injection H; clear H; intros; subst.
2231		inversion_clear H1.
2232		red in H; simpl in *; intuition.
2233		now elim H0.
2234		inversion H.
2235		change (max_elt_aux (p::l) = Some (x,e)) in H.
2236		generalize (IHl x e H); clear IHl; intros IHl.
2237		inversion_clear H1; [ \| inversion_clear H2; eauto ].
2238		red in H3; simpl in H3; destruct H3.
2239		destruct p as (p1,p2).
2240		destruct (E.eq_dec p1 x) as [Heq\|Hneq].
2241		rewrite <- Heq; auto.
2242		inversion_clear H2.
2243		inversion_clear H5.
2244		red in H2; simpl in H2; ME.order.
2245		transitivity p1; auto.
2246		inversion_clear H2.
2247		inversion_clear H5.
2248		red in H2; simpl in H2; ME.order.
2249		eapply IHl; eauto with *.
2250		econstructor; eauto.
2251		red; eauto with *.
2252		inversion H2; auto.
2253		Qed.
2254
2255		Lemma max_elt_MapsTo :
2256		forall m x e, max_elt m = Some (x,e) -> MapsTo x e m.
2257		Proof.
2258		intros.
2259		unfold max_elt in *.
2260		rewrite bindings_mapsto_iff.
2261		induction (bindings m).
2262		simpl; try discriminate.
2263		destruct a; destruct l; simpl in *.
2264		injection H; intros; subst; constructor; red; auto with *.
2265		constructor 2; auto.
2266		Qed.
2267
2268		Lemma max_elt_Empty :
2269		forall m, max_elt m = None -> Empty m.
2270		Proof.
2271		intros.
2272		unfold max_elt in *.
2273		rewrite bindings_Empty.
2274		induction (bindings m); auto.
2275		destruct a; destruct l; simpl in *; try discriminate.
2276		assert (H':=IHl H); discriminate.
2277		Qed.
2278
2279		Definition min_elt m : option (key*elt) := match bindings m with
2280		\| nil => None
2281		\| (x,e)::_ => Some (x,e)
2282		end.
2283
2284		Lemma min_elt_Below :
2285		forall m x e, min_elt m = Some (x,e) -> Below x (remove x m).
2286		Proof.
2287		unfold min_elt, Below; intros.
2288		rewrite remove_in_iff in H0; destruct H0.
2289		rewrite bindings_in_iff in H1.
2290		destruct H1.
2291		generalize (bindings_spec2 m).
2292		destruct (bindings m).
2293		try discriminate.
2294		destruct p; injection H; intros; subst.
2295		inversion_clear H1.
2296		red in H2; destruct H2; simpl in *; ME.order.
2297		inversion_clear H4.
2298		rewrite (@InfA_alt _ eqke) in H3; eauto with *.
2299		apply (H3 (y,x0)); auto.
2300		Qed.
2301
2302		Lemma min_elt_MapsTo :
2303		forall m x e, min_elt m = Some (x,e) -> MapsTo x e m.
2304		Proof.
2305		intros.
2306		unfold min_elt in *.
2307		rewrite bindings_mapsto_iff.
2308		destruct (bindings m).
2309		simpl; try discriminate.
2310		destruct p; simpl in *.
2311		injection H; intros; subst; constructor; red; auto with *.
2312		Qed.
2313
2314		Lemma min_elt_Empty :
2315		forall m, min_elt m = None -> Empty m.
2316		Proof.
2317		intros.
2318		unfold min_elt in *.
2319		rewrite bindings_Empty.
2320		destruct (bindings m); auto.
2321		destruct p; simpl in *; discriminate.
2322		Qed.
2323
2324		End Min_Max_Elt.
2325
2326		Section Induction_Principles.
2327
2328		Lemma map_induction_max :
2329		forall P : t elt -> Type,
2330		(forall m, Empty m -> P m) ->
2331		(forall m m', P m -> forall x e, Above x m -> Add x e m m' -> P m') ->
2332		forall m, P m.
2333		Proof.
2334		intros; remember (cardinal m) as n; revert m Heqn; induction n; intros.
2335		apply X; apply cardinal_inv_1; auto.
2336
2337		case_eq (max_elt m); intros.
2338		destruct p.
2339		assert (Add k e (remove k m) m).
2340		{ apply max_elt_MapsTo, find_spec, add_id in H.
2341		unfold Add. symmetry. now rewrite add_remove_1. }
2342		apply X0 with (remove k m) k e; auto with map.
2343		apply IHn.
2344		assert (S n = S (cardinal (remove k m))).
2345		{ rewrite Heqn.
2346		eapply cardinal_S; eauto with map. }
2347		inversion H1; auto.
2348		eapply max_elt_Above; eauto.
2349
2350		apply X; apply max_elt_Empty; auto.
2351		Qed.
2352
2353		Lemma map_induction_min :
2354		forall P : t elt -> Type,
2355		(forall m, Empty m -> P m) ->
2356		(forall m m', P m -> forall x e, Below x m -> Add x e m m' -> P m') ->
2357		forall m, P m.
2358		Proof.
2359		intros; remember (cardinal m) as n; revert m Heqn; induction n; intros.
2360		apply X; apply cardinal_inv_1; auto.
2361
2362		case_eq (min_elt m); intros.
2363		destruct p.
2364		assert (Add k e (remove k m) m).
2365		{ apply min_elt_MapsTo, find_spec, add_id in H.
2366		unfold Add. symmetry. now rewrite add_remove_1. }
2367		apply X0 with (remove k m) k e; auto.
2368		apply IHn.
2369		assert (S n = S (cardinal (remove k m))).
2370		{ rewrite Heqn.
2371		eapply cardinal_S; eauto with map. }
2372		inversion H1; auto.
2373		eapply min_elt_Below; eauto.
2374
2375		apply X; apply min_elt_Empty; auto.
2376		Qed.
2377
2378		End Induction_Principles.
2379
2380		Section Fold_properties.
2381
2382		(** The following lemma has already been proved on Weak Maps,
2383		but with one additionnal hypothesis (some [transpose] fact). *)
2384
2385		Lemma fold_Equal : forall m1 m2 (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA)
2386		(f:key->elt->A->A)(i:A),
2387		Proper (E.eq==>eq==>eqA==>eqA) f ->
2388		Equal m1 m2 ->
2389		eqA (fold f m1 i) (fold f m2 i).
2390		Proof.
2391		intros m1 m2 A eqA st f i Hf Heq.
2392		rewrite 2 fold_spec_right.
2393		apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto.
2394		intros (k,e) (k',e') (Hk,He) a a' Ha; simpl in *; apply Hf; auto.
2395		apply eqlistA_rev. apply bindings_Equal_eqlistA. auto.
2396		Qed.
2397
2398		Lemma fold_Add_Above : forall m1 m2 x e (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA)
2399		(f:key->elt->A->A)(i:A) (P:Proper (E.eq==>eq==>eqA==>eqA) f),
2400		Above x m1 -> Add x e m1 m2 ->
2401		eqA (fold f m2 i) (f x e (fold f m1 i)).
2402		Proof.
2403		intros. rewrite 2 fold_spec_right. set (f':=uncurry f).
2404		transitivity (fold_right f' i (rev (bindings m1 ++ (x,e)::nil))).
2405		apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto.
2406		intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; unfold f'; simpl in *. apply P; auto.
2407		apply eqlistA_rev.
2408		apply bindings_Add_Above; auto.
2409		rewrite distr_rev; simpl.
2410		reflexivity.
2411		Qed.
2412
2413		Lemma fold_Add_Below : forall m1 m2 x e (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA)
2414		(f:key->elt->A->A)(i:A) (P:Proper (E.eq==>eq==>eqA==>eqA) f),
2415		Below x m1 -> Add x e m1 m2 ->
2416		eqA (fold f m2 i) (fold f m1 (f x e i)).
2417		Proof.
2418		intros. rewrite 2 fold_spec_right. set (f':=uncurry f).
2419		transitivity (fold_right f' i (rev (((x,e)::nil)++bindings m1))).
2420		apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto.
2421		intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; unfold f'; simpl in *; apply P; auto.
2422		apply eqlistA_rev.
2423		simpl; apply bindings_Add_Below; auto.
2424		rewrite distr_rev; simpl.
2425		rewrite fold_right_app.
2426		reflexivity.
2427		Qed.
2428
2429		End Fold_properties.
2430
2431		End Elt.
2432
2433		End OrdProperties.

+0

-292

~~theories/MMaps/MMapInterface.v~~ less more

0		(***********************************************************************)
1		(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
3		(* \VV/ *************************************************************)
4		(* // * This file is distributed under the terms of the *)
5		(* * GNU Lesser General Public License Version 2.1 *)
6		(***********************************************************************)
7
8		(** * Finite map library *)
9
10		(** This file proposes interfaces for finite maps *)
11
12		Require Export Bool Equalities Orders SetoidList.
13		Set Implicit Arguments.
14		Unset Strict Implicit.
15
16		(** When compared with Ocaml Map, this signature has been split in
17		several parts :
18
19		- The first parts [WSfun] and [WS] propose signatures for weak
20		maps, which are maps with no ordering on the key type nor the
21		data type. [WSfun] and [WS] are almost identical, apart from the
22		fact that [WSfun] is expressed in a functorial way whereas [WS]
23		is self-contained. For obtaining an instance of such signatures,
24		a decidable equality on keys in enough (see for example
25		[FMapWeakList]). These signatures contain the usual operators
26		(add, find, ...). The only function that asks for more is
27		[equal], whose first argument should be a comparison on data.
28
29		- Then comes [Sfun] and [S], that extend [WSfun] and [WS] to the
30		case where the key type is ordered. The main novelty is that
31		[bindings] is required to produce sorted lists.
32
33		- Finally, [Sord] extends [S] with a complete comparison function. For
34		that, the data type should have a decidable total ordering as well.
35
36		If unsure, what you're looking for is probably [S]: apart from [Sord],
37		all other signatures are subsets of [S].
38
39		Some additional differences with Ocaml:
40
41		- no [iter] function, useless since Coq is purely functional
42		- [option] types are used instead of [Not_found] exceptions
43
44		*)
45
46
47		Definition Cmp {elt:Type}(cmp:elt->elt->bool) e1 e2 := cmp e1 e2 = true.
48
49		( Weak signature for maps
50
51		No requirements for an ordering on keys nor elements, only decidability
52		of equality on keys. First, a functorial signature: *)
53
54		Module Type WSfun (E : DecidableType).
55
56		Definition key := E.t.
57		Hint Transparent key.
58
59		Definition eq_key {elt} (p p':key*elt) := E.eq (fst p) (fst p').
60
61		Definition eq_key_elt {elt} (p p':key*elt) :=
62		E.eq (fst p) (fst p') /\ (snd p) = (snd p').
63
64		Parameter t : Type -> Type.
65		(** the abstract type of maps *)
66
67		Section Ops.
68
69		Parameter empty : forall {elt}, t elt.
70		(** The empty map. *)
71
72		Variable elt:Type.
73
74		Parameter is_empty : t elt -> bool.
75		(** Test whether a map is empty or not. *)
76
77		Parameter add : key -> elt -> t elt -> t elt.
78		(** [add x y m] returns a map containing the same bindings as [m],
79		plus a binding of [x] to [y]. If [x] was already bound in [m],
80		its previous binding disappears. *)
81
82		Parameter find : key -> t elt -> option elt.
83		(** [find x m] returns the current binding of [x] in [m],
84		or [None] if no such binding exists. *)
85
86		Parameter remove : key -> t elt -> t elt.
87		(** [remove x m] returns a map containing the same bindings as [m],
88		except for [x] which is unbound in the returned map. *)
89
90		Parameter mem : key -> t elt -> bool.
91		(** [mem x m] returns [true] if [m] contains a binding for [x],
92		and [false] otherwise. *)
93
94		Parameter bindings : t elt -> list (key*elt).
95		(** [bindings m] returns an assoc list corresponding to the bindings
96		of [m], in any order. *)
97
98		Parameter cardinal : t elt -> nat.
99		(** [cardinal m] returns the number of bindings in [m]. *)
100
101		Parameter fold : forall A: Type, (key -> elt -> A -> A) -> t elt -> A -> A.
102		(** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
103		where [k1] ... [kN] are the keys of all bindings in [m]
104		(in any order), and [d1] ... [dN] are the associated data. *)
105
106		Parameter equal : (elt -> elt -> bool) -> t elt -> t elt -> bool.
107		(** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal,
108		that is, contain equal keys and associate them with equal data.
109		[cmp] is the equality predicate used to compare the data associated
110		with the keys. *)
111
112		Variable elt' elt'' : Type.
113
114		Parameter map : (elt -> elt') -> t elt -> t elt'.
115		(** [map f m] returns a map with same domain as [m], where the associated
116		value a of all bindings of [m] has been replaced by the result of the
117		application of [f] to [a]. Since Coq is purely functional, the order
118		in which the bindings are passed to [f] is irrelevant. *)
119
120		Parameter mapi : (key -> elt -> elt') -> t elt -> t elt'.
121		(** Same as [map], but the function receives as arguments both the
122		key and the associated value for each binding of the map. *)
123
124		Parameter merge : (key -> option elt -> option elt' -> option elt'') ->
125		t elt -> t elt' -> t elt''.
126		(** [merge f m m'] creates a new map whose bindings belong to the ones
127		of either [m] or [m']. The presence and value for a key [k] is
128		determined by [f k e e'] where [e] and [e'] are the (optional)
129		bindings of [k] in [m] and [m']. *)
130
131		End Ops.
132		Section Specs.
133
134		Variable elt:Type.
135
136		Parameter MapsTo : key -> elt -> t elt -> Prop.
137
138		Definition In (k:key)(m: t elt) : Prop := exists e:elt, MapsTo k e m.
139
140		Global Declare Instance MapsTo_compat :
141		Proper (E.eq==>Logic.eq==>Logic.eq==>iff) MapsTo.
142
143		Variable m m' : t elt.
144		Variable x y : key.
145		Variable e : elt.
146
147		Parameter find_spec : find x m = Some e <-> MapsTo x e m.
148		Parameter mem_spec : mem x m = true <-> In x m.
149		Parameter empty_spec : find x (@empty elt) = None.
150		Parameter is_empty_spec : is_empty m = true <-> forall x, find x m = None.
151		Parameter add_spec1 : find x (add x e m) = Some e.
152		Parameter add_spec2 : ~E.eq x y -> find y (add x e m) = find y m.
153		Parameter remove_spec1 : find x (remove x m) = None.
154		Parameter remove_spec2 : ~E.eq x y -> find y (remove x m) = find y m.
155
156		(** Specification of [bindings] *)
157		Parameter bindings_spec1 :
158		InA eq_key_elt (x,e) (bindings m) <-> MapsTo x e m.
159		(** When compared with ordered maps, here comes the only
160		property that is really weaker: *)
161		Parameter bindings_spec2w : NoDupA eq_key (bindings m).
162
163		(** Specification of [cardinal] *)
164		Parameter cardinal_spec : cardinal m = length (bindings m).
165
166		(** Specification of [fold] *)
167		Parameter fold_spec :
168		forall {A} (i : A) (f : key -> elt -> A -> A),
169		fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.
170
171		(** Equality of maps *)
172
173		(** Caveat: there are at least three distinct equality predicates on maps.
174		- The simpliest (and maybe most natural) way is to consider keys up to
175		their equivalence [E.eq], but elements up to Leibniz equality, in
176		the spirit of [eq_key_elt] above. This leads to predicate [Equal].
177		- Unfortunately, this [Equal] predicate can't be used to describe
178		the [equal] function, since this function (for compatibility with
179		ocaml) expects a boolean comparison [cmp] that may identify more
180		elements than Leibniz. So logical specification of [equal] is done
181		via another predicate [Equivb]
182		- This predicate [Equivb] is quite ad-hoc with its boolean [cmp],
183		it can be generalized in a [Equiv] expecting a more general
184		(possibly non-decidable) equality predicate on elements *)
185
186		Definition Equal (m m':t elt) := forall y, find y m = find y m'.
187		Definition Equiv (eq_elt:elt->elt->Prop) m m' :=
188		(forall k, In k m <-> In k m') /\
189		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e').
190		Definition Equivb (cmp: elt->elt->bool) := Equiv (Cmp cmp).
191
192		(** Specification of [equal] *)
193		Parameter equal_spec : forall cmp : elt -> elt -> bool,
194		equal cmp m m' = true <-> Equivb cmp m m'.
195
196		End Specs.
197		Section SpecMaps.
198
199		Variables elt elt' elt'' : Type.
200
201		Parameter map_spec : forall (f:elt->elt') m x,
202		find x (map f m) = option_map f (find x m).
203
204		Parameter mapi_spec : forall (f:key->elt->elt') m x,
205		exists y:key, E.eq y x /\ find x (mapi f m) = option_map (f y) (find x m).
206
207		Parameter merge_spec1 :
208		forall (f:key->option elt->option elt'->option elt'') m m' x,
209		In x m \/ In x m' ->
210		exists y:key, E.eq y x /\
211		find x (merge f m m') = f y (find x m) (find x m').
212
213		Parameter merge_spec2 :
214		forall (f:key -> option elt->option elt'->option elt'') m m' x,
215		In x (merge f m m') -> In x m \/ In x m'.
216
217		End SpecMaps.
218		End WSfun.
219
220		( Static signature for Weak Maps
221
222		Similar to [WSfun] but expressed in a self-contained way. *)
223
224		Module Type WS.
225		Declare Module E : DecidableType.
226		Include WSfun E.
227		End WS.
228
229
230
231		( Maps on ordered keys, functorial signature *)
232
233		Module Type Sfun (E : OrderedType).
234		Include WSfun E.
235
236		Definition lt_key {elt} (p p':key*elt) := E.lt (fst p) (fst p').
237
238		(** Additional specification of [bindings] *)
239
240		Parameter bindings_spec2 : forall {elt}(m : t elt), sort lt_key (bindings m).
241
242		(** Remark: since [fold] is specified via [bindings], this stronger
243		specification of [bindings] has an indirect impact on [fold],
244		which can now be proved to receive bindings in increasing order. *)
245
246		End Sfun.
247
248
249		( Maps on ordered keys, self-contained signature *)
250
251		Module Type S.
252		Declare Module E : OrderedType.
253		Include Sfun E.
254		End S.
255
256
257
258		( Maps with ordering both on keys and datas *)
259
260		Module Type Sord.
261
262		Declare Module Data : OrderedType.
263		Declare Module MapS : S.
264		Import MapS.
265
266		Definition t := MapS.t Data.t.
267
268		Include HasEq <+ HasLt <+ IsEq <+ IsStrOrder.
269
270		Definition cmp e e' :=
271		match Data.compare e e' with Eq => true \| _ => false end.
272
273		Parameter eq_spec : forall m m', eq m m' <-> Equivb cmp m m'.
274
275		Parameter compare : t -> t -> comparison.
276
277		Parameter compare_spec : forall m1 m2, CompSpec eq lt m1 m2 (compare m1 m2).
278
279		End Sord.
280
281
282		(* TODO: provides filter + partition *)
283
284		(* TODO: provide split
285		Parameter split : key -> t elt -> t elt * option elt * t elt.
286
287		Parameter split_spec k m :
288		split k m = (filter (fun x -> E.compare x k) m, find k m, filter ...)
289
290		min_binding, max_binding, choose ?
291		*)

+0

-1144

~~theories/MMaps/MMapList.v~~ less more

0		(***********************************************************************)
1		(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
3		(* \VV/ *************************************************************)
4		(* // * This file is distributed under the terms of the *)
5		(* * GNU Lesser General Public License Version 2.1 *)
6		(***********************************************************************)
7
8		(** * Finite map library *)
9
10		(** This file proposes an implementation of the non-dependant interface
11		[MMapInterface.S] using lists of pairs ordered (increasing) with respect to
12		left projection. *)
13
14		Require Import MMapInterface OrdersFacts OrdersLists.
15
16		Set Implicit Arguments.
17		Unset Strict Implicit.
18
19		Module Raw (X:OrderedType).
20
21		Module Import MX := OrderedTypeFacts X.
22		Module Import PX := KeyOrderedType X.
23
24		Definition key := X.t.
25		Definition t (elt:Type) := list (X.t * elt).
26
27		Local Notation Sort := (sort ltk).
28		Local Notation Inf := (lelistA (ltk)).
29
30		Section Elt.
31		Variable elt : Type.
32
33		Ltac SortLt :=
34		match goal with
35		\| H1 : Sort ?m, H2:Inf (?k',?e') ?m, H3:In ?k ?m \|- _ =>
36		assert (X.lt k' k);
37		[let e := fresh "e" in destruct H3 as (e,H3);
38		change (ltk (k',e') (k,e));
39		apply (Sort_Inf_In H1 H2 (InA_eqke_eqk H3)) \| ]
40		\| H1:Sort ?m, H2:Inf (?k',?e') ?m, H3:MapsTo ?k ?e ?m \|- _ =>
41		assert (X.lt k' k);
42		[change (ltk (k',e') (k,e));
43		apply (Sort_Inf_In H1 H2 (InA_eqke_eqk H3)) \| ]
44		\| H1:Sort ?m, H2:Inf (?k',?e') ?m, H3:InA eqke (?k,?e) ?m \|- _ =>
45		assert (X.lt k' k);
46		[change (ltk (k',e') (k,e));
47		apply (Sort_Inf_In H1 H2 (InA_eqke_eqk H3)) \| ]
48		end.
49
50		(** * [find] *)
51
52		Fixpoint find (k:key) (m: t elt) : option elt :=
53		match m with
54		\| nil => None
55		\| (k',x)::m' =>
56		match X.compare k k' with
57		\| Lt => None
58		\| Eq => Some x
59		\| Gt => find k m'
60		end
61		end.
62
63		Lemma find_spec m (Hm:Sort m) x e :
64		find x m = Some e <-> MapsTo x e m.
65		Proof.
66		induction m as [\|(k,e') m IH]; simpl.
67		- split. discriminate. inversion 1.
68		- inversion_clear Hm.
69		unfold MapsTo in *. rewrite InA_cons, eqke_def.
70		case X.compare_spec; intros.
71		+ split. injection 1 as ->; auto.
72		intros [(_,<-)\|IN]; trivial. SortLt. MX.order.
73		+ split. discriminate.
74		intros [(E,<-)\|IN]; trivial; try SortLt; MX.order.
75		+ rewrite IH; trivial. split; auto.
76		intros [(E,<-)\|IN]; trivial. MX.order.
77		Qed.
78
79		(** * [mem] *)
80
81		Fixpoint mem (k : key) (m : t elt) : bool :=
82		match m with
83		\| nil => false
84		\| (k',_) :: l =>
85		match X.compare k k' with
86		\| Lt => false
87		\| Eq => true
88		\| Gt => mem k l
89		end
90		end.
91
92		Lemma mem_spec m (Hm:Sort m) x : mem x m = true <-> In x m.
93		Proof.
94		induction m as [\|(k,e') m IH]; simpl.
95		- split. discriminate. inversion 1. inversion_clear H0.
96		- inversion_clear Hm.
97		rewrite In_cons; simpl.
98		case X.compare_spec; intros.
99		+ intuition.
100		+ split. discriminate. intros [E\|(e,IN)]. MX.order.
101		SortLt. MX.order.
102		+ rewrite IH; trivial. split; auto. intros [E\|IN]; trivial.
103		MX.order.
104		Qed.
105
106		(** * [empty] *)
107
108		Definition empty : t elt := nil.
109
110		Lemma empty_spec x : find x empty = None.
111		Proof.
112		reflexivity.
113		Qed.
114
115		Lemma empty_sorted : Sort empty.
116		Proof.
117		unfold empty; auto.
118		Qed.
119
120		(** * [is_empty] *)
121
122		Definition is_empty (l : t elt) : bool := if l then true else false.
123
124		Lemma is_empty_spec m :
125		is_empty m = true <-> forall x, find x m = None.
126		Proof.
127		destruct m as [\|(k,e) m]; simpl; split; trivial; try discriminate.
128		intros H. specialize (H k). now rewrite compare_refl in H.
129		Qed.
130
131		(** * [add] *)
132
133		Fixpoint add (k : key) (x : elt) (s : t elt) : t elt :=
134		match s with
135		\| nil => (k,x) :: nil
136		\| (k',y) :: l =>
137		match X.compare k k' with
138		\| Lt => (k,x)::s
139		\| Eq => (k,x)::l
140		\| Gt => (k',y) :: add k x l
141		end
142		end.
143
144		Lemma add_spec1 m x e : find x (add x e m) = Some e.
145		Proof.
146		induction m as [\|(k,e') m IH]; simpl.
147		- now rewrite compare_refl.
148		- case X.compare_spec; simpl; rewrite ?compare_refl; trivial.
149		rewrite <- compare_gt_iff. now intros ->.
150		Qed.
151
152		Lemma add_spec2 m x y e : ~X.eq x y -> find y (add x e m) = find y m.
153		Proof.
154		induction m as [\|(k,e') m IH]; simpl.
155		- case X.compare_spec; trivial; MX.order.
156		- case X.compare_spec; simpl; intros; trivial.
157		+ rewrite <-H. case X.compare_spec; trivial; MX.order.
158		+ do 2 (case X.compare_spec; trivial; try MX.order).
159		+ now rewrite IH.
160		Qed.
161
162		Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt),
163		Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m).
164		Proof.
165		induction m.
166		simpl; intuition.
167		intros.
168		destruct a as (x'',e'').
169		inversion_clear H.
170		compute in H0,H1.
171		simpl; case X.compare; intuition.
172		Qed.
173		Hint Resolve add_Inf.
174
175		Lemma add_sorted : forall m (Hm:Sort m) x e, Sort (add x e m).
176		Proof.
177		induction m.
178		simpl; intuition.
179		intros.
180		destruct a as (x',e').
181		simpl; case (X.compare_spec x x'); intuition; inversion_clear Hm; auto.
182		constructor; auto.
183		apply Inf_eq with (x',e'); auto.
184		Qed.
185
186		(** * [remove] *)
187
188		Fixpoint remove (k : key) (s : t elt) : t elt :=
189		match s with
190		\| nil => nil
191		\| (k',x) :: l =>
192		match X.compare k k' with
193		\| Lt => s
194		\| Eq => l
195		\| Gt => (k',x) :: remove k l
196		end
197		end.
198
199		Lemma remove_spec1 m (Hm:Sort m) x : find x (remove x m) = None.
200		Proof.
201		induction m as [\|(k,e') m IH]; simpl; trivial.
202		inversion_clear Hm.
203		case X.compare_spec; simpl.
204		- intros E. rewrite <- E in H0.
205		apply Sort_Inf_NotIn in H0; trivial. unfold In in H0.
206		setoid_rewrite <- find_spec in H0; trivial.
207		destruct (find x m); trivial.
208		elim H0; now exists e.
209		- rewrite <- compare_lt_iff. now intros ->.
210		- rewrite <- compare_gt_iff. intros ->; auto.
211		Qed.
212
213		Lemma remove_spec2 m (Hm:Sort m) x y :
214		~X.eq x y -> find y (remove x m) = find y m.
215		Proof.
216		induction m as [\|(k,e') m IH]; simpl; trivial.
217		inversion_clear Hm.
218		case X.compare_spec; simpl; intros E E'; try rewrite IH; auto.
219		case X.compare_spec; simpl; trivial; try MX.order.
220		intros. rewrite <- E in H0,H1. clear E E'.
221		destruct (find y m) eqn:F; trivial.
222		apply find_spec in F; trivial.
223		SortLt. MX.order.
224		Qed.
225
226		Lemma remove_Inf : forall (m:t elt)(Hm : Sort m)(x x':key)(e':elt),
227		Inf (x',e') m -> Inf (x',e') (remove x m).
228		Proof.
229		induction m.
230		simpl; intuition.
231		intros.
232		destruct a as (x'',e'').
233		inversion_clear H.
234		compute in H0.
235		simpl; case X.compare; intuition.
236		inversion_clear Hm.
237		apply Inf_lt with (x'',e''); auto.
238		Qed.
239		Hint Resolve remove_Inf.
240
241		Lemma remove_sorted : forall m (Hm:Sort m) x, Sort (remove x m).
242		Proof.
243		induction m.
244		simpl; intuition.
245		intros.
246		destruct a as (x',e').
247		simpl; case X.compare_spec; intuition; inversion_clear Hm; auto.
248		Qed.
249
250		(** * [bindings] *)
251
252		Definition bindings (m: t elt) := m.
253
254		Lemma bindings_spec1 m x e :
255		InA eqke (x,e) (bindings m) <-> MapsTo x e m.
256		Proof.
257		reflexivity.
258		Qed.
259
260		Lemma bindings_spec2 m (Hm:Sort m) : sort ltk (bindings m).
261		Proof.
262		auto.
263		Qed.
264
265		Lemma bindings_spec2w m (Hm:Sort m) : NoDupA eqk (bindings m).
266		Proof.
267		now apply Sort_NoDupA.
268		Qed.
269
270		(** * [fold] *)
271
272		Fixpoint fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc:A) : A :=
273		match m with
274		\| nil => acc
275		\| (k,e)::m' => fold f m' (f k e acc)
276		end.
277
278		Lemma fold_spec m : forall (A:Type)(i:A)(f:key->elt->A->A),
279		fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.
280		Proof.
281		induction m as [\|(k,e) m IH]; simpl; auto.
282		Qed.
283
284		(** * [equal] *)
285
286		Fixpoint equal (cmp:elt->elt->bool)(m m' : t elt) : bool :=
287		match m, m' with
288		\| nil, nil => true
289		\| (x,e)::l, (x',e')::l' =>
290		match X.compare x x' with
291		\| Eq => cmp e e' && equal cmp l l'
292		\| _ => false
293		end
294		\| _, _ => false
295		end.
296
297		Definition Equivb (cmp:elt->elt->bool) m m' :=
298		(forall k, In k m <-> In k m') /\
299		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).
300
301		Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp,
302		Equivb cmp m m' -> equal cmp m m' = true.
303		Proof.
304		induction m as [\|(k,e) m IH]; destruct m' as [\|(k',e') m']; simpl.
305		- trivial.
306		- intros _ cmp (H,_).
307		exfalso. apply (@In_nil elt k'). rewrite H, In_cons. now left.
308		- intros _ cmp (H,_).
309		exfalso. apply (@In_nil elt k). rewrite <- H, In_cons. now left.
310		- intros Hm' cmp E.
311		inversion_clear Hm; inversion_clear Hm'.
312		case X.compare_spec; intros E'.
313		+ apply andb_true_intro; split.
314		* eapply E; eauto. apply InA_cons; now left.
315		* apply IH; clear IH; trivial.
316		destruct E as (E1,E2). split.
317		{ intros x. clear E2.
318		split; intros; SortLt.
319		specialize (E1 x); rewrite 2 In_cons in E1; simpl in E1.
320		destruct E1 as ([E1\|E1],_); eauto. MX.order.
321		specialize (E1 x); rewrite 2 In_cons in E1; simpl in E1.
322		destruct E1 as (_,[E1\|E1]); eauto. MX.order. }
323		{ intros x xe xe' Hx HX'. eapply E2; eauto. }
324		+ assert (IN : In k ((k',e')::m')).
325		{ apply E. apply In_cons; now left. }
326		apply In_cons in IN. simpl in IN. destruct IN as [?\|IN]. MX.order.
327		SortLt. MX.order.
328		+ assert (IN : In k' ((k,e)::m)).
329		{ apply E. apply In_cons; now left. }
330		apply In_cons in IN. simpl in IN. destruct IN as [?\|IN]. MX.order.
331		SortLt. MX.order.
332		Qed.
333
334		Lemma equal_2 m (Hm:Sort m) m' (Hm':Sort m') cmp :
335		equal cmp m m' = true -> Equivb cmp m m'.
336		Proof.
337		revert m' Hm'.
338		induction m as [\|(k,e) m IH]; destruct m' as [\|(k',e') m']; simpl;
339		try discriminate.
340		- split. reflexivity. inversion 1.
341		- intros Hm'. case X.compare_spec; try discriminate.
342		rewrite andb_true_iff. intros E (C,EQ).
343		inversion_clear Hm; inversion_clear Hm'.
344		apply IH in EQ; trivial.
345		destruct EQ as (E1,E2).
346		split.
347		+ intros x. rewrite 2 In_cons; simpl. rewrite <- E1.
348		intuition; now left; MX.order.
349		+ intros x ex ex'. unfold MapsTo in *. rewrite 2 InA_cons, 2 eqke_def.
350		intuition; subst.
351		* trivial.
352		* SortLt. MX.order.
353		* SortLt. MX.order.
354		* eapply E2; eauto.
355		Qed.
356
357		Lemma equal_spec m (Hm:Sort m) m' (Hm':Sort m') cmp :
358		equal cmp m m' = true <-> Equivb cmp m m'.
359		Proof.
360		split. now apply equal_2. now apply equal_1.
361		Qed.
362
363		(** This lemma isn't part of the spec of [Equivb], but is used in [MMapAVL] *)
364
365		Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) ->
366		eqk x y -> cmp (snd x) (snd y) = true ->
367		(Equivb cmp l1 l2 <-> Equivb cmp (x :: l1) (y :: l2)).
368		Proof.
369		intros.
370		inversion H; subst.
371		inversion H0; subst.
372		destruct x; destruct y; compute in H1, H2.
373		split; intros.
374		apply equal_2; auto.
375		simpl.
376		case X.compare_spec; intros; try MX.order.
377		rewrite H2; simpl.
378		apply equal_1; auto.
379		apply equal_2; auto.
380		generalize (equal_1 H H0 H3).
381		simpl.
382		case X.compare_spec; try discriminate.
383		rewrite andb_true_iff. intuition.
384		Qed.
385
386		Variable elt':Type.
387
388		(** * [map] and [mapi] *)
389
390		Fixpoint map (f:elt -> elt') (m:t elt) : t elt' :=
391		match m with
392		\| nil => nil
393		\| (k,e)::m' => (k,f e) :: map f m'
394		end.
395
396		Fixpoint mapi (f: key -> elt -> elt') (m:t elt) : t elt' :=
397		match m with
398		\| nil => nil
399		\| (k,e)::m' => (k,f k e) :: mapi f m'
400		end.
401
402		End Elt.
403		Arguments find {elt} k m.
404		Section Elt2.
405		Variable elt elt' : Type.
406
407		(** Specification of [map] *)
408
409		Lemma map_spec (f:elt->elt') m x :
410		find x (map f m) = option_map f (find x m).
411		Proof.
412		induction m as [\|(k,e) m IH]; simpl; trivial.
413		now case X.compare_spec.
414		Qed.
415
416		Lemma map_Inf (f:elt->elt') m x e e' :
417		Inf (x,e) m -> Inf (x,e') (map f m).
418		Proof.
419		induction m as [\|(x0,e0) m IH]; simpl; auto.
420		inversion_clear 1; auto.
421		Qed.
422		Hint Resolve map_Inf.
423
424		Lemma map_sorted (f:elt->elt')(m: t elt)(Hm : Sort m) :
425		Sort (map f m).
426		Proof.
427		induction m as [\|(x,e) m IH]; simpl; auto.
428		inversion_clear Hm. constructor; eauto.
429		Qed.
430
431		(** Specification of [mapi] *)
432
433		Lemma mapi_spec (f:key->elt->elt') m x :
434		exists y, X.eq y x /\ find x (mapi f m) = option_map (f y) (find x m).
435		Proof.
436		induction m as [\|(k,e) m IH]; simpl.
437		- now exists x.
438		- elim X.compare_spec; intros; simpl.
439		+ now exists k.
440		+ now exists x.
441		+ apply IH.
442		Qed.
443
444		Lemma mapi_Inf (f:key->elt->elt') m x e :
445		Inf (x,e) m -> Inf (x,f x e) (mapi f m).
446		Proof.
447		induction m as [\|(x0,e0) m IH]; simpl; auto.
448		inversion_clear 1; auto.
449		Qed.
450		Hint Resolve mapi_Inf.
451
452		Lemma mapi_sorted (f:key->elt->elt') m (Hm : Sort m) :
453		Sort (mapi f m).
454		Proof.
455		induction m as [\|(x,e) m IH]; simpl; auto.
456		inversion_clear Hm; auto.
457		Qed.
458
459		End Elt2.
460		Section Elt3.
461
462		(** * [merge] *)
463
464		Variable elt elt' elt'' : Type.
465		Variable f : key -> option elt -> option elt' -> option elt''.
466
467		Definition option_cons {A}(k:key)(o:option A)(l:list (key*A)) :=
468		match o with
469		\| Some e => (k,e)::l
470		\| None => l
471		end.
472
473		Fixpoint merge_l (m : t elt) : t elt'' :=
474		match m with
475		\| nil => nil
476		\| (k,e)::l => option_cons k (f k (Some e) None) (merge_l l)
477		end.
478
479		Fixpoint merge_r (m' : t elt') : t elt'' :=
480		match m' with
481		\| nil => nil
482		\| (k,e')::l' => option_cons k (f k None (Some e')) (merge_r l')
483		end.
484
485		Fixpoint merge (m : t elt) : t elt' -> t elt'' :=
486		match m with
487		\| nil => merge_r
488		\| (k,e) :: l =>
489		fix merge_aux (m' : t elt') : t elt'' :=
490		match m' with
491		\| nil => merge_l m
492		\| (k',e') :: l' =>
493		match X.compare k k' with
494		\| Lt => option_cons k (f k (Some e) None) (merge l m')
495		\| Eq => option_cons k (f k (Some e) (Some e')) (merge l l')
496		\| Gt => option_cons k' (f k' None (Some e')) (merge_aux l')
497		end
498		end
499		end.
500
501		Notation oee' := (option elt * option elt')%type.
502
503		Fixpoint combine (m : t elt) : t elt' -> t oee' :=
504		match m with
505		\| nil => map (fun e' => (None,Some e'))
506		\| (k,e) :: l =>
507		fix combine_aux (m':t elt') : list (key * oee') :=
508		match m' with
509		\| nil => map (fun e => (Some e,None)) m
510		\| (k',e') :: l' =>
511		match X.compare k k' with
512		\| Lt => (k,(Some e, None))::combine l m'
513		\| Eq => (k,(Some e, Some e'))::combine l l'
514		\| Gt => (k',(None,Some e'))::combine_aux l'
515		end
516		end
517		end.
518
519		Definition fold_right_pair {A B C}(f: A->B->C->C)(l:list (A*B))(i:C) :=
520		List.fold_right (fun p => f (fst p) (snd p)) i l.
521
522		Definition merge' m m' :=
523		let m0 : t oee' := combine m m' in
524		let m1 : t (option elt'') := mapi (fun k p => f k (fst p) (snd p)) m0 in
525		fold_right_pair (option_cons (A:=elt'')) m1 nil.
526
527		Lemma merge_equiv : forall m m', merge' m m' = merge m m'.
528		Proof.
529		unfold merge'.
530		induction m as [\|(k,e) m IHm]; intros.
531		- (* merge_r *)
532		simpl.
533		induction m' as [\|(k',e') m' IHm']; simpl; rewrite ?IHm'; auto.
534		- induction m' as [\|(k',e') m' IHm']; simpl.
535		+ f_equal.
536		(* merge_l *)
537		clear k e IHm.
538		induction m as [\|(k,e) m IHm]; simpl; rewrite ?IHm; auto.
539		+ elim X.compare_spec; intros; simpl; f_equal.
540		* apply IHm.
541		* apply IHm.
542		* apply IHm'.
543		Qed.
544
545		Lemma combine_Inf :
546		forall m m' (x:key)(e:elt)(e':elt')(e'':oee'),
547		Inf (x,e) m ->
548		Inf (x,e') m' ->
549		Inf (x,e'') (combine m m').
550		Proof.
551		induction m.
552		- intros. simpl. eapply map_Inf; eauto.
553		- induction m'; intros.
554		+ destruct a.
555		replace (combine ((t0, e0) :: m) nil) with
556		(map (fun e => (Some e,None (A:=elt'))) ((t0,e0)::m)); auto.
557		eapply map_Inf; eauto.
558		+ simpl.
559		destruct a as (k,e0); destruct a0 as (k',e0').
560		elim X.compare_spec.
561		* inversion_clear H; auto.
562		* inversion_clear H; auto.
563		* inversion_clear H0; auto.
564		Qed.
565		Hint Resolve combine_Inf.
566
567		Lemma combine_sorted m (Hm : Sort m) m' (Hm' : Sort m') :
568		Sort (combine m m').
569		Proof.
570		revert m' Hm'.
571		induction m.
572		- intros; clear Hm. simpl. apply map_sorted; auto.
573		- induction m'; intros.
574		+ clear Hm'.
575		destruct a.
576		replace (combine ((t0, e) :: m) nil) with
577		(map (fun e => (Some e,None (A:=elt'))) ((t0,e)::m)); auto.
578		apply map_sorted; auto.
579		+ simpl.
580		destruct a as (k,e); destruct a0 as (k',e').
581		inversion_clear Hm; inversion_clear Hm'.
582		case X.compare_spec; [intros Heq\| intros Hlt\| intros Hlt];
583		constructor; auto.
584		* assert (Inf (k, e') m') by (apply Inf_eq with (k',e'); auto).
585		exact (combine_Inf _ H0 H3).
586		* assert (Inf (k, e') ((k',e')::m')) by auto.
587		exact (combine_Inf _ H0 H3).
588		* assert (Inf (k', e) ((k,e)::m)) by auto.
589		exact (combine_Inf _ H3 H2).
590		Qed.
591
592		Lemma merge_sorted m (Hm : Sort m) m' (Hm' : Sort m') :
593		Sort (merge m m').
594		Proof.
595		intros.
596		rewrite <- merge_equiv.
597		unfold merge'.
598		assert (Hmm':=combine_sorted Hm Hm').
599		set (l0:=combine m m') in *; clearbody l0.
600		set (f':= fun k p => f k (fst p) (snd p)).
601		assert (H1:=mapi_sorted f' Hmm').
602		set (l1:=mapi f' l0) in *; clearbody l1.
603		clear f' f Hmm' l0 Hm Hm' m m'.
604		(* Sort fold_right_pair *)
605		induction l1.
606		- simpl; auto.
607		- inversion_clear H1.
608		destruct a; destruct o; auto.
609		simpl.
610		constructor; auto.
611		clear IHl1.
612		(* Inf fold_right_pair *)
613		induction l1.
614		+ simpl; auto.
615		+ destruct a; destruct o; simpl; auto.
616		* inversion_clear H0; auto.
617		* inversion_clear H0. inversion_clear H.
618		compute in H1.
619		apply IHl1; auto.
620		apply Inf_lt with (t1, None); auto.
621		Qed.
622
623		Definition at_least_one (o:option elt)(o':option elt') :=
624		match o, o' with
625		\| None, None => None
626		\| _, _ => Some (o,o')
627		end.
628
629		Lemma combine_spec m (Hm : Sort m) m' (Hm' : Sort m') (x:key) :
630		find x (combine m m') = at_least_one (find x m) (find x m').
631		Proof.
632		revert m' Hm'.
633		induction m.
634		intros.
635		simpl.
636		induction m'.
637		intros; simpl; auto.
638		simpl; destruct a.
639		simpl; destruct (X.compare x t0); simpl; auto.
640		inversion_clear Hm'; auto.
641		induction m'.
642		(* m' = nil *)
643		intros; destruct a; simpl.
644		destruct (X.compare_spec x t0) as [ \|Hlt\|Hlt]; simpl; auto.
645		inversion_clear Hm; clear H0 Hlt Hm' IHm t0.
646		induction m; simpl; auto.
647		inversion_clear H.
648		destruct a.
649		simpl; destruct (X.compare x t0); simpl; auto.
650		(* m' <> nil *)
651		intros.
652		destruct a as (k,e); destruct a0 as (k',e'); simpl.
653		inversion Hm; inversion Hm'; subst.
654		destruct (X.compare_spec k k'); simpl;
655		destruct (X.compare_spec x k);
656		MX.order \|\| destruct (X.compare_spec x k');
657		simpl; try MX.order; auto.
658		- rewrite IHm; auto; simpl. elim X.compare_spec; auto; MX.order.
659		- rewrite IHm; auto; simpl. elim X.compare_spec; auto; MX.order.
660		- rewrite IHm; auto; simpl. elim X.compare_spec; auto; MX.order.
661		- change (find x (combine ((k, e) :: m) m') = Some (Some e, find x m')).
662		rewrite IHm'; auto; simpl. elim X.compare_spec; auto; MX.order.
663		- change (find x (combine ((k, e) :: m) m') = at_least_one None (find x m')).
664		rewrite IHm'; auto; simpl. elim X.compare_spec; auto; MX.order.
665		- change (find x (combine ((k, e) :: m) m') =
666		at_least_one (find x m) (find x m')).
667		rewrite IHm'; auto; simpl. elim X.compare_spec; auto; MX.order.
668		Qed.
669
670		Definition at_least_one_then_f k (o:option elt)(o':option elt') :=
671		match o, o' with
672		\| None, None => None
673		\| _, _ => f k o o'
674		end.
675
676		Lemma merge_spec0 m (Hm : Sort m) m' (Hm' : Sort m') (x:key) :
677		exists y, X.eq y x /\
678		find x (merge m m') = at_least_one_then_f y (find x m) (find x m').
679		Proof.
680		intros.
681		rewrite <- merge_equiv.
682		unfold merge'.
683		assert (H:=combine_spec Hm Hm' x).
684		assert (H2:=combine_sorted Hm Hm').
685		set (f':= fun k p => f k (fst p) (snd p)).
686		set (m0 := combine m m') in *; clearbody m0.
687		set (o:=find x m) in *; clearbody o.
688		set (o':=find x m') in *; clearbody o'.
689		clear Hm Hm' m m'. revert H.
690		match goal with \|- ?G =>
691		assert (G/\(find x m0 = None ->
692		find x (fold_right_pair option_cons (mapi f' m0) nil) = None));
693		[\|intuition] end.
694		induction m0; simpl in *; intuition.
695		- exists x; split; [easy\|].
696		destruct o; destruct o'; simpl in *; try discriminate; auto.
697		- destruct a as (k,(oo,oo')); simpl in *.
698		inversion_clear H2.
699		destruct (X.compare_spec x k) as [Heq\|Hlt\|Hlt]; simpl in *.
700		+ (* x = k *)
701		exists k; split; [easy\|].
702		assert (at_least_one_then_f k o o' = f k oo oo').
703		{ destruct o; destruct o'; simpl in *; inversion_clear H; auto. }
704		rewrite H2.
705		unfold f'; simpl.
706		destruct (f k oo oo'); simpl.
707		* elim X.compare_spec; trivial; try MX.order.
708		* destruct (IHm0 H0) as (_,H4); apply H4; auto.
709		case_eq (find x m0); intros; auto.
710		assert (eqk (elt:=oee') (k,(oo,oo')) (x,(oo,oo'))).
711		now compute.
712		symmetry in H5.
713		destruct (Sort_Inf_NotIn H0 (Inf_eq H5 H1)).
714		exists p; apply find_spec; auto.
715		+ (* x < k *)
716		destruct (f' k (oo,oo')); simpl.
717		* elim X.compare_spec; trivial; try MX.order.
718		destruct o; destruct o'; simpl in *; try discriminate; auto.
719		now exists x.
720		* apply IHm0; trivial.
721		rewrite <- H.
722		case_eq (find x m0); intros; auto.
723		assert (ltk (elt:=oee') (x,(oo,oo')) (k,(oo,oo'))).
724		red; auto.
725		destruct (Sort_Inf_NotIn H0 (Inf_lt H3 H1)).
726		exists p; apply find_spec; auto.
727		+ (* k < x *)
728		unfold f'; simpl.
729		destruct (f k oo oo'); simpl.
730		* elim X.compare_spec; trivial; try MX.order.
731		intros. apply IHm0; auto.
732		* apply IHm0; auto.
733
734		- (* None -> None *)
735		destruct a as (k,(oo,oo')).
736		simpl.
737		inversion_clear H2.
738		destruct (X.compare_spec x k) as [Hlt\|Heq\|Hlt]; try discriminate.
739		+ (* x < k *)
740		unfold f'; simpl.
741		destruct (f k oo oo'); simpl.
742		elim X.compare_spec; trivial; try MX.order. intros.
743		apply IHm0; auto.
744		case_eq (find x m0); intros; auto.
745		assert (ltk (elt:=oee') (x,(oo,oo')) (k,(oo,oo'))).
746		now compute.
747		destruct (Sort_Inf_NotIn H0 (Inf_lt H3 H1)).
748		exists p; apply find_spec; auto.
749		+ (* k < x *)
750		unfold f'; simpl.
751		destruct (f k oo oo'); simpl.
752		elim X.compare_spec; trivial; try MX.order. intros.
753		apply IHm0; auto.
754		apply IHm0; auto.
755		Qed.
756
757		(** Specification of [merge] *)
758
759		Lemma merge_spec1 m (Hm : Sort m) m' (Hm' : Sort m')(x:key) :
760		In x m \/ In x m' ->
761		exists y, X.eq y x /\
762		find x (merge m m') = f y (find x m) (find x m').
763		Proof.
764		intros.
765		destruct (merge_spec0 Hm Hm' x) as (y,(Hy,H')).
766		exists y; split; [easy\|]. rewrite H'.
767		destruct H as [(e,H)\|(e,H)];
768		apply find_spec in H; trivial; rewrite H; simpl; auto.
769		now destruct (find x m).
770		Qed.
771
772		Lemma merge_spec2 m (Hm : Sort m) m' (Hm' : Sort m')(x:key) :
773		In x (merge m m') -> In x m \/ In x m'.
774		Proof.
775		intros.
776		destruct H as (e,H).
777		apply find_spec in H; auto using merge_sorted.
778		destruct (merge_spec0 Hm Hm' x) as (y,(Hy,H')).
779		rewrite H in H'.
780		destruct (find x m) eqn:F.
781		- apply find_spec in F; eauto.
782		- destruct (find x m') eqn:F'.
783		+ apply find_spec in F'; eauto.
784		+ simpl in H'. discriminate.
785		Qed.
786
787		End Elt3.
788		End Raw.
789
790		Module Make (X: OrderedType) <: S with Module E := X.
791		Module Raw := Raw X.
792		Module E := X.
793
794		Definition key := E.t.
795		Definition eq_key {elt} := @Raw.PX.eqk elt.
796		Definition eq_key_elt {elt} := @Raw.PX.eqke elt.
797		Definition lt_key {elt} := @Raw.PX.ltk elt.
798
799		Record t_ (elt:Type) := Mk
800		{this :> Raw.t elt;
801		sorted : sort Raw.PX.ltk this}.
802		Definition t := t_.
803
804		Definition empty {elt} := Mk (Raw.empty_sorted elt).
805
806		Section Elt.
807		Variable elt elt' elt'':Type.
808
809		Implicit Types m : t elt.
810		Implicit Types x y : key.
811		Implicit Types e : elt.
812
813		Definition is_empty m : bool := Raw.is_empty m.(this).
814		Definition add x e m : t elt := Mk (Raw.add_sorted m.(sorted) x e).
815		Definition find x m : option elt := Raw.find x m.(this).
816		Definition remove x m : t elt := Mk (Raw.remove_sorted m.(sorted) x).
817		Definition mem x m : bool := Raw.mem x m.(this).
818		Definition map f m : t elt' := Mk (Raw.map_sorted f m.(sorted)).
819		Definition mapi (f:key->elt->elt') m : t elt' :=
820		Mk (Raw.mapi_sorted f m.(sorted)).
821		Definition merge f m (m':t elt') : t elt'' :=
822		Mk (Raw.merge_sorted f m.(sorted) m'.(sorted)).
823		Definition bindings m : list (key*elt) := Raw.bindings m.(this).
824		Definition cardinal m := length m.(this).
825		Definition fold {A:Type}(f:key->elt->A->A) m (i:A) : A :=
826		Raw.fold f m.(this) i.
827		Definition equal cmp m m' : bool := Raw.equal cmp m.(this) m'.(this).
828
829		Definition MapsTo x e m : Prop := Raw.PX.MapsTo x e m.(this).
830		Definition In x m : Prop := Raw.PX.In x m.(this).
831
832		Definition Equal m m' := forall y, find y m = find y m'.
833		Definition Equiv (eq_elt:elt->elt->Prop) m m' :=
834		(forall k, In k m <-> In k m') /\
835		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e').
836		Definition Equivb cmp m m' : Prop := @Raw.Equivb elt cmp m.(this) m'.(this).
837
838		Instance MapsTo_compat :
839		Proper (E.eq==>Logic.eq==>Logic.eq==>iff) MapsTo.
840		Proof.
841		intros x x' Hx e e' <- m m' <-. unfold MapsTo. now rewrite Hx.
842		Qed.
843
844		Lemma find_spec m : forall x e, find x m = Some e <-> MapsTo x e m.
845		Proof. exact (Raw.find_spec m.(sorted)). Qed.
846
847		Lemma mem_spec m : forall x, mem x m = true <-> In x m.
848		Proof. exact (Raw.mem_spec m.(sorted)). Qed.
849
850		Lemma empty_spec : forall x, find x empty = None.
851		Proof. exact (Raw.empty_spec _). Qed.
852
853		Lemma is_empty_spec m : is_empty m = true <-> (forall x, find x m = None).
854		Proof. exact (Raw.is_empty_spec m.(this)). Qed.
855
856		Lemma add_spec1 m : forall x e, find x (add x e m) = Some e.
857		Proof. exact (Raw.add_spec1 m.(this)). Qed.
858		Lemma add_spec2 m : forall x y e, ~E.eq x y -> find y (add x e m) = find y m.
859		Proof. exact (Raw.add_spec2 m.(this)). Qed.
860
861		Lemma remove_spec1 m : forall x, find x (remove x m) = None.
862		Proof. exact (Raw.remove_spec1 m.(sorted)). Qed.
863		Lemma remove_spec2 m : forall x y, ~E.eq x y -> find y (remove x m) = find y m.
864		Proof. exact (Raw.remove_spec2 m.(sorted)). Qed.
865
866		Lemma bindings_spec1 m : forall x e,
867		InA eq_key_elt (x,e) (bindings m) <-> MapsTo x e m.
868		Proof. exact (Raw.bindings_spec1 m.(this)). Qed.
869		Lemma bindings_spec2w m : NoDupA eq_key (bindings m).
870		Proof. exact (Raw.bindings_spec2w m.(sorted)). Qed.
871		Lemma bindings_spec2 m : sort lt_key (bindings m).
872		Proof. exact (Raw.bindings_spec2 m.(sorted)). Qed.
873
874		Lemma cardinal_spec m : cardinal m = length (bindings m).
875		Proof. reflexivity. Qed.
876
877		Lemma fold_spec m : forall (A : Type) (i : A) (f : key -> elt -> A -> A),
878		fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.
879		Proof. exact (Raw.fold_spec m.(this)). Qed.
880
881		Lemma equal_spec m m' : forall cmp, equal cmp m m' = true <-> Equivb cmp m m'.
882		Proof. exact (Raw.equal_spec m.(sorted) m'.(sorted)). Qed.
883
884		End Elt.
885
886		Lemma map_spec {elt elt'} (f:elt->elt') m :
887		forall x, find x (map f m) = option_map f (find x m).
888		Proof. exact (Raw.map_spec f m.(this)). Qed.
889
890		Lemma mapi_spec {elt elt'} (f:key->elt->elt') m :
891		forall x, exists y,
892		E.eq y x /\ find x (mapi f m) = option_map (f y) (find x m).
893		Proof. exact (Raw.mapi_spec f m.(this)). Qed.
894
895		Lemma merge_spec1 {elt elt' elt''}
896		(f:key->option elt->option elt'->option elt'') m m' :
897		forall x,
898		In x m \/ In x m' ->
899		exists y, E.eq y x /\ find x (merge f m m') = f y (find x m) (find x m').
900		Proof. exact (Raw.merge_spec1 f m.(sorted) m'.(sorted)). Qed.
901
902		Lemma merge_spec2 {elt elt' elt''}
903		(f:key->option elt->option elt'->option elt'') m m' :
904		forall x,
905		In x (merge f m m') -> In x m \/ In x m'.
906		Proof. exact (Raw.merge_spec2 m.(sorted) m'.(sorted)). Qed.
907
908		End Make.
909
910		Module Make_ord (X: OrderedType)(D : OrderedType) <:
911		Sord with Module Data := D
912		with Module MapS.E := X.
913
914		Module Data := D.
915		Module MapS := Make(X).
916		Import MapS.
917
918		Module MD := OrderedTypeFacts(D).
919		Import MD.
920
921		Definition t := MapS.t D.t.
922
923		Definition cmp e e' :=
924		match D.compare e e' with Eq => true \| _ => false end.
925
926		Fixpoint eq_list (m m' : list (X.t * D.t)) : Prop :=
927		match m, m' with
928		\| nil, nil => True
929		\| (x,e)::l, (x',e')::l' =>
930		match X.compare x x' with
931		\| Eq => D.eq e e' /\ eq_list l l'
932		\| _ => False
933		end
934		\| _, _ => False
935		end.
936
937		Definition eq m m' := eq_list m.(this) m'.(this).
938
939		Fixpoint lt_list (m m' : list (X.t * D.t)) : Prop :=
940		match m, m' with
941		\| nil, nil => False
942		\| nil, _ => True
943		\| _, nil => False
944		\| (x,e)::l, (x',e')::l' =>
945		match X.compare x x' with
946		\| Lt => True
947		\| Gt => False
948		\| Eq => D.lt e e' \/ (D.eq e e' /\ lt_list l l')
949		end
950		end.
951
952		Definition lt m m' := lt_list m.(this) m'.(this).
953
954		Lemma eq_equal : forall m m', eq m m' <-> equal cmp m m' = true.
955		Proof.
956		intros (l,Hl); induction l.
957		intros (l',Hl'); unfold eq; simpl.
958		destruct l'; unfold equal; simpl; intuition.
959		intros (l',Hl'); unfold eq.
960		destruct l'.
961		destruct a; unfold equal; simpl; intuition.
962		destruct a as (x,e).
963		destruct p as (x',e').
964		unfold equal; simpl.
965		destruct (X.compare_spec x x') as [Hlt\|Heq\|Hlt]; simpl; intuition.
966		unfold cmp at 1.
967		elim D.compare_spec; try MD.order; simpl.
968		inversion_clear Hl.
969		inversion_clear Hl'.
970		destruct (IHl H (Mk H3)).
971		unfold equal, eq in H5; simpl in H5; auto.
972		destruct (andb_prop _ _ H); clear H.
973		generalize H0; unfold cmp.
974		elim D.compare_spec; try MD.order; simpl; try discriminate.
975		destruct (andb_prop _ _ H); clear H.
976		inversion_clear Hl.
977		inversion_clear Hl'.
978		destruct (IHl H (Mk H3)).
979		unfold equal, eq in H6; simpl in H6; auto.
980		Qed.
981
982		Lemma eq_spec m m' : eq m m' <-> Equivb cmp m m'.
983		Proof.
984		now rewrite eq_equal, equal_spec.
985		Qed.
986
987		Lemma eq_refl : forall m : t, eq m m.
988		Proof.
989		intros (m,Hm); induction m; unfold eq; simpl; auto.
990		destruct a.
991		destruct (X.compare_spec t0 t0) as [Hlt\|Heq\|Hlt]; auto.
992		- split. reflexivity. inversion_clear Hm. apply (IHm H).
993		- MapS.Raw.MX.order.
994		- MapS.Raw.MX.order.
995		Qed.
996
997		Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1.
998		Proof.
999		intros (m,Hm); induction m;
1000		intros (m', Hm'); destruct m'; unfold eq; simpl;
1001		try destruct a as (x,e); try destruct p as (x',e'); auto.
1002		destruct (X.compare_spec x x') as [Hlt\|Heq\|Hlt];
1003		elim X.compare_spec; try MapS.Raw.MX.order; intuition.
1004		inversion_clear Hm; inversion_clear Hm'.
1005		apply (IHm H0 (Mk H4)); auto.
1006		Qed.
1007
1008		Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3.
1009		Proof.
1010		intros (m1,Hm1); induction m1;
1011		intros (m2, Hm2); destruct m2;
1012		intros (m3, Hm3); destruct m3; unfold eq; simpl;
1013		try destruct a as (x,e);
1014		try destruct p as (x',e');
1015		try destruct p0 as (x'',e''); try contradiction; auto.
1016		destruct (X.compare_spec x x') as [Hlt\|Heq\|Hlt];
1017		destruct (X.compare_spec x' x'') as [Hlt'\|Heq'\|Hlt'];
1018		elim X.compare_spec; try MapS.Raw.MX.order; intuition.
1019		now transitivity e'.
1020		inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
1021		apply (IHm1 H1 (Mk H6) (Mk H8)); intuition.
1022		Qed.
1023
1024		Instance eq_equiv : Equivalence eq.
1025		Proof. split; [exact eq_refl\|exact eq_sym\|exact eq_trans]. Qed.
1026
1027		Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3.
1028		Proof.
1029		intros (m1,Hm1); induction m1;
1030		intros (m2, Hm2); destruct m2;
1031		intros (m3, Hm3); destruct m3; unfold lt; simpl;
1032		try destruct a as (x,e);
1033		try destruct p as (x',e');
1034		try destruct p0 as (x'',e''); try contradiction; auto.
1035		destruct (X.compare_spec x x') as [Hlt\|Heq\|Hlt];
1036		destruct (X.compare_spec x' x'') as [Hlt'\|Heq'\|Hlt'];
1037		elim X.compare_spec; try MapS.Raw.MX.order; intuition.
1038		left; transitivity e'; auto.
1039		left; MD.order.
1040		left; MD.order.
1041		right.
1042		split.
1043		transitivity e'; auto.
1044		inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
1045		apply (IHm1 H2 (Mk H6) (Mk H8)); intuition.
1046		Qed.
1047
1048		Lemma lt_irrefl : forall m, ~ lt m m.
1049		Proof.
1050		intros (m,Hm); induction m; unfold lt; simpl; auto.
1051		destruct a.
1052		destruct (X.compare_spec t0 t0) as [Hlt\|Heq\|Hlt]; auto.
1053		- intuition. MD.order. inversion_clear Hm. now apply (IHm H0).
1054		- MapS.Raw.MX.order.
1055		Qed.
1056
1057		Instance lt_strorder : StrictOrder lt.
1058		Proof. split; [exact lt_irrefl\|exact lt_trans]. Qed.
1059
1060		Lemma lt_compat1 : forall m1 m1' m2, eq m1 m1' -> lt m1 m2 -> lt m1' m2.
1061		Proof.
1062		intros (m1,Hm1); induction m1;
1063		intros (m1',Hm1'); destruct m1';
1064		intros (m2,Hm2); destruct m2; unfold eq, lt;
1065		try destruct a as (x,e);
1066		try destruct p as (x',e');
1067		try destruct p0 as (x'',e''); try contradiction; simpl; auto.
1068		destruct (X.compare_spec x x') as [Hlt\|Heq\|Hlt];
1069		destruct (X.compare_spec x' x'') as [Hlt'\|Heq'\|Hlt'];
1070		elim X.compare_spec; try MapS.Raw.MX.order; intuition.
1071		left; MD.order.
1072		right.
1073		split.
1074		MD.order.
1075		inversion_clear Hm1; inversion_clear Hm1'; inversion_clear Hm2.
1076		apply (IHm1 H0 (Mk H6) (Mk H8)); intuition.
1077		Qed.
1078
1079		Lemma lt_compat2 : forall m1 m2 m2', eq m2 m2' -> lt m1 m2 -> lt m1 m2'.
1080		Proof.
1081		intros (m1,Hm1); induction m1;
1082		intros (m2,Hm2); destruct m2;
1083		intros (m2',Hm2'); destruct m2'; unfold eq, lt;
1084		try destruct a as (x,e);
1085		try destruct p as (x',e');
1086		try destruct p0 as (x'',e''); try contradiction; simpl; auto.
1087		destruct (X.compare_spec x x') as [Hlt\|Heq\|Hlt];
1088		destruct (X.compare_spec x' x'') as [Hlt'\|Heq'\|Hlt'];
1089		elim X.compare_spec; try MapS.Raw.MX.order; intuition.
1090		left; MD.order.
1091		right.
1092		split.
1093		MD.order.
1094		inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm2'.
1095		apply (IHm1 H0 (Mk H6) (Mk H8)); intuition.
1096		Qed.
1097
1098		Instance lt_compat : Proper (eq==>eq==>iff) lt.
1099		Proof.
1100		intros m1 m1' H1 m2 m2' H2. split; intros.
1101		now apply (lt_compat2 H2), (lt_compat1 H1).
1102		symmetry in H1, H2.
1103		now apply (lt_compat2 H2), (lt_compat1 H1).
1104		Qed.
1105
1106		Ltac cmp_solve :=
1107		unfold eq, lt; simpl; elim X.compare_spec; try Raw.MX.order; auto.
1108
1109		Fixpoint compare_list m1 m2 := match m1, m2 with
1110		\| nil, nil => Eq
1111		\| nil, _ => Lt
1112		\| _, nil => Gt
1113		\| (k1,e1)::m1, (k2,e2)::m2 =>
1114		match X.compare k1 k2 with
1115		\| Lt => Lt
1116		\| Gt => Gt
1117		\| Eq => match D.compare e1 e2 with
1118		\| Lt => Lt
1119		\| Gt => Gt
1120		\| Eq => compare_list m1 m2
1121		end
1122		end
1123		end.
1124
1125		Definition compare m1 m2 := compare_list m1.(this) m2.(this).
1126
1127		Lemma compare_spec : forall m1 m2, CompSpec eq lt m1 m2 (compare m1 m2).
1128		Proof.
1129		unfold CompSpec.
1130		intros (m1,Hm1)(m2,Hm2). unfold compare, eq, lt; simpl.
1131		revert m2 Hm2.
1132		induction m1 as [\|(k1,e1) m1 IH1]; destruct m2 as [\|(k2,e2) m2];
1133		try constructor; simpl; intros; auto.
1134		elim X.compare_spec; simpl; try constructor; auto; intros.
1135		elim D.compare_spec; simpl; try constructor; auto; intros.
1136		inversion_clear Hm1; inversion_clear Hm2.
1137		destruct (IH1 H1 _ H3); simpl; try constructor; auto.
1138		elim X.compare_spec; try Raw.MX.order. right. now split.
1139		elim X.compare_spec; try Raw.MX.order. now left.
1140		elim X.compare_spec; try Raw.MX.order; auto.
1141		Qed.
1142
1143		End Make_ord.

+0

-698

~~theories/MMaps/MMapPositive.v~~ less more

0		(***********************************************************************)
1		(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
3		(* \VV/ *************************************************************)
4		(* // * This file is distributed under the terms of the *)
5		(* * GNU Lesser General Public License Version 2.1 *)
6		(***********************************************************************)
7
8		(** * MMapPositive : an implementation of MMapInterface for [positive] keys. *)
9
10		Require Import Bool PeanoNat BinPos Orders OrdersEx OrdersLists MMapInterface.
11
12		Set Implicit Arguments.
13		Local Open Scope lazy_bool_scope.
14		Local Open Scope positive_scope.
15		Local Unset Elimination Schemes.
16
17		(** This file is an adaptation to the [MMap] framework of a work by
18		Xavier Leroy and Sandrine Blazy (used for building certified compilers).
19		Keys are of type [positive], and maps are binary trees: the sequence
20		of binary digits of a positive number corresponds to a path in such a tree.
21		This is quite similar to the [IntMap] library, except that no path
22		compression is implemented, and that the current file is simple enough to be
23		self-contained. *)
24
25		(** Reverses the positive [y] and concatenate it with [x] *)
26
27		Fixpoint rev_append (y x : positive) : positive :=
28		match y with
29		\| 1 => x
30		\| y~1 => rev_append y x~1
31		\| y~0 => rev_append y x~0
32		end.
33		Local Infix "@" := rev_append (at level 60).
34		Definition rev x := x@1.
35
36		(** The module of maps over positive keys *)
37
38		Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
39
40		Module E:=PositiveOrderedTypeBits.
41		Module ME:=KeyOrderedType E.
42
43		Definition key := positive : Type.
44
45		Definition eq_key {A} (p p':key*A) := E.eq (fst p) (fst p').
46
47		Definition eq_key_elt {A} (p p':key*A) :=
48		E.eq (fst p) (fst p') /\ (snd p) = (snd p').
49
50		Definition lt_key {A} (p p':key*A) := E.lt (fst p) (fst p').
51
52		Instance eqk_equiv {A} : Equivalence (@eq_key A) := _.
53		Instance eqke_equiv {A} : Equivalence (@eq_key_elt A) := _.
54		Instance ltk_strorder {A} : StrictOrder (@lt_key A) := _.
55
56		Inductive tree (A : Type) :=
57		\| Leaf : tree A
58		\| Node : tree A -> option A -> tree A -> tree A.
59
60		Arguments Leaf {A}.
61
62		Scheme tree_ind := Induction for tree Sort Prop.
63
64		Definition t := tree.
65
66		Definition empty {A} : t A := Leaf.
67
68		Section A.
69		Variable A:Type.
70
71		Fixpoint is_empty (m : t A) : bool :=
72		match m with
73		\| Leaf => true
74		\| Node l None r => (is_empty l) &&& (is_empty r)
75		\| _ => false
76		end.
77
78		Fixpoint find (i : key) (m : t A) : option A :=
79		match m with
80		\| Leaf => None
81		\| Node l o r =>
82		match i with
83		\| xH => o
84		\| xO ii => find ii l
85		\| xI ii => find ii r
86		end
87		end.
88
89		Fixpoint mem (i : key) (m : t A) : bool :=
90		match m with
91		\| Leaf => false
92		\| Node l o r =>
93		match i with
94		\| xH => match o with None => false \| _ => true end
95		\| xO ii => mem ii l
96		\| xI ii => mem ii r
97		end
98		end.
99
100		Fixpoint add (i : key) (v : A) (m : t A) : t A :=
101		match m with
102		\| Leaf =>
103		match i with
104		\| xH => Node Leaf (Some v) Leaf
105		\| xO ii => Node (add ii v Leaf) None Leaf
106		\| xI ii => Node Leaf None (add ii v Leaf)
107		end
108		\| Node l o r =>
109		match i with
110		\| xH => Node l (Some v) r
111		\| xO ii => Node (add ii v l) o r
112		\| xI ii => Node l o (add ii v r)
113		end
114		end.
115
116		(** helper function to avoid creating empty trees that are not leaves *)
117
118		Definition node (l : t A) (o: option A) (r : t A) : t A :=
119		match o,l,r with
120		\| None,Leaf,Leaf => Leaf
121		\| _,_,_ => Node l o r
122		end.
123
124		Fixpoint remove (i : key) (m : t A) : t A :=
125		match m with
126		\| Leaf => Leaf
127		\| Node l o r =>
128		match i with
129		\| xH => node l None r
130		\| xO ii => node (remove ii l) o r
131		\| xI ii => node l o (remove ii r)
132		end
133		end.
134
135		(** [bindings] *)
136
137		Fixpoint xbindings (m : t A) (i : positive) (a: list (key*A)) :=
138		match m with
139		\| Leaf => a
140		\| Node l None r => xbindings l i~0 (xbindings r i~1 a)
141		\| Node l (Some e) r => xbindings l i~0 ((rev i,e) :: xbindings r i~1 a)
142		end.
143
144		Definition bindings (m : t A) := xbindings m 1 nil.
145
146		(** [cardinal] *)
147
148		Fixpoint cardinal (m : t A) : nat :=
149		match m with
150		\| Leaf => 0%nat
151		\| Node l None r => (cardinal l + cardinal r)%nat
152		\| Node l (Some _) r => S (cardinal l + cardinal r)
153		end.
154
155		(** Specification proofs *)
156
157		Definition MapsTo (i:key)(v:A)(m:t A) := find i m = Some v.
158		Definition In (i:key)(m:t A) := exists e:A, MapsTo i e m.
159
160		Lemma MapsTo_compat : Proper (E.eq==>eq==>eq==>iff) MapsTo.
161		Proof.
162		intros k k' Hk e e' He m m' Hm. red in Hk. now subst.
163		Qed.
164
165		Lemma find_spec m x e : find x m = Some e <-> MapsTo x e m.
166		Proof. reflexivity. Qed.
167
168		Lemma mem_find :
169		forall m x, mem x m = match find x m with None => false \| _ => true end.
170		Proof.
171		induction m; destruct x; simpl; auto.
172		Qed.
173
174		Lemma mem_spec : forall m x, mem x m = true <-> In x m.
175		Proof.
176		unfold In, MapsTo; intros m x; rewrite mem_find.
177		split.
178		- destruct (find x m).
179		exists a; auto.
180		intros; discriminate.
181		- destruct 1 as (e0,H0); rewrite H0; auto.
182		Qed.
183
184		Lemma gleaf : forall (i : key), find i Leaf = None.
185		Proof. destruct i; simpl; auto. Qed.
186
187		Theorem empty_spec:
188		forall (i: key), find i empty = None.
189		Proof. exact gleaf. Qed.
190
191		Lemma is_empty_spec m :
192		is_empty m = true <-> forall k, find k m = None.
193		Proof.
194		induction m; simpl.
195		- intuition. apply empty_spec.
196		- destruct o. split; try discriminate.
197		intros H. now specialize (H xH).
198		rewrite <- andb_lazy_alt, andb_true_iff, IHm1, IHm2.
199		clear IHm1 IHm2.
200		split.
201		+ intros (H1,H2) k. destruct k; simpl; auto.
202		+ intros H; split; intros k. apply (H (xO k)). apply (H (xI k)).
203		Qed.
204
205		Theorem add_spec1:
206		forall (m: t A) (i: key) (x: A), find i (add i x m) = Some x.
207		Proof.
208		intros m i; revert m.
209		induction i; destruct m; simpl; auto.
210		Qed.
211
212		Theorem add_spec2:
213		forall (m: t A) (i j: key) (x: A),
214		i <> j -> find j (add i x m) = find j m.
215		Proof.
216		intros m i j; revert m i.
217		induction j; destruct i, m; simpl; intros;
218		rewrite ?IHj, ?gleaf; auto; try congruence.
219		Qed.
220
221		Lemma rleaf : forall (i : key), remove i Leaf = Leaf.
222		Proof. destruct i; simpl; auto. Qed.
223
224		Lemma gnode l o r i : find i (node l o r) = find i (Node l o r).
225		Proof.
226		destruct o,l,r; simpl; trivial.
227		destruct i; simpl; now rewrite ?gleaf.
228		Qed.
229
230		Opaque node.
231
232		Theorem remove_spec1:
233		forall (m: t A)(i: key), find i (remove i m) = None.
234		Proof.
235		induction m; simpl.
236		- intros; rewrite rleaf. apply gleaf.
237		- destruct i; simpl remove; rewrite gnode; simpl; auto.
238		Qed.
239
240		Theorem remove_spec2:
241		forall (m: t A)(i j: key),
242		i <> j -> find j (remove i m) = find j m.
243		Proof.
244		induction m; simpl; intros.
245		- now rewrite rleaf.
246		- destruct i; simpl; rewrite gnode; destruct j; simpl; trivial;
247		try apply IHm1; try apply IHm2; congruence.
248		Qed.
249
250		Local Notation InL := (InA eq_key_elt).
251
252		Lemma xbindings_spec: forall m j acc k e,
253		InL (k,e) (xbindings m j acc) <->
254		InL (k,e) acc \/ exists x, k=(j@x) /\ find x m = Some e.
255		Proof.
256		induction m as [\|l IHl o r IHr]; simpl.
257		- intros. split; intro H.
258		+ now left.
259		+ destruct H as [H\|[x [_ H]]]. assumption.
260		now rewrite gleaf in H.
261		- intros j acc k e. case o as [e'\|];
262		rewrite IHl, ?InA_cons, IHr; clear IHl IHr; split.
263		+ intros [[H\|[H\|H]]\|H]; auto.
264		* unfold eq_key_elt, E.eq, fst, snd in H. destruct H as (->,<-).
265		right. now exists 1.
266		* destruct H as (x,(->,H)). right. now exists x~1.
267		* destruct H as (x,(->,H)). right. now exists x~0.
268		+ intros [H\|H]; auto.
269		destruct H as (x,(->,H)).
270		destruct x; simpl in *.
271		* left. right. right. now exists x.
272		* right. now exists x.
273		* left. left. injection H as ->. reflexivity.
274		+ intros [[H\|H]\|H]; auto.
275		* destruct H as (x,(->,H)). right. now exists x~1.
276		* destruct H as (x,(->,H)). right. now exists x~0.
277		+ intros [H\|H]; auto.
278		destruct H as (x,(->,H)).
279		destruct x; simpl in *.
280		* left. right. now exists x.
281		* right. now exists x.
282		* discriminate.
283		Qed.
284
285		Lemma lt_rev_append: forall j x y, E.lt x y -> E.lt (j@x) (j@y).
286		Proof. induction j; intros; simpl; auto. Qed.
287
288		Lemma xbindings_sort m j acc :
289		sort lt_key acc ->
290		(forall x p, In x m -> InL p acc -> E.lt (j@x) (fst p)) ->
291		sort lt_key (xbindings m j acc).
292		Proof.
293		revert j acc.
294		induction m as [\|l IHl o r IHr]; simpl; trivial.
295		intros j acc Hacc Hsacc. destruct o as [e\|].
296		- apply IHl;[constructor;[apply IHr; [apply Hacc\|]\|]\|].
297		+ intros. now apply Hsacc.
298		+ case_eq (xbindings r j~1 acc); [constructor\|].
299		intros (z,e') q H. constructor.
300		assert (H': InL (z,e') (xbindings r j~1 acc)).
301		{ rewrite H. now constructor. }
302		clear H q. rewrite xbindings_spec in H'.
303		destruct H' as [H'\|H'].
304		* apply (Hsacc 1 (z,e')); trivial. now exists e.
305		* destruct H' as (x,(->,H)).
306		red. simpl. now apply lt_rev_append.
307		+ intros x (y,e') Hx Hy. inversion_clear Hy.
308		rewrite H. simpl. now apply lt_rev_append.
309		rewrite xbindings_spec in H.
310		destruct H as [H\|H].
311		* now apply Hsacc.
312		* destruct H as (z,(->,H)). simpl.
313		now apply lt_rev_append.
314		- apply IHl; [apply IHr; [apply Hacc\|]\|].
315		+ intros. now apply Hsacc.
316		+ intros x (y,e') Hx H. rewrite xbindings_spec in H.
317		destruct H as [H\|H].
318		* now apply Hsacc.
319		* destruct H as (z,(->,H)). simpl.
320		now apply lt_rev_append.
321		Qed.
322
323		Lemma bindings_spec1 m k e :
324		InA eq_key_elt (k,e) (bindings m) <-> MapsTo k e m.
325		Proof.
326		unfold bindings, MapsTo. rewrite xbindings_spec.
327		split; [ intros [H\|(y & H & H')] \| intros IN ].
328		- inversion H.
329		- simpl in *. now subst.
330		- right. now exists k.
331		Qed.
332
333		Lemma bindings_spec2 m : sort lt_key (bindings m).
334		Proof.
335		unfold bindings.
336		apply xbindings_sort. constructor. inversion 2.
337		Qed.
338
339		Lemma bindings_spec2w m : NoDupA eq_key (bindings m).
340		Proof.
341		apply ME.Sort_NoDupA.
342		apply bindings_spec2.
343		Qed.
344
345		Lemma xbindings_length m j acc :
346		length (xbindings m j acc) = (cardinal m + length acc)%nat.
347		Proof.
348		revert j acc.
349		induction m; simpl; trivial; intros.
350		destruct o; simpl; rewrite IHm1; simpl; rewrite IHm2;
351		now rewrite ?Nat.add_succ_r, Nat.add_assoc.
352		Qed.
353
354		Lemma cardinal_spec m : cardinal m = length (bindings m).
355		Proof.
356		unfold bindings. rewrite xbindings_length. simpl.
357		symmetry. apply Nat.add_0_r.
358		Qed.
359
360		(** [map] and [mapi] *)
361
362		Variable B : Type.
363
364		Section Mapi.
365
366		Variable f : key -> option A -> option B.
367
368		Fixpoint xmapi (m : t A) (i : key) : t B :=
369		match m with
370		\| Leaf => Leaf
371		\| Node l o r => Node (xmapi l (i~0))
372		(f (rev i) o)
373		(xmapi r (i~1))
374		end.
375
376		End Mapi.
377
378		Definition mapi (f : key -> A -> B) m :=
379		xmapi (fun k => option_map (f k)) m 1.
380
381		Definition map (f : A -> B) m := mapi (fun _ => f) m.
382
383		End A.
384
385		Lemma xgmapi:
386		forall (A B: Type) (f: key -> option A -> option B) (i j : key) (m: t A),
387		(forall k, f k None = None) ->
388		find i (xmapi f m j) = f (j@i) (find i m).
389		Proof.
390		induction i; intros; destruct m; simpl; rewrite ?IHi; auto.
391		Qed.
392
393		Theorem mapi_spec0 :
394		forall (A B: Type) (f: key -> A -> B) (i: key) (m: t A),
395		find i (mapi f m) = option_map (f i) (find i m).
396		Proof.
397		intros. unfold mapi. rewrite xgmapi; simpl; auto.
398		Qed.
399
400		Lemma mapi_spec :
401		forall (A B: Type) (f: key -> A -> B) (m: t A) (i:key),
402		exists j, E.eq j i /\
403		find i (mapi f m) = option_map (f j) (find i m).
404		Proof.
405		intros.
406		exists i. split. reflexivity. apply mapi_spec0.
407		Qed.
408
409		Lemma map_spec :
410		forall (elt elt':Type)(f:elt->elt')(m: t elt)(x:key),
411		find x (map f m) = option_map f (find x m).
412		Proof.
413		intros; unfold map. apply mapi_spec0.
414		Qed.
415
416		Section merge.
417		Variable A B C : Type.
418		Variable f : key -> option A -> option B -> option C.
419
420		Fixpoint xmerge (m1 : t A)(m2 : t B)(i:positive) : t C :=
421		match m1 with
422		\| Leaf => xmapi (fun k => f k None) m2 i
423		\| Node l1 o1 r1 =>
424		match m2 with
425		\| Leaf => xmapi (fun k o => f k o None) m1 i
426		\| Node l2 o2 r2 =>
427		Node (xmerge l1 l2 (i~0))
428		(f (rev i) o1 o2)
429		(xmerge r1 r2 (i~1))
430		end
431		end.
432
433		Lemma xgmerge: forall (i j: key)(m1:t A)(m2: t B),
434		(forall i, f i None None = None) ->
435		find i (xmerge m1 m2 j) = f (j@i) (find i m1) (find i m2).
436		Proof.
437		induction i; intros; destruct m1; destruct m2; simpl; auto;
438		rewrite ?xgmapi, ?IHi; simpl; auto.
439		Qed.
440
441		End merge.
442
443		Definition merge {A B C}(f:key->option A->option B->option C) m1 m2 :=
444		xmerge
445		(fun k o1 o2 => match o1,o2 with
446		\| None,None => None
447		\| _, _ => f k o1 o2
448		end)
449		m1 m2 xH.
450
451		Lemma merge_spec1 {A B C}(f:key->option A->option B->option C) :
452		forall m m' x,
453		In x m \/ In x m' ->
454		exists y, E.eq y x /\
455		find x (merge f m m') = f y (find x m) (find x m').
456		Proof.
457		intros. exists x. split. reflexivity.
458		unfold merge.
459		rewrite xgmerge; simpl; auto.
460		rewrite <- 2 mem_spec, 2 mem_find in H.
461		destruct (find x m); simpl; auto.
462		destruct (find x m'); simpl; auto. intuition discriminate.
463		Qed.
464
465		Lemma merge_spec2 {A B C}(f:key->option A->option B->option C) :
466		forall m m' x, In x (merge f m m') -> In x m \/ In x m'.
467		Proof.
468		intros.
469		rewrite <-mem_spec, mem_find in H.
470		unfold merge in H.
471		rewrite xgmerge in H; simpl; auto.
472		rewrite <- 2 mem_spec, 2 mem_find.
473		destruct (find x m); simpl in *; auto.
474		destruct (find x m'); simpl in *; auto.
475		Qed.
476
477		Section Fold.
478
479		Variables A B : Type.
480		Variable f : key -> A -> B -> B.
481
482		(** the additional argument, [i], records the current path, in
483		reverse order (this should be more efficient: we reverse this argument
484		only at present nodes only, rather than at each node of the tree).
485		we also use this convention in all functions below
486		*)
487
488		Fixpoint xfold (m : t A) (v : B) (i : key) :=
489		match m with
490		\| Leaf => v
491		\| Node l (Some x) r =>
492		xfold r (f (rev i) x (xfold l v i~0)) i~1
493		\| Node l None r =>
494		xfold r (xfold l v i~0) i~1
495		end.
496		Definition fold m i := xfold m i 1.
497
498		End Fold.
499
500		Lemma fold_spec :
501		forall {A}(m:t A){B}(i : B) (f : key -> A -> B -> B),
502		fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.
503		Proof.
504		unfold fold, bindings. intros A m B i f. revert m i.
505		set (f' := fun a p => f (fst p) (snd p) a).
506		assert (H: forall m i j acc,
507		fold_left f' acc (xfold f m i j) =
508		fold_left f' (xbindings m j acc) i).
509		{ induction m as [\|l IHl o r IHr]; intros; trivial.
510		destruct o; simpl; now rewrite IHr, <- IHl. }
511		intros. exact (H m i 1 nil).
512		Qed.
513
514		Fixpoint equal (A:Type)(cmp : A -> A -> bool)(m1 m2 : t A) : bool :=
515		match m1, m2 with
516		\| Leaf, _ => is_empty m2
517		\| _, Leaf => is_empty m1
518		\| Node l1 o1 r1, Node l2 o2 r2 =>
519		(match o1, o2 with
520		\| None, None => true
521		\| Some v1, Some v2 => cmp v1 v2
522		\| _, _ => false
523		end)
524		&&& equal cmp l1 l2 &&& equal cmp r1 r2
525		end.
526
527		Definition Equal (A:Type)(m m':t A) :=
528		forall y, find y m = find y m'.
529		Definition Equiv (A:Type)(eq_elt:A->A->Prop) m m' :=
530		(forall k, In k m <-> In k m') /\
531		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e').
532		Definition Equivb (A:Type)(cmp: A->A->bool) := Equiv (Cmp cmp).
533
534		Lemma equal_1 : forall (A:Type)(m m':t A)(cmp:A->A->bool),
535		Equivb cmp m m' -> equal cmp m m' = true.
536		Proof.
537		induction m.
538		- (* m = Leaf *)
539		destruct 1 as (E,_); simpl.
540		apply is_empty_spec; intros k.
541		destruct (find k m') eqn:F; trivial.
542		assert (H : In k m') by now exists a.
543		rewrite <- E in H.
544		destruct H as (x,H). red in H. now rewrite gleaf in H.
545		- (* m = Node *)
546		destruct m'.
547		+ (* m' = Leaf *)
548		destruct 1 as (E,_); simpl.
549		destruct o.
550		* assert (H : In xH (@Leaf A)).
551		{ rewrite <- E. now exists a. }
552		destruct H as (e,H). now red in H.
553		* apply andb_true_intro; split; apply is_empty_spec; intros k.
554		destruct (find k m1) eqn:F; trivial.
555		assert (H : In (xO k) (@Leaf A)).
556		{ rewrite <- E. exists a; auto. }
557		destruct H as (x,H). red in H. now rewrite gleaf in H.
558		destruct (find k m2) eqn:F; trivial.
559		assert (H : In (xI k) (@Leaf A)).
560		{ rewrite <- E. exists a; auto. }
561		destruct H as (x,H). red in H. now rewrite gleaf in H.
562		+ (* m' = Node *)
563		destruct 1.
564		assert (Equivb cmp m1 m'1).
565		{ split.
566		intros k; generalize (H (xO k)); unfold In, MapsTo; simpl; auto.
567		intros k e e'; generalize (H0 (xO k) e e'); unfold In, MapsTo; simpl; auto. }
568		assert (Equivb cmp m2 m'2).
569		{ split.
570		intros k; generalize (H (xI k)); unfold In, MapsTo; simpl; auto.
571		intros k e e'; generalize (H0 (xI k) e e'); unfold In, MapsTo; simpl; auto. }
572		simpl.
573		destruct o; destruct o0; simpl.
574		repeat (apply andb_true_intro; split); auto.
575		apply (H0 xH); red; auto.
576		generalize (H xH); unfold In, MapsTo; simpl; intuition.
577		destruct H4; try discriminate; eauto.
578		generalize (H xH); unfold In, MapsTo; simpl; intuition.
579		destruct H5; try discriminate; eauto.
580		apply andb_true_intro; split; auto.
581		Qed.
582
583		Lemma equal_2 : forall (A:Type)(m m':t A)(cmp:A->A->bool),
584		equal cmp m m' = true -> Equivb cmp m m'.
585		Proof.
586		induction m.
587		(* m = Leaf *)
588		simpl.
589		split; intros.
590		split.
591		destruct 1; red in H0; destruct k; discriminate.
592		rewrite is_empty_spec in H.
593		intros (e,H'). red in H'. now rewrite H in H'.
594		red in H0; destruct k; discriminate.
595		(* m = Node *)
596		destruct m'.
597		(* m' = Leaf *)
598		simpl.
599		destruct o; intros; try discriminate.
600		destruct (andb_prop _ _ H); clear H.
601		split; intros.
602		split; unfold In, MapsTo; destruct 1.
603		destruct k; simpl in *; try discriminate.
604		rewrite is_empty_spec in H1.
605		now rewrite H1 in H.
606		rewrite is_empty_spec in H0.
607		now rewrite H0 in H.
608		destruct k; simpl in *; discriminate.
609		unfold In, MapsTo; destruct k; simpl in *; discriminate.
610		(* m' = Node *)
611		destruct o; destruct o0; simpl; intros; try discriminate.
612		destruct (andb_prop _ _ H); clear H.
613		destruct (andb_prop _ _ H0); clear H0.
614		destruct (IHm1 _ _ H2); clear H2 IHm1.
615		destruct (IHm2 _ _ H1); clear H1 IHm2.
616		split; intros.
617		destruct k; unfold In, MapsTo in *; simpl; auto.
618		split; eauto.
619		destruct k; unfold In, MapsTo in ; simpl in .
620		eapply H4; eauto.
621		eapply H3; eauto.
622		congruence.
623		destruct (andb_prop _ _ H); clear H.
624		destruct (IHm1 _ _ H0); clear H0 IHm1.
625		destruct (IHm2 _ _ H1); clear H1 IHm2.
626		split; intros.
627		destruct k; unfold In, MapsTo in *; simpl; auto.
628		split; eauto.
629		destruct k; unfold In, MapsTo in ; simpl in .
630		eapply H3; eauto.
631		eapply H2; eauto.
632		try discriminate.
633		Qed.
634
635		Lemma equal_spec : forall (A:Type)(m m':t A)(cmp:A->A->bool),
636		equal cmp m m' = true <-> Equivb cmp m m'.
637		Proof.
638		split. apply equal_2. apply equal_1.
639		Qed.
640
641		End PositiveMap.
642
643		(** Here come some additionnal facts about this implementation.
644		Most are facts that cannot be derivable from the general interface. *)
645
646		Module PositiveMapAdditionalFacts.
647		Import PositiveMap.
648
649		(* Derivable from the Map interface *)
650		Theorem gsspec {A} i j x (m: t A) :
651		find i (add j x m) = if E.eq_dec i j then Some x else find i m.
652		Proof.
653		destruct (E.eq_dec i j) as [->\|];
654		[ apply add_spec1 \| apply add_spec2; auto ].
655		Qed.
656
657		(* Not derivable from the Map interface *)
658		Theorem gsident {A} i (m:t A) v :
659		find i m = Some v -> add i v m = m.
660		Proof.
661		revert m.
662		induction i; destruct m; simpl in *; try congruence.
663		- intro H; now rewrite (IHi m2 H).
664		- intro H; now rewrite (IHi m1 H).
665		Qed.
666
667		Lemma xmapi_ext {A B}(f g: key -> option A -> option B) :
668		(forall k (o : option A), f k o = g k o) ->
669		forall m i, xmapi f m i = xmapi g m i.
670		Proof.
671		induction m; intros; simpl; auto. now f_equal.
672		Qed.
673
674		Theorem xmerge_commut{A B C}
675		(f: key -> option A -> option B -> option C)
676		(g: key -> option B -> option A -> option C) :
677		(forall k o1 o2, f k o1 o2 = g k o2 o1) ->
678		forall m1 m2 i, xmerge f m1 m2 i = xmerge g m2 m1 i.
679		Proof.
680		intros E.
681		induction m1; destruct m2; intros i; simpl; trivial; f_equal;
682		try apply IHm1_1; try apply IHm1_2; try apply xmapi_ext;
683		intros; apply E.
684		Qed.
685
686		Theorem merge_commut{A B C}
687		(f: key -> option A -> option B -> option C)
688		(g: key -> option B -> option A -> option C) :
689		(forall k o1 o2, f k o1 o2 = g k o2 o1) ->
690		forall m1 m2, merge f m1 m2 = merge g m2 m1.
691		Proof.
692		intros E m1 m2.
693		unfold merge. apply xmerge_commut.
694		intros k [x1\|] [x2\|]; trivial.
695		Qed.
696
697		End PositiveMapAdditionalFacts.

+0

-687

~~theories/MMaps/MMapWeakList.v~~ less more

0		(***********************************************************************)
1		(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
3		(* \VV/ *************************************************************)
4		(* // * This file is distributed under the terms of the *)
5		(* * GNU Lesser General Public License Version 2.1 *)
6		(***********************************************************************)
7
8		(** * Finite map library *)
9
10		(** This file proposes an implementation of the non-dependant interface
11		[MMapInterface.WS] using lists of pairs, unordered but without redundancy. *)
12
13		Require Import MMapInterface EqualitiesFacts.
14
15		Set Implicit Arguments.
16		Unset Strict Implicit.
17
18		Lemma Some_iff {A} (a a' : A) : Some a = Some a' <-> a = a'.
19		Proof. split; congruence. Qed.
20
21		Module Raw (X:DecidableType).
22
23		Module Import PX := KeyDecidableType X.
24
25		Definition key := X.t.
26		Definition t (elt:Type) := list (X.t * elt).
27
28		Ltac dec := match goal with
29		\| \|- context [ X.eq_dec ?x ?x ] =>
30		let E := fresh "E" in destruct (X.eq_dec x x) as [E\|E]; [ \| now elim E]
31		\| H : X.eq ?x ?y \|- context [ X.eq_dec ?x ?y ] =>
32		let E := fresh "E" in destruct (X.eq_dec x y) as [_\|E]; [ \| now elim E]
33		\| H : ~X.eq ?x ?y \|- context [ X.eq_dec ?x ?y ] =>
34		let E := fresh "E" in destruct (X.eq_dec x y) as [E\|_]; [ now elim H \| ]
35		\| \|- context [ X.eq_dec ?x ?y ] =>
36		let E := fresh "E" in destruct (X.eq_dec x y) as [E\|E]
37		end.
38
39		Section Elt.
40
41		Variable elt : Type.
42		Notation NoDupA := (@NoDupA _ eqk).
43
44		(** * [find] *)
45
46		Fixpoint find (k:key) (s: t elt) : option elt :=
47		match s with
48		\| nil => None
49		\| (k',x)::s' => if X.eq_dec k k' then Some x else find k s'
50		end.
51
52		Lemma find_spec : forall m (Hm:NoDupA m) x e,
53		find x m = Some e <-> MapsTo x e m.
54		Proof.
55		unfold PX.MapsTo.
56		induction m as [ \| (k,e) m IH]; simpl.
57		- split; inversion 1.
58		- intros Hm k' e'. rewrite InA_cons.
59		change (eqke (k',e') (k,e)) with (X.eq k' k /\ e' = e).
60		inversion_clear Hm. dec.
61		+ rewrite Some_iff; intuition.
62		elim H. apply InA_eqk with (k',e'); auto.
63		+ rewrite IH; intuition.
64		Qed.
65
66		(** * [mem] *)
67
68		Fixpoint mem (k : key) (s : t elt) : bool :=
69		match s with
70		\| nil => false
71		\| (k',_) :: l => if X.eq_dec k k' then true else mem k l
72		end.
73
74		Lemma mem_spec : forall m (Hm:NoDupA m) x, mem x m = true <-> In x m.
75		Proof.
76		induction m as [ \| (k,e) m IH]; simpl; intros Hm x.
77		- split. discriminate. inversion_clear 1. inversion H0.
78		- inversion_clear Hm. rewrite PX.In_cons; simpl.
79		rewrite <- IH by trivial.
80		dec; intuition.
81		Qed.
82
83		(** * [empty] *)
84
85		Definition empty : t elt := nil.
86
87		Lemma empty_spec x : find x empty = None.
88		Proof.
89		reflexivity.
90		Qed.
91
92		Lemma empty_NoDup : NoDupA empty.
93		Proof.
94		unfold empty; auto.
95		Qed.
96
97		(** * [is_empty] *)
98
99		Definition is_empty (l : t elt) : bool := if l then true else false.
100
101		Lemma is_empty_spec m : is_empty m = true <-> forall x, find x m = None.
102		Proof.
103		destruct m; simpl; intuition; try discriminate.
104		specialize (H a).
105		revert H. now dec.
106		Qed.
107
108		(* Not part of the exported specifications, used later for [merge]. *)
109
110		Lemma find_eq : forall m (Hm:NoDupA m) x x',
111		X.eq x x' -> find x m = find x' m.
112		Proof.
113		induction m; simpl; auto; destruct a; intros.
114		inversion_clear Hm.
115		rewrite (IHm H1 x x'); auto.
116		dec; dec; trivial.
117		elim E0. now transitivity x.
118		elim E. now transitivity x'.
119		Qed.
120
121		(** * [add] *)
122
123		Fixpoint add (k : key) (x : elt) (s : t elt) : t elt :=
124		match s with
125		\| nil => (k,x) :: nil
126		\| (k',y) :: l => if X.eq_dec k k' then (k,x)::l else (k',y)::add k x l
127		end.
128
129		Lemma add_spec1 m x e : find x (add x e m) = Some e.
130		Proof.
131		induction m as [ \| (k,e') m IH]; simpl.
132		- now dec.
133		- dec; simpl; now dec.
134		Qed.
135
136		Lemma add_spec2 m x y e : ~X.eq x y -> find y (add x e m) = find y m.
137		Proof.
138		intros N.
139		assert (N' : ~X.eq y x) by now contradict N.
140		induction m as [ \| (k,e') m IH]; simpl.
141		- dec; trivial.
142		- repeat (dec; simpl); trivial. elim N. now transitivity k.
143		Qed.
144
145		Lemma add_InA : forall m x y e e',
146		~ X.eq x y -> InA eqk (y,e) (add x e' m) -> InA eqk (y,e) m.
147		Proof.
148		induction m as [ \| (k,e') m IH]; simpl; intros.
149		- inversion_clear H0. elim H. symmetry; apply H1. inversion_clear H1.
150		- revert H0; dec; rewrite !InA_cons.
151		+ rewrite E. intuition.
152		+ intuition. right; eapply IH; eauto.
153		Qed.
154
155		Lemma add_NoDup : forall m (Hm:NoDupA m) x e, NoDupA (add x e m).
156		Proof.
157		induction m as [ \| (k,e') m IH]; simpl; intros Hm x e.
158		- constructor; auto. now inversion 1.
159		- inversion_clear Hm. dec; constructor; auto.
160		+ contradict H. apply InA_eqk with (x,e); auto.
161		+ contradict H; apply add_InA with x e; auto.
162		Qed.
163
164		(** * [remove] *)
165
166		Fixpoint remove (k : key) (s : t elt) : t elt :=
167		match s with
168		\| nil => nil
169		\| (k',x) :: l => if X.eq_dec k k' then l else (k',x) :: remove k l
170		end.
171
172		Lemma remove_spec1 m (Hm: NoDupA m) x : find x (remove x m) = None.
173		Proof.
174		induction m as [ \| (k,e') m IH]; simpl; trivial.
175		inversion_clear Hm.
176		repeat (dec; simpl); auto.
177		destruct (find x m) eqn:F; trivial.
178		apply find_spec in F; trivial.
179		elim H. apply InA_eqk with (x,e); auto.
180		Qed.
181
182		Lemma remove_spec2 m (Hm: NoDupA m) x y : ~X.eq x y ->
183		find y (remove x m) = find y m.
184		Proof.
185		induction m as [ \| (k,e') m IH]; simpl; trivial; intros E.
186		inversion_clear Hm.
187		repeat (dec; simpl); auto.
188		elim E. now transitivity k.
189		Qed.
190
191		Lemma remove_InA : forall m (Hm:NoDupA m) x y e,
192		InA eqk (y,e) (remove x m) -> InA eqk (y,e) m.
193		Proof.
194		induction m as [ \| (k,e') m IH]; simpl; trivial; intros.
195		inversion_clear Hm.
196		revert H; dec; rewrite !InA_cons; intuition.
197		right; eapply H; eauto.
198		Qed.
199
200		Lemma remove_NoDup : forall m (Hm:NoDupA m) x, NoDupA (remove x m).
201		Proof.
202		induction m.
203		simpl; intuition.
204		intros.
205		inversion_clear Hm.
206		destruct a as (x',e').
207		simpl; case (X.eq_dec x x'); auto.
208		constructor; auto.
209		contradict H; apply remove_InA with x; auto.
210		Qed.
211
212		(** * [bindings] *)
213
214		Definition bindings (m: t elt) := m.
215
216		Lemma bindings_spec1 m x e : InA eqke (x,e) (bindings m) <-> MapsTo x e m.
217		Proof.
218		reflexivity.
219		Qed.
220
221		Lemma bindings_spec2w m (Hm:NoDupA m) : NoDupA (bindings m).
222		Proof.
223		trivial.
224		Qed.
225
226		(** * [fold] *)
227
228		Fixpoint fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc : A) : A :=
229		match m with
230		\| nil => acc
231		\| (k,e)::m' => fold f m' (f k e acc)
232		end.
233
234		Lemma fold_spec : forall m (A:Type)(i:A)(f:key->elt->A->A),
235		fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.
236		Proof.
237		induction m as [ \| (k,e) m IH]; simpl; auto.
238		Qed.
239
240		(** * [equal] *)
241
242		Definition check (cmp : elt -> elt -> bool)(k:key)(e:elt)(m': t elt) :=
243		match find k m' with
244		\| None => false
245		\| Some e' => cmp e e'
246		end.
247
248		Definition submap (cmp : elt -> elt -> bool)(m m' : t elt) : bool :=
249		fold (fun k e b => andb (check cmp k e m') b) m true.
250
251		Definition equal (cmp : elt -> elt -> bool)(m m' : t elt) : bool :=
252		andb (submap cmp m m') (submap (fun e' e => cmp e e') m' m).
253
254		Definition Submap (cmp:elt->elt->bool) m m' :=
255		(forall k, In k m -> In k m') /\
256		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).
257
258		Definition Equivb (cmp:elt->elt->bool) m m' :=
259		(forall k, In k m <-> In k m') /\
260		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).
261
262		Lemma submap_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp,
263		Submap cmp m m' -> submap cmp m m' = true.
264		Proof.
265		unfold Submap, submap.
266		induction m.
267		simpl; auto.
268		destruct a; simpl; intros.
269		destruct H.
270		inversion_clear Hm.
271		assert (H3 : In t0 m').
272		{ apply H; exists e; auto with *. }
273		destruct H3 as (e', H3).
274		assert (H4 : find t0 m' = Some e') by now apply find_spec.
275		unfold check at 2. rewrite H4.
276		rewrite (H0 t0); simpl; auto with *.
277		eapply IHm; auto.
278		split; intuition.
279		apply H.
280		destruct H6 as (e'',H6); exists e''; auto.
281		apply H0 with k; auto.
282		Qed.
283
284		Lemma submap_2 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp,
285		submap cmp m m' = true -> Submap cmp m m'.
286		Proof.
287		unfold Submap, submap.
288		induction m.
289		simpl; auto.
290		intuition.
291		destruct H0; inversion H0.
292		inversion H0.
293
294		destruct a; simpl; intros.
295		inversion_clear Hm.
296		rewrite andb_b_true in H.
297		assert (check cmp t0 e m' = true).
298		clear H1 H0 Hm' IHm.
299		set (b:=check cmp t0 e m') in *.
300		generalize H; clear H; generalize b; clear b.
301		induction m; simpl; auto; intros.
302		destruct a; simpl in *.
303		destruct (andb_prop _ _ (IHm _ H)); auto.
304		rewrite H2 in H.
305		destruct (IHm H1 m' Hm' cmp H); auto.
306		unfold check in H2.
307		case_eq (find t0 m'); [intros e' H5 \| intros H5];
308		rewrite H5 in H2; try discriminate.
309		split; intros.
310		destruct H6 as (e0,H6); inversion_clear H6.
311		compute in H7; destruct H7; subst.
312		exists e'.
313		apply PX.MapsTo_eq with t0; auto with *.
314		apply find_spec; auto.
315		apply H3.
316		exists e0; auto.
317		inversion_clear H6.
318		compute in H8; destruct H8; subst.
319		assert (H8 : MapsTo t0 e'0 m'). { eapply PX.MapsTo_eq; eauto. }
320		apply find_spec in H8; trivial. congruence.
321		apply H4 with k; auto.
322		Qed.
323
324		(** Specification of [equal] *)
325
326		Lemma equal_spec : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp,
327		equal cmp m m' = true <-> Equivb cmp m m'.
328		Proof.
329		unfold Equivb, equal.
330		split.
331		- intros.
332		destruct (andb_prop _ _ H); clear H.
333		generalize (submap_2 Hm Hm' H0).
334		generalize (submap_2 Hm' Hm H1).
335		firstorder.
336		- intuition.
337		apply andb_true_intro; split; apply submap_1; unfold Submap; firstorder.
338		Qed.
339		End Elt.
340		Section Elt2.
341		Variable elt elt' : Type.
342
343		(** * [map] and [mapi] *)
344
345		Fixpoint map (f:elt -> elt') (m:t elt) : t elt' :=
346		match m with
347		\| nil => nil
348		\| (k,e)::m' => (k,f e) :: map f m'
349		end.
350
351		Fixpoint mapi (f: key -> elt -> elt') (m:t elt) : t elt' :=
352		match m with
353		\| nil => nil
354		\| (k,e)::m' => (k,f k e) :: mapi f m'
355		end.
356
357		(** Specification of [map] *)
358
359		Lemma map_spec (f:elt->elt')(m:t elt)(x:key) :
360		find x (map f m) = option_map f (find x m).
361		Proof.
362		induction m as [ \| (k,e) m IH]; simpl; trivial.
363		dec; simpl; trivial.
364		Qed.
365
366		Lemma map_NoDup m (Hm : NoDupA (@eqk elt) m)(f:elt->elt') :
367		NoDupA (@eqk elt') (map f m).
368		Proof.
369		induction m; simpl; auto.
370		intros.
371		destruct a as (x',e').
372		inversion_clear Hm.
373		constructor; auto.
374		contradict H.
375		clear IHm H0.
376		induction m; simpl in *; auto.
377		inversion H.
378		destruct a; inversion H; auto.
379		Qed.
380
381		(** Specification of [mapi] *)
382
383		Lemma mapi_spec (f:key->elt->elt')(m:t elt)(x:key) :
384		exists y, X.eq y x /\ find x (mapi f m) = option_map (f y) (find x m).
385		Proof.
386		induction m as [ \| (k,e) m IH]; simpl; trivial.
387		- now exists x.
388		- dec; simpl.
389		+ now exists k.
390		+ destruct IH as (y,(Hy,H)). now exists y.
391		Qed.
392
393		Lemma mapi_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f: key->elt->elt'),
394		NoDupA (@eqk elt') (mapi f m).
395		Proof.
396		induction m; simpl; auto.
397		intros.
398		destruct a as (x',e').
399		inversion_clear Hm; auto.
400		constructor; auto.
401		contradict H.
402		clear IHm H0.
403		induction m; simpl in *; auto.
404		inversion_clear H.
405		destruct a; inversion_clear H; auto.
406		Qed.
407
408		End Elt2.
409
410		Lemma mapfst_InA {elt}(m:t elt) x :
411		InA X.eq x (List.map fst m) <-> In x m.
412		Proof.
413		induction m as [\| (k,e) m IH]; simpl; auto.
414		- split; inversion 1. inversion H0.
415		- rewrite InA_cons, In_cons. simpl. now rewrite IH.
416		Qed.
417
418		Lemma mapfst_NoDup {elt}(m:t elt) :
419		NoDupA X.eq (List.map fst m) <-> NoDupA eqk m.
420		Proof.
421		induction m as [\| (k,e) m IH]; simpl.
422		- split; constructor.
423		- split; inversion_clear 1; constructor; try apply IH; trivial.
424		+ contradict H0. rewrite mapfst_InA. eapply In_alt'; eauto.
425		+ rewrite mapfst_InA. contradict H0. now apply In_alt'.
426		Qed.
427
428		Lemma filter_NoDup f (m:list key) :
429		NoDupA X.eq m -> NoDupA X.eq (List.filter f m).
430		Proof.
431		induction 1; simpl.
432		- constructor.
433		- destruct (f x); trivial. constructor; trivial.
434		contradict H. rewrite InA_alt in *. destruct H as (y,(Hy,H)).
435		exists y; split; trivial. now rewrite filter_In in H.
436		Qed.
437
438		Lemma NoDupA_unique_repr (l:list key) x y :
439		NoDupA X.eq l -> X.eq x y -> List.In x l -> List.In y l -> x = y.
440		Proof.
441		intros H E Hx Hy.
442		induction H; simpl in *.
443		- inversion Hx.
444		- intuition; subst; trivial.
445		elim H. apply InA_alt. now exists y.
446		elim H. apply InA_alt. now exists x.
447		Qed.
448
449		Section Elt3.
450
451		Variable elt elt' elt'' : Type.
452
453		Definition restrict (m:t elt)(k:key) :=
454		match find k m with
455		\| None => true
456		\| Some _ => false
457		end.
458
459		Definition domains (m:t elt)(m':t elt') :=
460		List.map fst m ++ List.filter (restrict m) (List.map fst m').
461
462		Lemma domains_InA m m' (Hm : NoDupA eqk m) x :
463		InA X.eq x (domains m m') <-> In x m \/ In x m'.
464		Proof.
465		unfold domains.
466		assert (Proper (X.eq==>eq) (restrict m)).
467		{ intros k k' Hk. unfold restrict. now rewrite (find_eq Hm Hk). }
468		rewrite InA_app_iff, filter_InA, !mapfst_InA; intuition.
469		unfold restrict.
470		destruct (find x m) eqn:F.
471		- left. apply find_spec in F; trivial. now exists e.
472		- now right.
473		Qed.
474
475		Lemma domains_NoDup m m' : NoDupA eqk m -> NoDupA eqk m' ->
476		NoDupA X.eq (domains m m').
477		Proof.
478		intros Hm Hm'. unfold domains.
479		apply NoDupA_app; auto with *.
480		- now apply mapfst_NoDup.
481		- now apply filter_NoDup, mapfst_NoDup.
482		- intros x.
483		rewrite mapfst_InA. intros (e,H).
484		apply find_spec in H; trivial.
485		rewrite InA_alt. intros (y,(Hy,H')).
486		rewrite (find_eq Hm Hy) in H.
487		rewrite filter_In in H'. destruct H' as (_,H').
488		unfold restrict in H'. now rewrite H in H'.
489		Qed.
490
491		Fixpoint fold_keys (f:key->option elt'') l :=
492		match l with
493		\| nil => nil
494		\| k::l =>
495		match f k with
496		\| Some e => (k,e)::fold_keys f l
497		\| None => fold_keys f l
498		end
499		end.
500
501		Lemma fold_keys_In f l x e :
502		List.In (x,e) (fold_keys f l) <-> List.In x l /\ f x = Some e.
503		Proof.
504		induction l as [\|k l IH]; simpl.
505		- intuition.
506		- destruct (f k) eqn:F; simpl; rewrite IH; clear IH; intuition;
507		try left; congruence.
508		Qed.
509
510		Lemma fold_keys_NoDup f l :
511		NoDupA X.eq l -> NoDupA eqk (fold_keys f l).
512		Proof.
513		induction 1; simpl.
514		- constructor.
515		- destruct (f x); trivial.
516		constructor; trivial. contradict H.
517		apply InA_alt in H. destruct H as ((k,e'),(E,H)).
518		rewrite fold_keys_In in H.
519		apply InA_alt. exists k. now split.
520		Qed.
521
522		Variable f : key -> option elt -> option elt' -> option elt''.
523
524		Definition merge m m' : t elt'' :=
525		fold_keys (fun k => f k (find k m) (find k m')) (domains m m').
526
527		Lemma merge_NoDup m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m') :
528		NoDupA (@eqk elt'') (merge m m').
529		Proof.
530		now apply fold_keys_NoDup, domains_NoDup.
531		Qed.
532
533		Lemma merge_spec1 m (Hm:NoDupA eqk m) m' (Hm':NoDupA eqk m') x :
534		In x m \/ In x m' ->
535		exists y:key, X.eq y x /\
536		find x (merge m m') = f y (find x m) (find x m').
537		Proof.
538		assert (Hmm' : NoDupA eqk (merge m m')) by now apply merge_NoDup.
539		rewrite <- domains_InA; trivial.
540		rewrite InA_alt. intros (y,(Hy,H)).
541		exists y; split; [easy\|].
542		rewrite (find_eq Hm Hy), (find_eq Hm' Hy).
543		destruct (f y (find y m) (find y m')) eqn:F.
544		- apply find_spec; trivial.
545		red. apply InA_alt. exists (y,e). split. now split.
546		unfold merge. apply fold_keys_In. now split.
547		- destruct (find x (merge m m')) eqn:F'; trivial.
548		rewrite <- F; clear F. symmetry.
549		apply find_spec in F'; trivial.
550		red in F'. rewrite InA_alt in F'.
551		destruct F' as ((y',e'),(E,F')).
552		unfold merge in F'; rewrite fold_keys_In in F'.
553		destruct F' as (H',F').
554		compute in E; destruct E as (Hy',<-).
555		replace y with y'; trivial.
556		apply (@NoDupA_unique_repr (domains m m')); auto.
557		now apply domains_NoDup.
558		now transitivity x.
559		Qed.
560
561		Lemma merge_spec2 m (Hm:NoDupA eqk m) m' (Hm':NoDupA eqk m') x :
562		In x (merge m m') -> In x m \/ In x m'.
563		Proof.
564		rewrite <- domains_InA; trivial.
565		intros (e,H). red in H. rewrite InA_alt in H. destruct H as ((k,e'),(E,H)).
566		unfold merge in H; rewrite fold_keys_In in H. destruct H as (H,_).
567		apply InA_alt. exists k. split; trivial. now destruct E.
568		Qed.
569
570		End Elt3.
571		End Raw.
572
573
574		Module Make (X: DecidableType) <: WS with Module E:=X.
575		Module Raw := Raw X.
576
577		Module E := X.
578		Definition key := E.t.
579		Definition eq_key {elt} := @Raw.PX.eqk elt.
580		Definition eq_key_elt {elt} := @Raw.PX.eqke elt.
581
582		Record t_ (elt:Type) := Mk
583		{this :> Raw.t elt;
584		nodup : NoDupA Raw.PX.eqk this}.
585		Definition t := t_.
586
587		Definition empty {elt} : t elt := Mk (Raw.empty_NoDup elt).
588
589		Section Elt.
590		Variable elt elt' elt'':Type.
591		Implicit Types m : t elt.
592		Implicit Types x y : key.
593		Implicit Types e : elt.
594
595		Definition find x m : option elt := Raw.find x m.(this).
596		Definition mem x m : bool := Raw.mem x m.(this).
597		Definition is_empty m : bool := Raw.is_empty m.(this).
598		Definition add x e m : t elt := Mk (Raw.add_NoDup m.(nodup) x e).
599		Definition remove x m : t elt := Mk (Raw.remove_NoDup m.(nodup) x).
600		Definition map f m : t elt' := Mk (Raw.map_NoDup m.(nodup) f).
601		Definition mapi (f:key->elt->elt') m : t elt' :=
602		Mk (Raw.mapi_NoDup m.(nodup) f).
603		Definition merge f m (m':t elt') : t elt'' :=
604		Mk (Raw.merge_NoDup f m.(nodup) m'.(nodup)).
605		Definition bindings m : list (key*elt) := Raw.bindings m.(this).
606		Definition cardinal m := length m.(this).
607		Definition fold {A}(f:key->elt->A->A) m (i:A) : A := Raw.fold f m.(this) i.
608		Definition equal cmp m m' : bool := Raw.equal cmp m.(this) m'.(this).
609		Definition MapsTo x e m : Prop := Raw.PX.MapsTo x e m.(this).
610		Definition In x m : Prop := Raw.PX.In x m.(this).
611
612		Definition Equal m m' := forall y, find y m = find y m'.
613		Definition Equiv (eq_elt:elt->elt->Prop) m m' :=
614		(forall k, In k m <-> In k m') /\
615		(forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e').
616		Definition Equivb cmp m m' : Prop := Raw.Equivb cmp m.(this) m'.(this).
617
618		Instance MapsTo_compat :
619		Proper (E.eq==>Logic.eq==>Logic.eq==>iff) MapsTo.
620		Proof.
621		intros x x' Hx e e' <- m m' <-. unfold MapsTo. now rewrite Hx.
622		Qed.
623
624		Lemma find_spec m : forall x e, find x m = Some e <-> MapsTo x e m.
625		Proof. exact (Raw.find_spec m.(nodup)). Qed.
626
627		Lemma mem_spec m : forall x, mem x m = true <-> In x m.
628		Proof. exact (Raw.mem_spec m.(nodup)). Qed.
629
630		Lemma empty_spec : forall x, find x empty = None.
631		Proof. exact (Raw.empty_spec _). Qed.
632
633		Lemma is_empty_spec m : is_empty m = true <-> (forall x, find x m = None).
634		Proof. exact (Raw.is_empty_spec m.(this)). Qed.
635
636		Lemma add_spec1 m : forall x e, find x (add x e m) = Some e.
637		Proof. exact (Raw.add_spec1 m.(this)). Qed.
638		Lemma add_spec2 m : forall x y e, ~E.eq x y -> find y (add x e m) = find y m.
639		Proof. exact (Raw.add_spec2 m.(this)). Qed.
640
641		Lemma remove_spec1 m : forall x, find x (remove x m) = None.
642		Proof. exact (Raw.remove_spec1 m.(nodup)). Qed.
643		Lemma remove_spec2 m : forall x y, ~E.eq x y -> find y (remove x m) = find y m.
644		Proof. exact (Raw.remove_spec2 m.(nodup)). Qed.
645
646		Lemma bindings_spec1 m : forall x e,
647		InA eq_key_elt (x,e) (bindings m) <-> MapsTo x e m.
648		Proof. exact (Raw.bindings_spec1 m.(this)). Qed.
649		Lemma bindings_spec2w m : NoDupA eq_key (bindings m).
650		Proof. exact (Raw.bindings_spec2w m.(nodup)). Qed.
651
652		Lemma cardinal_spec m : cardinal m = length (bindings m).
653		Proof. reflexivity. Qed.
654
655		Lemma fold_spec m : forall (A : Type) (i : A) (f : key -> elt -> A -> A),
656		fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (bindings m) i.
657		Proof. exact (Raw.fold_spec m.(this)). Qed.
658
659		Lemma equal_spec m m' : forall cmp, equal cmp m m' = true <-> Equivb cmp m m'.
660		Proof. exact (Raw.equal_spec m.(nodup) m'.(nodup)). Qed.
661
662		End Elt.
663
664		Lemma map_spec {elt elt'} (f:elt->elt') m :
665		forall x, find x (map f m) = option_map f (find x m).
666		Proof. exact (Raw.map_spec f m.(this)). Qed.
667
668		Lemma mapi_spec {elt elt'} (f:key->elt->elt') m :
669		forall x, exists y,
670		E.eq y x /\ find x (mapi f m) = option_map (f y) (find x m).
671		Proof. exact (Raw.mapi_spec f m.(this)). Qed.
672
673		Lemma merge_spec1 {elt elt' elt''}
674		(f:key->option elt->option elt'->option elt'') m m' :
675		forall x,
676		In x m \/ In x m' ->
677		exists y, E.eq y x /\ find x (merge f m m') = f y (find x m) (find x m').
678		Proof. exact (Raw.merge_spec1 f m.(nodup) m'.(nodup)). Qed.
679
680		Lemma merge_spec2 {elt elt' elt''}
681		(f:key->option elt->option elt'->option elt'') m m' :
682		forall x,
683		In x (merge f m m') -> In x m \/ In x m'.
684		Proof. exact (Raw.merge_spec2 m.(nodup) m'.(nodup)). Qed.
685
686		End Make.

+0

-16

~~theories/MMaps/MMaps.v~~ less more

0		(***********************************************************************)
1		(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA-Rocquencourt & LRI-CNRS-Orsay *)
3		(* \VV/ *************************************************************)
4		(* // * This file is distributed under the terms of the *)
5		(* * GNU Lesser General Public License Version 2.1 *)
6		(***********************************************************************)
7
8
9		Require Export Orders OrdersEx OrdersAlt.
10		Require Export Equalities.
11		Require Export MMapInterface.
12		Require Export MMapFacts.
13		Require Export MMapWeakList.
14		Require Export MMapList.
15		Require Export MMapPositive.

+0

-7

~~theories/MMaps/vo.itarget~~ less more

0		MMapInterface.vo
1		MMapFacts.vo
2		MMapWeakList.vo
3		MMapList.vo
4		MMapPositive.vo
5		MMaps.vo
6		MMapAVL.vo⏎

+1

-1

theories/NArith/BinNat.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/BinNatDef.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/NArith.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/Ndec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/Ndigits.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/Ndist.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/Ndiv_def.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/Ngcd_def.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/Nnat.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/NArith/Nsqrt_def.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/BigNumPrelude.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/BinNums.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/Abstract/CyclicAxioms.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/Abstract/NZCyclic.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/Int31/Cyclic31.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/Int31/Int31.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/Int31/Ring31.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Cyclic/ZModulo/ZModulo.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZAdd.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZAddOrder.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZAxioms.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZBase.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZBits.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/Numbers/Integer/Abstract/ZDivEucl.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

390	390	apply add_cancel_l.
391	391	Qed.
392	392
393		(** Some additionnal inequalities about div. *)
	393	(** Some additional inequalities about div. *)
394	394
395	395	Theorem div_lt_upper_bound:
396	396	forall a b q, 0<b -> a < b*q -> a/b < q.

+2

-2

theories/Numbers/Integer/Abstract/ZDivFloor.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

435	435	apply add_cancel_l.
436	436	Qed.
437	437
438		(** Some additionnal inequalities about div. *)
	438	(** Some additional inequalities about div. *)
439	439
440	440	Theorem div_lt_upper_bound:
441	441	forall a b q, 0<b -> a < b*q -> a/b < q.

+2

-2

theories/Numbers/Integer/Abstract/ZDivTrunc.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

403	403	intros. rewrite rem_eq by order. rewrite sub_move_r; nzsimpl; tauto.
404	404	Qed.
405	405
406		(** Some additionnal inequalities about quot. *)
	406	(** Some additional inequalities about quot. *)
407	407
408	408	Theorem quot_lt_upper_bound:
409	409	forall a b q, 0<=a -> 0<b -> a < b*q -> a÷b < q.

+1

-1

theories/Numbers/Integer/Abstract/ZGcd.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZLcm.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZLt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZMaxMin.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZMul.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZMulOrder.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZParity.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZPow.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZProperties.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Abstract/ZSgnAbs.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/BigZ/BigZ.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/BigZ/ZMake.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/Binary/ZBinary.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/NatPairs/ZNatPairs.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/SpecViaZ/ZSig.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NaryFunctions.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZAdd.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZAddOrder.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZAxioms.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZBase.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZBits.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/Numbers/NatInt/NZDiv.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

306	306	apply add_cancel_l.
307	307	Qed.
308	308
309		(** Some additionnal inequalities about div. *)
	309	(** Some additional inequalities about div. *)
310	310
311	311	Theorem div_lt_upper_bound:
312	312	forall a b q, 0<=a -> 0<b -> a < b*q -> a/b < q.

+1

-1

theories/Numbers/NatInt/NZDomain.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZGcd.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZLog.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZMul.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZMulOrder.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZOrder.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZParity.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZPow.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZProperties.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NatInt/NZSqrt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NAdd.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NAddOrder.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NAxioms.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NBase.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NBits.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NDefOps.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/Numbers/Natural/Abstract/NDiv.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

136	136	Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0).
137	137	Proof. intros. apply div_exact; auto'. Qed.
138	138
139		(** Some additionnal inequalities about div. *)
	139	(** Some additional inequalities about div. *)
140	140
141	141	Theorem div_lt_upper_bound:
142	142	forall a b q, b~=0 -> a < b*q -> a/b < q.

+1

-1

theories/Numbers/Natural/Abstract/NGcd.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NIso.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NLcm.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NLog.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NMaxMin.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NMulOrder.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NOrder.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/Numbers/Natural/Abstract/NParity.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

7	7
8	8	Require Import Bool NSub NZParity.
9	9
10		(** Some additionnal properties of [even], [odd]. *)
	10	(** Some additional properties of [even], [odd]. *)
11	11
12	12	Module Type NParityProp (Import N : NAxiomsSig')(Import NP : NSubProp N).
13	13

+1

-1

theories/Numbers/Natural/Abstract/NPow.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NProperties.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NSqrt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NStrongRec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Abstract/NSub.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/BigN/BigN.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/BigN/NMake.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/BigN/NMake_gen.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/BigN/Nbasic.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Binary/NBinary.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/Peano/NPeano.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/SpecViaZ/NSig.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/NumPrelude.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Rational/BigQ/BigQ.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Rational/BigQ/QMake.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Numbers/Rational/SpecViaQ/QSig.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/PArith/BinPos.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/PArith/BinPosDef.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/PArith/PArith.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/PArith/POrderedType.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/PArith/Pnat.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Program/Basics.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Program/Combinators.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Program/Equality.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Program/Program.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/Program/Subset.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

81	81	Definition match_eq (A B : Type) (x : A) (fn : {y : A \| y = x} -> B) : B :=
82	82	fn (exist _ x eq_refl).
83	83
84		(* This is what we want to be able to do: replace the originaly matched object by a new,
	84	(* This is what we want to be able to do: replace the originally matched object by a new,
85	85	propositionally equal one. If [fn] works on [x] it should work on any [y \| y = x]. *)
86	86
87	87	Lemma match_eq_rewrite : forall (A B : Type) (x : A) (fn : {y : A \| y = x} -> B)

+1

-1

theories/Program/Syntax.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Program/Tactics.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Program/Utils.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Program/Wf.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/QArith.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/QArith_base.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/QOrderedType.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qabs.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qcanon.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qfield.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qminmax.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qpower.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qreals.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qreduction.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qring.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/QArith/Qround.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Alembert.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/AltSeries.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/ArithProp.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Binomial.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Cauchy_prod.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Cos_plus.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Cos_rel.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/DiscrR.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Exp_prop.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Integration.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/MVT.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Machin.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/NewtonInt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/PSeries_reg.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/PartSum.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/RIneq.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/RList.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/ROrderedType.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/R_Ifp.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/R_sqr.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/R_sqrt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Ranalysis.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Ranalysis1.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Ranalysis2.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Ranalysis3.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Ranalysis4.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Ranalysis5.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Ranalysis_reg.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Ratan.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Raxioms.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rbase.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rbasic_fun.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rcomplete.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rdefinitions.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rderiv.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Reals.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rfunctions.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rgeom.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/RiemannInt.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/RiemannInt_SF.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rlimit.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rlogic.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rminmax.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rpow_def.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rpower.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rprod.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rseries.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rsigma.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rsqrt_def.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rtopology.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rtrigo.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rtrigo1.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rtrigo_alt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rtrigo_calc.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rtrigo_def.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rtrigo_fun.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Rtrigo_reg.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/SeqProp.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/SeqSeries.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/SplitAbsolu.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/SplitRmult.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Reals/Sqrt_reg.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Relations/Operators_Properties.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Relations/Relation_Definitions.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Relations/Relation_Operators.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Relations/Relations.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Setoids/Setoid.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Classical_sets.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Constructive_sets.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Cpo.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Ensembles.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Finite_sets.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Finite_sets_facts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Image.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Infinite_sets.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Integers.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Multiset.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Partial_Order.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Permut.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Powerset.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Powerset_Classical_facts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Powerset_facts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Relations_1.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Relations_1_facts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Relations_2.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Relations_2_facts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Relations_3.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Relations_3_facts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sets/Uniset.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sorting/Heap.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sorting/Mergesort.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sorting/PermutEq.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sorting/PermutSetoid.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sorting/Permutation.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sorting/Sorted.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Sorting/Sorting.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Strings/Ascii.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Strings/String.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/Structures/EqualitiesFacts.v less more

9	9
10	10	Set Implicit Arguments.
11	11
12		(** * Keys and datas used in MMap *)
	12	(** * Keys and datas used in the future MMaps *)
13	13
14	14	Module KeyDecidableType(D:DecidableType).
15	15

59	59
60	60	Hint Resolve eqke_1 eqke_2 eqk_1.
61	61
62		(* Additionnal facts *)
	62	(* Additional facts *)
63	63
64	64	Lemma InA_eqke_eqk {elt} p (m:list (key*elt)) :
65	65	InA eqke p m -> InA eqk p m.

+1

-1

theories/Structures/OrderedType.v less more

341	341	compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto.
342	342	Qed.
343	343
344		(* Additionnal facts *)
	344	(* Additional facts *)
345	345
346	346	Lemma eqk_not_ltk : forall x x', eqk x x' -> ~ltk x x'.
347	347	Proof.

+1

-1

theories/Structures/OrdersEx.v less more

86	86	(** Even if [positive] can be seen as an ordered type with respect to the
87	87	usual order (see above), we can also use a lexicographic order over bits
88	88	(lower bits are considered first). This is more natural when using
89		[positive] as indexes for sets or maps (see MSetPositive and MMapPositive. *)
	89	[positive] as indexes for sets or maps (see MSetPositive). *)
90	90
91	91	Local Open Scope positive.
92	92

+1

-1

theories/Structures/OrdersFacts.v less more

89	89	Instance le_order : PartialOrder eq le.
90	90	Proof. compute; iorder. Qed.
91	91
92		Instance le_antisym : Antisymmetric eq le.
	92	Instance le_antisym : Antisymmetric _ eq le.
93	93	Proof. apply partial_order_antisym; auto with *. Qed.
94	94
95	95	Lemma le_not_gt_iff : forall x y, x<=y <-> ~y<x.

+2

-2

theories/Structures/OrdersLists.v less more

53	53	End OrderedTypeLists.
54	54
55	55
56		(** * Results about keys and data as manipulated in MMaps. *)
	56	(** * Results about keys and data as manipulated in the future MMaps. *)
57	57
58	58	Module KeyOrderedType(O:OrderedType).
59	59	Include KeyDecidableType(O). (* provides eqk, eqke *)

75	75	Instance ltk_compat' {elt} : Proper (eqke==>eqke==>iff) (@ltk elt).
76	76	Proof. eapply subrelation_proper; eauto with *. Qed.
77	77
78		(* Additionnal facts *)
	78	(* Additional facts *)
79	79
80	80	Instance pair_compat {elt} : Proper (O.eq==>Logic.eq==>eqke) (@pair key elt).
81	81	Proof. apply pair_compat. Qed.

+1

-1

theories/Unicode/Utf8.v less more

0	0	(* -- coding:utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Unicode/Utf8_core.v less more

0	0	(* -- coding:utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Wellfounded/Disjoint_Union.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Wellfounded/Inclusion.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Wellfounded/Inverse_Image.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/Wellfounded/Lexicographic_Exponentiation.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

94	94	intros.
95	95	- inversion H.
96	96	assert ([b; a] = ([] ++ [b]) ++ [a]) by auto with sets.
97		destruct (app_inj_tail (l ++ [y]) ([] ++ [b]) _ _ H0) as ((?, <-)/app_inj_tail, <-).
	97	destruct (app_inj_tail (l ++ [y]) ([] ++ [b]) _ _ H0) as ((?, <-)%app_inj_tail, <-).
98	98	inversion H1; subst; [ apply rt_step; assumption \| apply rt_refl ].
99	99	- inversion H0.
100	100	+ apply app_cons_not_nil in H3 as ().

+1

-1

theories/Wellfounded/Lexicographic_Product.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Wellfounded/Transitive_Closure.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Wellfounded/Union.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Wellfounded/Well_Ordering.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/Wellfounded/Wellfounded.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/BinInt.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/BinIntDef.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Wf_Z.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/ZArith.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/ZArith_base.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/ZArith_dec.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zabs.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zbool.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zcompare.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zcomplements.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zdigits.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/ZArith/Zdiv.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

278	278	Theorem Zmod_le: forall a b, 0 < b -> 0 <= a -> a mod b <= a.
279	279	Proof. intros. apply Z.mod_le; auto. Qed.
280	280
281		(** Some additionnal inequalities about Z.div. *)
	281	(** Some additional inequalities about Z.div. *)
282	282
283	283	Theorem Zdiv_lt_upper_bound:
284	284	forall a b q, 0 < b -> a < q*b -> a/b < q.

+1

-1

theories/ZArith/Zeuclid.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zeven.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zgcd_alt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zhints.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zlogarithm.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zmax.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zmin.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zminmax.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zmisc.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Znat.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Znumtheory.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zorder.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/ZArith/Zpow_alt.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

10	10
11	11	(** An alternative power function for Z *)
12	12
13		(** This [Zpower_alt] is extensionnaly equal to [Z.pow],
	13	(** This [Zpower_alt] is extensionally equal to [Z.pow],
14	14	but not convertible with it. The number of
15	15	multiplications is logarithmic instead of linear, but
16	16	these multiplications are bigger. Experimentally, it seems

+1

-1

theories/ZArith/Zpow_def.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zpow_facts.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zpower.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

theories/ZArith/Zquot.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

242	242	Theorem Zrem_le a b : 0 <= a -> 0 <= b -> Z.rem a b <= a.
243	243	Proof. intros. zero_or_not b. apply Z.rem_le; auto with zarith. Qed.
244	244
245		(** Some additionnal inequalities about Zdiv. *)
	245	(** Some additional inequalities about Zdiv. *)
246	246
247	247	Theorem Zquot_le_upper_bound:
248	248	forall a b q, 0 < b -> a <= q*b -> a÷b <= q.

+1

-1

theories/ZArith/Zsqrt_compat.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/Zwf.v less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

theories/ZArith/auxiliary.v less more

0	0	(* -- coding: utf-8 -- *)
1	1	(************************************************************************)
2	2	(* v * The Coq Proof Assistant / The Coq Development Team *)
3		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	3	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
4	4	(* \VV/ **************************************************************)
5	5	(* // * This file is distributed under the terms of the *)
6	6	(* * GNU Lesser General Public License Version 2.1 *)

+0

-1

theories/theories.itarget less more

3	3	Compat/vo.otarget
4	4	FSets/vo.otarget
5	5	MSets/vo.otarget
6		MMaps/vo.otarget
7	6	Structures/vo.otarget
8	7	Init/vo.otarget
9	8	Lists/vo.otarget

+1

-1

tools/compat5.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/compat5.mlp less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/compat5b.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/compat5b.mlp less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coq_makefile.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coq_tex.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqc.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+41

-20

tools/coqdep.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

425	425	end
426	426
427	427	let usage () =
428		eprintf " usage: coqdep [-w] [-c] [-D] [-I dir] [-R dir coqdir] <filename>+\n";
429		eprintf " extra options:\n";
	428	eprintf " usage: coqdep [options] <filename>+\n";
	429	eprintf " options:\n";
	430	eprintf " -c : Also print the dependencies of caml modules (=ocamldep).\n";
	431	(* Does not work anymore *)
	432	(* eprintf " -w : Print informations on missing or wrong \"Declare
	433	ML Module\" commands in coq files.\n"; *)
	434	(* Does not work anymore: *)
	435	(* eprintf " -D : Prints the missing ocmal module names. No dependency computed.\n"; *)
	436	eprintf " -boot : For coq developpers, prints dependencies over coq library files (omitted by default).\n";
	437	eprintf " -sort : output the given file name ordered by dependencies\n";
	438	eprintf " -noglob \| -no-glob : \n";
	439	eprintf " -I dir -as logname : add (non recursively) dir to coq load path under logical name logname\n";
	440	eprintf " -I dir : add (non recursively) dir to ocaml path\n";
	441	eprintf " -R dir -as logname : add and import dir recursively to coq load path under logical name logname\n"; (* deprecate? *)
	442	eprintf " -R dir logname : add and import dir recursively to coq load path under logical name logname\n";
	443	eprintf " -Q dir logname : add (recusively) and open (non recursively) dir to coq load path under logical name logname\n";
	444	eprintf " -dumpgraph f : print a dot dependency graph in file 'f'\n";
	445	eprintf " -dumpgraphbox f : print a dot dependency graph box in file 'f'\n";
	446	eprintf " -exclude-dir dir : skip subdirectories named 'dir' during -R/-Q search\n";
430	447	eprintf " -coqlib dir : set the coq standard library directory\n";
431		eprintf " -exclude-dir f : skip subdirectories named 'f' during -R search\n";
432		eprintf " -dumpgraph f : print a dot dependency graph in file 'f'\n";
	448	eprintf " -suffix s : \n";
	449	eprintf " -slash : deprecated, no effect\n";
433	450	exit 1
434	451
435	452	let split_period = Str.split (Str.regexp (Str.quote "."))

441	458	\| "-boot" :: ll -> option_boot := true; parse ll
442	459	\| "-sort" :: ll -> option_sort := true; parse ll
443	460	\| ("-noglob" \| "-no-glob") :: ll -> option_noglob := true; parse ll
444		\| "-I" :: r :: "-as" :: ln :: ll -> add_dir add_known r [];
445		add_dir add_known r (split_period ln);
446		parse ll
	461	\| "-I" :: r :: "-as" :: ln :: ll ->
	462	add_rec_dir_no_import add_known r [];
	463	add_rec_dir_no_import add_known r (split_period ln);
	464	parse ll
447	465	\| "-I" :: r :: "-as" :: [] -> usage ()
448	466	\| "-I" :: r :: ll -> add_caml_dir r; parse ll
449	467	\| "-I" :: [] -> usage ()
450		\| "-R" :: r :: "-as" :: ln :: ll -> add_rec_dir add_known r (split_period ln); parse ll
	468	\| "-R" :: r :: "-as" :: ln :: ll -> add_rec_dir_import add_known r (split_period ln); parse ll
451	469	\| "-R" :: r :: "-as" :: [] -> usage ()
452		\| "-R" :: r :: ln :: ll -> add_rec_dir add_known r (split_period ln); parse ll
453		\| "-Q" :: r :: ln :: ll -> add_dir add_known r (split_period ln); parse ll
	470	\| "-R" :: r :: ln :: ll -> add_rec_dir_import add_known r (split_period ln); parse ll
	471	\| "-Q" :: r :: ln :: ll -> add_rec_dir_no_import add_known r (split_period ln); parse ll
454	472	\| "-R" :: ([] \| [_]) -> usage ()
455	473	\| "-dumpgraph" :: f :: ll -> option_dump := Some (false, f); parse ll
456	474	\| "-dumpgraphbox" :: f :: ll -> option_dump := Some (true, f); parse ll

470	488	let coqdep () =
471	489	if Array.length Sys.argv < 2 then usage ();
472	490	parse (List.tl (Array.to_list Sys.argv));
	491	(* Add current dir with empty logical path if not set by options above. *)
	492	(try ignore (Coqdep_common.find_dir_logpath (Sys.getcwd()))
	493	with Not_found -> add_norec_dir_import add_known "." []);
473	494	if not Coq_config.has_natdynlink then option_natdynlk := false;
474	495	(* NOTE: These directories are searched from last to first *)
475	496	if !option_boot then begin
476		add_rec_dir add_known "theories" ["Coq"];
477		add_rec_dir add_known "plugins" ["Coq"];
478		add_rec_dir (fun _ -> add_caml_known) "theories" ["Coq"];
479		add_rec_dir (fun _ -> add_caml_known) "plugins" ["Coq"];
	497	add_rec_dir_import add_known "theories" ["Coq"];
	498	add_rec_dir_import add_known "plugins" ["Coq"];
	499	add_rec_dir_import (fun _ -> add_caml_known) "theories" ["Coq"];
	500	add_rec_dir_import (fun _ -> add_caml_known) "plugins" ["Coq"];
480	501	end else begin
481	502	Envars.set_coqlib ~fail:Errors.error;
482	503	let coqlib = Envars.coqlib () in
483		add_rec_dir add_coqlib_known (coqlib//"theories") ["Coq"];
484		add_rec_dir add_coqlib_known (coqlib//"plugins") ["Coq"];
	504	add_rec_dir_import add_coqlib_known (coqlib//"theories") ["Coq"];
	505	add_rec_dir_import add_coqlib_known (coqlib//"plugins") ["Coq"];
485	506	let user = coqlib//"user-contrib" in
486		if Sys.file_exists user then add_dir add_coqlib_known user [];
487		List.iter (fun s -> add_dir add_coqlib_known s [])
	507	if Sys.file_exists user then add_rec_dir_no_import add_coqlib_known user [];
	508	List.iter (fun s -> add_rec_dir_no_import add_coqlib_known s [])
488	509	(Envars.xdg_dirs (fun x -> Pp.msg_warning (Pp.str x)));
489		List.iter (fun s -> add_dir add_coqlib_known s []) Envars.coqpath;
	510	List.iter (fun s -> add_rec_dir_no_import add_coqlib_known s []) Envars.coqpath;
490	511	end;
491	512	List.iter (fun (f,d) -> add_mli_known f d ".mli") !mliAccu;
492	513	List.iter (fun (f,d) -> add_mllib_known f d ".mllib") !mllibAccu;

+7

-7

tools/coqdep_boot.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

34	34	if Array.length Sys.argv < 2 then exit 1;
35	35	parse (List.tl (Array.to_list Sys.argv));
36	36	if !option_c then begin
37		add_rec_dir add_known "." [];
38		add_rec_dir (fun _ -> add_caml_known) "." ["Coq"];
	37	add_rec_dir_import add_known "." [];
	38	add_rec_dir_import (fun _ -> add_caml_known) "." ["Coq"];
39	39	end
40	40	else begin
41		add_rec_dir add_known "theories" ["Coq"];
42		add_rec_dir add_known "plugins" ["Coq"];
	41	add_rec_dir_import add_known "theories" ["Coq"];
	42	add_rec_dir_import add_known "plugins" ["Coq"];
43	43	add_caml_dir "tactics";
44		add_rec_dir (fun _ -> add_caml_known) "theories" ["Coq"];
45		add_rec_dir (fun _ -> add_caml_known) "plugins" ["Coq"];
	44	add_rec_dir_import (fun _ -> add_caml_known) "theories" ["Coq"];
	45	add_rec_dir_import (fun _ -> add_caml_known) "plugins" ["Coq"];
46	46	end;
47	47	if !option_c then mL_dependencies ();
48	48	coq_dependencies ()

+29

-9

tools/coqdep_common.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

218	218	let absolute_file_name basename odir =
219	219	let dir = match odir with Some dir -> dir \| None -> "." in
220	220	absolute_dir dir // basename
	221
	222	(** [find_dir_logpath dir] Return the logical path of directory [dir]
	223	if it has been given one. Raise [Not_found] otherwise. In
	224	particular we can check if "." has been attributed a logical path
	225	after processing all options and silently give the default one if
	226	it hasn't. We may also use this to warn if ap hysical path is met
	227	twice.*)
	228	let register_dir_logpath,find_dir_logpath =
	229	let tbl: (string, string list) Hashtbl.t = Hashtbl.create 19 in
	230	let reg physdir logpath = Hashtbl.add tbl (absolute_dir physdir) logpath in
	231	let fnd physdir = Hashtbl.find tbl (absolute_dir physdir) in
	232	reg,fnd
221	233
222	234	let file_name s = function
223	235	\| None -> s

338	350	Buffer.contents s'
339	351
340	352	let compare_file f1 f2 =
341		absolute_dir (Filename.dirname f1) = absolute_dir (Filename.dirname f2)
	353	absolute_file_name (Filename.basename f1) (Some (Filename.dirname f1))
	354	= absolute_file_name (Filename.basename f2) (Some (Filename.dirname f2))
342	355
343	356	let canonize f =
344	357	let f' = absolute_dir (Filename.dirname f) // Filename.basename f in

513	526	List.iter (fun f -> Hashtbl.add coqlibKnown f ()) paths
514	527	\| _ -> ()
515	528
516		(* Visits all the directories under [dir], including [dir],
517		or just [dir] if [recur=false] *)
518
	529	(** Visit directory [phys_dir] (recursively unless [recur=false]) and
	530	apply function add_file to each regular file encountered.
	531	[log_dir] is the logical name of the [phys_dir].
	532	[add_file] takes both directory names and the file. *)
519	533	let rec add_directory recur add_file phys_dir log_dir =
520	534	let dirh = opendir phys_dir in
	535	register_dir_logpath phys_dir log_dir;
521	536	try
522	537	while true do
523	538	let f = readdir dirh in

530	545	if StrSet.mem f !norec_dirnames then ()
531	546	else
532	547	if StrSet.mem phys_f !norec_dirs then ()
533		else
	548	else (* TODO: warn if already seen this physycal dir? *)
534	549	add_directory recur add_file phys_f (log_dir@[f])
535	550	\| S_REG -> add_file phys_dir log_dir f
536	551	\| _ -> ()
537	552	done
538	553	with End_of_file -> closedir dirh
539	554
	555	(** Simply add this directory and imports it, no subdirs. This is used
	556	by the implicit adding of the current path (which is not recursive). *)
	557	let add_norec_dir_import add_file phys_dir log_dir =
	558	try add_directory false (add_file true) phys_dir log_dir with Unix_error _ -> ()
	559
540	560	(** -Q semantic: go in subdirs but only full logical paths are known. *)
541		let add_dir add_file phys_dir log_dir =
	561	let add_rec_dir_no_import add_file phys_dir log_dir =
542	562	try add_directory true (add_file false) phys_dir log_dir with Unix_error _ -> ()
543	563
544	564	(** -R semantic: go in subdirs and suffixes of logical paths are known. *)
545		let add_rec_dir add_file phys_dir log_dir =
	565	let add_rec_dir_import add_file phys_dir log_dir =
546	566	handle_unix_error (add_directory true (add_file true) phys_dir) log_dir
547	567
548	568	(** -I semantic: do not go in subdirs. *)
549	569	let add_caml_dir phys_dir =
550		handle_unix_error (add_directory true add_caml_known phys_dir) []
	570	handle_unix_error (add_directory false add_caml_known phys_dir) []
551	571
552	572
553	573	let rec treat_file old_dirname old_name =

+21

-3

tools/coqdep_common.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)
6	6	(************************************************************************)
7	7
8	8	module StrSet : Set.S with type elt = string
	9
	10	(** [find_dir_logpath dir] Return the logical path of directory [dir]
	11	if it has been given one. Raise [Not_found] otherwise. In
	12	particular we can check if "." has been attributed a logical path
	13	after processing all options and silently give the default one if
	14	it hasn't. We may also use this to warn if ap hysical path is met
	15	twice.*)
	16	val find_dir_logpath: string -> string list
9	17
10	18	val option_c : bool ref
11	19	val option_noglob : bool ref

46	54	bool ->
47	55	(string -> string list -> string -> unit) -> string -> string list -> unit
48	56	val add_caml_dir : string -> unit
49		val add_dir :
	57
	58	(** Simply add this directory and imports it, no subdirs. This is used
	59	by the implicit adding of the current path. *)
	60	val add_norec_dir_import :
50	61	(bool -> string -> string list -> string -> unit) -> string -> string list -> unit
51		val add_rec_dir :
	62
	63	(** -Q semantic: go in subdirs but only full logical paths are known. *)
	64	val add_rec_dir_no_import :
52	65	(bool -> string -> string list -> string -> unit) -> string -> string list -> unit
	66
	67	(** -R semantic: go in subdirs and suffixes of logical paths are known. *)
	68	val add_rec_dir_import :
	69	(bool -> string -> string list -> string -> unit) -> string -> string list -> unit
	70
53	71	val treat_file : dir -> string -> unit
54	72	val error_cannot_parse : string -> int * int -> 'a

+1

-1

tools/coqdep_lexer.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdep_lexer.mll less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/alpha.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/alpha.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/cdglobals.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/cpretty.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/cpretty.mll less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/index.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/index.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/main.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/output.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/output.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/tokens.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqdoc/tokens.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

tools/coqmktop.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

279	279	(* - We add topstart.cmo explicitly because we shunted ocamlmktop wrapper.
280	280	- With the coq .cma, we MUST use the -linkall option. *)
281	281	let args =
282		"-linkall" :: "-rectypes" :: flags @ copts @ options @
	282	"-linkall" :: "-rectypes" :: "-w" :: "-31" :: flags @ copts @ options @
283	283	(std_includes basedir) @ tolink @ [ main_file ] @ topstart
284	284	in
285	285	if !echo then begin

+1

-1

tools/coqwc.mll less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/coqworkmgr.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/fake_ide.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/gallina.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

tools/gallina_lexer.mll less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

toplevel/assumptions.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

157	157	\| Case (_,oty,c,[\|\|]) ->
158	158	(* non dependent match on an inductive with no constructors *)
159	159	begin match Constr.(kind oty, kind c) with
160		\| Lambda(Anonymous,_,oty), Const (kn, _)
	160	\| Lambda(_,_,oty), Const (kn, _)
161	161	when Vars.noccurn 1 oty &&
162	162	not (Declareops.constant_has_body (lookup_constant kn)) ->
163	163	let body () = Global.body_of_constant_body (lookup_constant kn) in

+1

-1

toplevel/assumptions.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/auto_ind_decl.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/auto_ind_decl.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/cerrors.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/cerrors.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/class.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/class.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+2

-2

toplevel/classes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

287	287	else if !refine_instance \|\| Option.is_empty term then begin
288	288	let kind = Decl_kinds.Global, poly, Decl_kinds.DefinitionBody Decl_kinds.Instance in
289	289	if Flags.is_program_mode () then
290		let hook vis gr =
	290	let hook vis gr _ =
291	291	let cst = match gr with ConstRef kn -> kn \| _ -> assert false in
292	292	Impargs.declare_manual_implicits false gr ~enriching:false [imps];
293	293	Typeclasses.declare_instance pri (not global) (ConstRef cst)

+1

-1

toplevel/classes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+8

-5

toplevel/command.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

191	191	Obligations.eterm_obligations env ident evd 0 c typ
192	192	in
193	193	let ctx = Evd.evar_universe_context evd in
	194	let hook = Lemmas.mk_hook (fun l r _ -> Lemmas.call_hook (fun exn -> exn) hook l r) in
194	195	ignore(Obligations.add_definition
195	196	ident ~term:c cty ctx ~implicits:imps ~kind:k ~hook obls)
196	197	else let ce = check_definition def in

1009	1010	let hook, recname, typ =
1010	1011	if List.length binders_rel > 1 then
1011	1012	let name = add_suffix recname "_func" in
1012		let hook l gr =
	1013	let hook l gr _ =
1013	1014	let body = it_mkLambda_or_LetIn (mkApp (Universes.constr_of_global gr, [\|make\|])) binders_rel in
1014	1015	let ty = it_mkProd_or_LetIn top_arity binders_rel in
1015	1016	let pl, univs = Evd.universe_context !evdref in

1025	1026	hook, name, typ
1026	1027	else
1027	1028	let typ = it_mkProd_or_LetIn top_arity binders_rel in
1028		let hook l gr =
	1029	let hook l gr _ =
1029	1030	if Impargs.is_implicit_args () \|\| not (List.is_empty impls) then
1030	1031	Impargs.declare_manual_implicits false gr [impls]
1031	1032	in hook, recname, typ

1126	1127	if List.exists Option.is_empty fixdefs then
1127	1128	(* Some bodies to define by proof *)
1128	1129	let thms =
1129		List.map3 (fun id t (len,imps,_) -> (id,(t,(len,imps)))) fixnames fixtypes fiximps in
	1130	List.map3 (fun id t (len,imps,_) -> ((id,pl),(t,(len,imps))))
	1131	fixnames fixtypes fiximps in
1130	1132	let init_tac =
1131	1133	Some (List.map (Option.cata Tacmach.refine_no_check Tacticals.tclIDTAC)
1132	1134	fixdefs) in

1162	1164	if List.exists Option.is_empty fixdefs then
1163	1165	(* Some bodies to define by proof *)
1164	1166	let thms =
1165		List.map3 (fun id t (len,imps,_) -> (id,(t,(len,imps)))) fixnames fixtypes fiximps in
	1167	List.map3 (fun id t (len,imps,_) -> ((id,pl),(t,(len,imps))))
	1168	fixnames fixtypes fiximps in
1166	1169	let init_tac =
1167	1170	Some (List.map (Option.cata Tacmach.refine_no_check Tacticals.tclIDTAC)
1168	1171	fixdefs) in

+1

-1

toplevel/command.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/coqinit.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/coqinit.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/coqloop.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/coqloop.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+8

-3

toplevel/coqtop.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

195	195	let map dir = Qualid (Loc.ghost, qualid_of_string dir) in
196	196	Vernacentries.vernac_require None (Some false) (List.rev_map map !require_list)
197	197
	198	let add_compat_require v =
	199	match v with
	200	\| Flags.V8_4 -> add_require "Coq.Compat.Coq84"
	201	\| _ -> ()
	202
198	203	let compile_list = ref ([] : (bool * string) list)
199	204
200	205	let glob_opt = ref false

474	479	\|"-async-proofs-private-flags" ->
475	480	Flags.async_proofs_private_flags := Some (next ());
476	481	\|"-worker-id" -> set_worker_id opt (next ())
477		\|"-compat" -> Flags.compat_version := get_compat_version (next ())
	482	\|"-compat" -> let v = get_compat_version (next ()) in Flags.compat_version := v; add_compat_require v
478	483	\|"-compile" -> add_compile false (next ())
479	484	\|"-compile-verbose" -> add_compile true (next ())
480	485	\|"-dump-glob" -> Dumpglob.dump_into_file (next ()); glob_opt := true

540	545	\|"-v"\|"--version" -> Usage.version (exitcode ())
541	546	\|"-verbose-compat-notations" -> verb_compat_ntn := true
542	547	\|"-where" -> print_where := true
	548	\|"-xml" -> Flags.xml_export := true
543	549
544	550	(* Deprecated options *)
545	551	\|"-byte" -> warning "option -byte deprecated, call with .byte suffix"

555	561	\|"-force-load-proofs" -> warning "Obsolete option \"-force-load-proofs\"."
556	562	\|"-unsafe" -> warning "Obsolete option \"-unsafe\"."; ignore (next ())
557	563	\|"-quality" -> warning "Obsolete option \"-quality\"."
558		\|"-xml" -> warning "Obsolete option \"-xml\"."
559	564
560	565	(* Unknown option *)
561	566	\| s -> extras := s :: !extras

+1

-1

toplevel/coqtop.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/discharge.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/discharge.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/g_obligations.ml4 less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+8

-1

toplevel/himsg.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

923	923	str "The field " ++ str (Label.to_string l) ++ str " is missing in "
924	924	++ str s ++ str "."
925	925
	926	let explain_include_restricted_functor mp =
	927	let q = Nametab.shortest_qualid_of_module mp in
	928	str "Cannot include the functor " ++ Libnames.pr_qualid q ++
	929	strbrk " since it has a restricted signature. " ++
	930	strbrk "You may name first an instance of this functor, and include it."
	931
926	932	let explain_module_error = function
927	933	\| SignatureMismatch (l,spec,err) -> explain_signature_mismatch l spec err
928	934	\| LabelAlreadyDeclared l -> explain_label_already_declared l

939	945	\| IncorrectWithConstraint l -> explain_incorrect_label_constraint l
940	946	\| GenerativeModuleExpected l -> explain_generative_module_expected l
941	947	\| LabelMissing (l,s) -> explain_label_missing l s
	948	\| IncludeRestrictedFunctor mp -> explain_include_restricted_functor mp
942	949
943	950	(* Module internalization errors *)
944	951

+1

-1

toplevel/himsg.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/ind_tables.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/ind_tables.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+16

-7

toplevel/indschemes.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

127	127	{ const_entry_body = c;
128	128	const_entry_secctx = None;
129	129	const_entry_type = t;
130		const_entry_polymorphic = true;
	130	const_entry_polymorphic = Flags.is_universe_polymorphism ();
131	131	const_entry_universes = snd (Evd.universe_context ctx);
132	132	const_entry_opaque = false;
133	133	const_entry_inline_code = false;

359	359	let do_mutual_induction_scheme lnamedepindsort =
360	360	let lrecnames = List.map (fun ((_,f),_,_,_) -> f) lnamedepindsort
361	361	and env0 = Global.env() in
362		let sigma, lrecspec =
	362	let sigma, lrecspec, _ =
363	363	List.fold_right
364		(fun (_,dep,ind,sort) (evd, l) ->
365		let evd, indu = Evd.fresh_inductive_instance env0 evd ind in
366		(evd, (indu,dep,interp_elimination_sort sort) :: l))
367		lnamedepindsort (Evd.from_env env0,[])
	364	(fun (_,dep,ind,sort) (evd, l, inst) ->
	365	let evd, indu, inst =
	366	match inst with
	367	\| None ->
	368	let _, ctx = Global.type_of_global_in_context env0 (IndRef ind) in
	369	let ctxs = Univ.ContextSet.of_context ctx in
	370	let evd = Evd.from_ctx (Evd.evar_universe_context_of ctxs) in
	371	let u = Univ.UContext.instance ctx in
	372	evd, (ind,u), Some u
	373	\| Some ui -> evd, (ind, ui), inst
	374	in
	375	(evd, (indu,dep,interp_elimination_sort sort) :: l, inst))
	376	lnamedepindsort (Evd.from_env env0,[],None)
368	377	in
369	378	let sigma, listdecl = Indrec.build_mutual_induction_scheme env0 sigma lrecspec in
370	379	let declare decl fi lrecref =

+1

-1

toplevel/indschemes.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/locality.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/locality.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/metasyntax.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/metasyntax.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/mltop.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/mltop.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+27

-16

toplevel/obligations.ml less more

317	317	prg_notations : notations ;
318	318	prg_kind : definition_kind;
319	319	prg_reduce : constr -> constr;
320		prg_hook : unit Lemmas.declaration_hook;
	320	prg_hook : (Evd.evar_universe_context -> unit) Lemmas.declaration_hook;
321	321	prg_opaque : bool;
	322	prg_sign: named_context_val;
322	323	}
323	324
324	325	type program_info = program_info_aux Ephemeron.key

516	517	progmap_remove prg;
517	518	!declare_definition_ref prg.prg_name
518	519	prg.prg_kind ce prg.prg_implicits
519		(Lemmas.mk_hook (fun l r -> Lemmas.call_hook fix_exn prg.prg_hook l r; r))
	520	(Lemmas.mk_hook (fun l r -> Lemmas.call_hook fix_exn prg.prg_hook l r prg.prg_ctx; r))
520	521
521	522	open Pp
522	523

581	582	in
582	583	(* Declare the recursive definitions *)
583	584	let ctx = Evd.evar_context_universe_context first.prg_ctx in
	585	let fix_exn = Stm.get_fix_exn () in
584	586	let kns = List.map4 (!declare_fix_ref ~opaque (local, poly, kind) ctx)
585	587	fixnames fixdecls fixtypes fiximps in
586	588	(* Declare notations *)

588	590	Declare.recursive_message (fixkind != IsCoFixpoint) indexes fixnames;
589	591	let gr = List.hd kns in
590	592	let kn = match gr with ConstRef kn -> kn \| _ -> assert false in
591		Lemmas.call_hook (fun exn -> exn) first.prg_hook local gr;
592		List.iter progmap_remove l; kn
	593	Lemmas.call_hook fix_exn first.prg_hook local gr first.prg_ctx;
	594	List.iter progmap_remove l; kn
593	595
594	596	let shrink_body c =
595	597	let ctx, b = decompose_lam c in

641	643	else
642	644	Some (TermObl (it_mkLambda_or_LetIn (mkApp (mkConst constant, args)) ctx)) }
643	645
644		let init_prog_info ?(opaque = false) n b t ctx deps fixkind notations obls impls kind reduce hook =
	646	let init_prog_info ?(opaque = false) sign n b t ctx deps fixkind notations obls impls kind reduce hook =
645	647	let obls', b =
646	648	match b with
647	649	\| None ->

665	667	prg_obligations = (obls', Array.length obls');
666	668	prg_deps = deps; prg_fixkind = fixkind ; prg_notations = notations ;
667	669	prg_implicits = impls; prg_kind = kind; prg_reduce = reduce;
668		prg_hook = hook;
669		prg_opaque = opaque; }
	670	prg_hook = hook; prg_opaque = opaque;
	671	prg_sign = sign }
670	672
671	673	let map_cardinal m =
672	674	let i = ref 0 in

821	823	if not (pi2 prg.prg_kind) (* Not polymorphic *) then
822	824	(* The universe context was declared globally, we continue
823	825	from the new global environment. *)
824		Evd.evar_universe_context (Evd.from_env (Global.env ()))
	826	let evd = Evd.from_env (Global.env ()) in
	827	let ctx' = Evd.merge_universe_subst evd (Evd.universe_subst (Evd.from_ctx ctx')) in
	828	Evd.evar_universe_context ctx'
825	829	else ctx'
826	830	in
827	831	let prg = { prg with prg_ctx = ctx' } in

852	856	let obl = subst_deps_obl obls obl in
853	857	let kind = kind_of_obligation (pi2 prg.prg_kind) obl.obl_status in
854	858	let evd = Evd.from_ctx prg.prg_ctx in
	859	let evd = Evd.update_sigma_env evd (Global.env ()) in
855	860	let auto n tac oblset = auto_solve_obligations n ~oblset tac in
856	861	let hook ctx = Lemmas.mk_hook (obligation_hook prg obl num auto ctx) in
857		let () = Lemmas.start_proof_univs obl.obl_name kind evd obl.obl_type hook in
	862	let () = Lemmas.start_proof_univs ~sign:prg.prg_sign obl.obl_name kind evd obl.obl_type hook in
858	863	let () = trace (str "Started obligation " ++ int user_num ++ str " proof: " ++
859	864	Printer.pr_constr_env (Global.env ()) Evd.empty obl.obl_type) in
860	865	let _ = Pfedit.by (snd (get_default_tactic ())) in

888	893	\| Some t -> t
889	894	\| None -> snd (get_default_tactic ())
890	895	in
	896	let evd = Evd.from_ctx !prg.prg_ctx in
	897	let evd = Evd.update_sigma_env evd (Global.env ()) in
891	898	let t, ty, ctx =
892	899	solve_by_tac obl.obl_name (evar_of_obligation obl) tac
893		(pi2 !prg.prg_kind) !prg.prg_ctx
	900	(pi2 !prg.prg_kind) (Evd.evar_universe_context evd)
894	901	in
895	902	let uctx = Evd.evar_context_universe_context ctx in
896	903	let () = prg := {!prg with prg_ctx = ctx} in
897	904	let def, obl' = declare_obligation !prg obl t ty uctx in
898	905	obls.(i) <- obl';
899	906	if def && not (pi2 !prg.prg_kind) then (
900		(* Declare the term constraints with the first obligation only *)
901		let ctx' = Evd.evar_universe_context (Evd.from_env (Global.env ())) in
	907	(* Declare the term constraints with the first obligation only *)
	908	let evd = Evd.from_env (Global.env ()) in
	909	let evd = Evd.merge_universe_subst evd (Evd.universe_subst (Evd.from_ctx ctx)) in
	910	let ctx' = Evd.evar_universe_context evd in
902	911	prg := {!prg with prg_ctx = ctx'});
903	912	true
904	913	else false

986	995	++ Printer.pr_constr_env (Global.env ()) Evd.empty prg.prg_body)
987	996
988	997	let add_definition n ?term t ctx ?(implicits=[]) ?(kind=Global,false,Definition) ?tactic
989		?(reduce=reduce) ?(hook=Lemmas.mk_hook (fun _ _ -> ())) ?(opaque = false) obls =
	998	?(reduce=reduce) ?(hook=Lemmas.mk_hook (fun _ _ _ -> ())) ?(opaque = false) obls =
	999	let sign = Decls.initialize_named_context_for_proof () in
990	1000	let info = str (Id.to_string n) ++ str " has type-checked" in
991		let prg = init_prog_info ~opaque n term t ctx [] None [] obls implicits kind reduce hook in
	1001	let prg = init_prog_info sign ~opaque n term t ctx [] None [] obls implicits kind reduce hook in
992	1002	let obls,_ = prg.prg_obligations in
993	1003	if Int.equal (Array.length obls) 0 then (
994	1004	Flags.if_verbose msg_info (info ++ str ".");

1004	1014	\| _ -> res)
1005	1015
1006	1016	let add_mutual_definitions l ctx ?tactic ?(kind=Global,false,Definition) ?(reduce=reduce)
1007		?(hook=Lemmas.mk_hook (fun _ _ -> ())) ?(opaque = false) notations fixkind =
	1017	?(hook=Lemmas.mk_hook (fun _ _ _ -> ())) ?(opaque = false) notations fixkind =
	1018	let sign = Decls.initialize_named_context_for_proof () in
1008	1019	let deps = List.map (fun (n, b, t, imps, obls) -> n) l in
1009	1020	List.iter
1010	1021	(fun (n, b, t, imps, obls) ->
1011		let prg = init_prog_info ~opaque n (Some b) t ctx deps (Some fixkind)
	1022	let prg = init_prog_info sign ~opaque n (Some b) t ctx deps (Some fixkind)
1012	1023	notations obls imps kind reduce hook
1013	1024	in progmap_add n (Ephemeron.create prg)) l;
1014	1025	let _defined =

+3

-3

toplevel/obligations.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

67	67	?kind:Decl_kinds.definition_kind ->
68	68	?tactic:unit Proofview.tactic ->
69	69	?reduce:(Term.constr -> Term.constr) ->
70		?hook:unit Lemmas.declaration_hook -> ?opaque:bool -> obligation_info -> progress
	70	?hook:(Evd.evar_universe_context -> unit) Lemmas.declaration_hook -> ?opaque:bool -> obligation_info -> progress
71	71
72	72	type notations =
73	73	(Vernacexpr.lstring * Constrexpr.constr_expr * Notation_term.scope_name option) list

83	83	?tactic:unit Proofview.tactic ->
84	84	?kind:Decl_kinds.definition_kind ->
85	85	?reduce:(Term.constr -> Term.constr) ->
86		?hook:unit Lemmas.declaration_hook -> ?opaque:bool ->
	86	?hook:(Evd.evar_universe_context -> unit) Lemmas.declaration_hook -> ?opaque:bool ->
87	87	notations ->
88	88	fixpoint_kind -> unit
89	89

+1

-1

toplevel/record.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/record.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/search.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/search.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+4

-1

toplevel/usage.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

72	72	\n -impredicative-set set sort Set impredicative\
73	73	\n -indices-matter levels of indices (and nonuniform parameters) contribute to the level of inductives\
74	74	\n -type-in-type disable universe consistency checking\
	75	\n -xml export XML files either to the hierarchy rooted in\
	76	\n the directory $COQ_XML_LIBRARY_ROOT (if set) or to\
	77	\n stdout (if unset)\
75	78	\n -time display the time taken by each command\
76	79	\n -m, --memory display total heap size at program exit\
77	80	\n (use environment variable\

+1

-1

toplevel/usage.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+7

-1

toplevel/vernac.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

276	276
277	277	let eval_expr loc_ast = vernac_com (Flags.is_verbose()) checknav loc_ast
278	278
	279	(* XML output hooks *)
	280	let (f_xml_start_library, xml_start_library) = Hook.make ~default:ignore ()
	281	let (f_xml_end_library, xml_end_library) = Hook.make ~default:ignore ()
	282
279	283	(* Load a vernac file. Errors are annotated with file and location *)
280	284	let load_vernac verb file =
281	285	chan_beautify :=

310	314	Aux_file.start_aux_file_for long_f_dot_v;
311	315	Dumpglob.start_dump_glob long_f_dot_v;
312	316	Dumpglob.dump_string ("F" ^ Names.DirPath.to_string ldir ^ "\n");
	317	if !Flags.xml_export then Hook.get f_xml_start_library ();
313	318	let wall_clock1 = Unix.gettimeofday () in
314	319	let _ = load_vernac verbosely long_f_dot_v in
315	320	Stm.join ();

319	324	Aux_file.record_in_aux_at Loc.ghost "vo_compile_time"
320	325	(Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1));
321	326	Aux_file.stop_aux_file ();
	327	if !Flags.xml_export then Hook.get f_xml_end_library ();
322	328	Dumpglob.end_dump_glob ()
323	329	\| BuildVio ->
324	330	let long_f_dot_v = ensure_v f in

+5

-1

toplevel/vernac.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

22	22
23	23	val eval_expr : Loc.t * Vernacexpr.vernac_expr -> unit
24	24
	25	(** Set XML hooks *)
	26	val xml_start_library : (unit -> unit) Hook.t
	27	val xml_end_library : (unit -> unit) Hook.t
	28
25	29	(** Load a vernac file, verbosely or not. Errors are annotated with file
26	30	and location *)
27	31

+10

-11

toplevel/vernacentries.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

353	353	let reraise = Errors.push reraise in
354	354	close ();
355	355	iraise reraise
356
357		let dump_universes sorted s =
358		let g = Global.universes () in
359		let g = if sorted then Univ.sort_universes g else g in
360		dump_universes_gen g s
361	356
362	357	(*********************)
363	358	(* "Locate" commands *)

1622	1617	\| PrintCoercionPaths (cls,clt) ->
1623	1618	msg_notice (Prettyp.print_path_between (cl_of_qualid cls) (cl_of_qualid clt))
1624	1619	\| PrintCanonicalConversions -> msg_notice (Prettyp.print_canonical_projections ())
1625		\| PrintUniverses (b, None) ->
	1620	\| PrintUniverses (b, dst) ->
1626	1621	let univ = Global.universes () in
1627	1622	let univ = if b then Univ.sort_universes univ else univ in
1628	1623	let pr_remaining =
1629	1624	if Global.is_joined_environment () then mt ()
1630	1625	else str"There may remain asynchronous universe constraints"
1631	1626	in
1632		msg_notice (Univ.pr_universes Universes.pr_with_global_universes univ ++ pr_remaining)
1633		\| PrintUniverses (b, Some s) -> dump_universes b s
	1627	begin match dst with
	1628	\| None -> msg_notice (Univ.pr_universes Universes.pr_with_global_universes univ ++ pr_remaining)
	1629	\| Some s -> dump_universes_gen univ s
	1630	end
1634	1631	\| PrintHint r -> msg_notice (Hints.pr_hint_ref (smart_global r))
1635	1632	\| PrintHintGoal -> msg_notice (Hints.pr_applicable_hint ())
1636	1633	\| PrintHintDbName s -> msg_notice (Hints.pr_hint_db_by_name s)

2050	2047
2051	2048	let enforce_polymorphism = function
2052	2049	\| None -> Flags.is_universe_polymorphism ()
2053		\| Some b -> b
	2050	\| Some b -> Flags.make_polymorphic_flag b; b
2054	2051
2055	2052	(** A global default timeout, controled by option "Set Default Timeout n".
2056	2053	Use "Unset Default Timeout" to deactivate it (or set it to 0). *)

2151	2148	then Flags.verbosely (interp ?proof ~loc locality poly) c
2152	2149	else Flags.silently (interp ?proof ~loc locality poly) c;
2153	2150	if orig_program_mode \|\| not !Flags.program_mode \|\| isprogcmd then
2154		Flags.program_mode := orig_program_mode
	2151	Flags.program_mode := orig_program_mode;
	2152	ignore (Flags.use_polymorphic_flag ())
2155	2153	end
2156	2154	with
2157	2155	\| reraise when

2163	2161	let e = locate_if_not_already loc e in
2164	2162	let () = restore_timeout () in
2165	2163	Flags.program_mode := orig_program_mode;
	2164	ignore (Flags.use_polymorphic_flag ());
2166	2165	iraise e
2167	2166	and aux_list ?locality ?polymorphism isprogcmd l =
2168	2167	List.iter (aux false) (List.map snd l)

+1

-1

toplevel/vernacentries.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/vernacinterp.ml less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)

+1

-1

toplevel/vernacinterp.mli less more

0	0	(************************************************************************)
1	1	(* v * The Coq Proof Assistant / The Coq Development Team *)
2		(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
	2	(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
3	3	(* \VV/ **************************************************************)
4	4	(* // * This file is distributed under the terms of the *)
5	5	(* * GNU Lesser General Public License Version 2.1 *)