summaryrefslogtreecommitdiff
path: root/plugins
diff options
context:
space:
mode:
authorGravatar Enrico Tassi <gareuselesinge@debian.org>2016-01-26 16:56:33 +0100
committerGravatar Enrico Tassi <gareuselesinge@debian.org>2016-01-26 16:56:33 +0100
commit164c6861860e6b52818c031f901ffeff91fca16a (patch)
tree4f91d20c890c25915e7b28226c663b94a8cfb0d3 /plugins
parent91dbeab8eef959c3f64960909ca69d4e68c8198d (diff)
Imported Upstream version 8.5upstream/8.5
Diffstat (limited to 'plugins')
-rw-r--r--plugins/btauto/g_btauto.ml42
-rw-r--r--plugins/cc/ccalgo.ml2
-rw-r--r--plugins/cc/ccalgo.mli8
-rw-r--r--plugins/cc/ccproof.ml2
-rw-r--r--plugins/cc/ccproof.mli2
-rw-r--r--plugins/cc/cctac.ml6
-rw-r--r--plugins/cc/g_congruence.ml42
-rw-r--r--plugins/decl_mode/decl_expr.mli2
-rw-r--r--plugins/decl_mode/decl_interp.ml2
-rw-r--r--plugins/decl_mode/decl_interp.mli2
-rw-r--r--plugins/decl_mode/decl_mode.ml2
-rw-r--r--plugins/decl_mode/decl_mode.mli2
-rw-r--r--plugins/decl_mode/decl_proof_instr.ml2
-rw-r--r--plugins/decl_mode/decl_proof_instr.mli2
-rw-r--r--plugins/decl_mode/g_decl_mode.ml42
-rw-r--r--plugins/decl_mode/ppdecl_proof.ml2
-rw-r--r--plugins/derive/derive.ml2
-rw-r--r--plugins/derive/derive.mli2
-rw-r--r--plugins/derive/g_derive.ml42
-rw-r--r--plugins/extraction/ExtrOcamlBasic.v2
-rw-r--r--plugins/extraction/ExtrOcamlBigIntConv.v2
-rw-r--r--plugins/extraction/ExtrOcamlIntConv.v2
-rw-r--r--plugins/extraction/ExtrOcamlNatBigInt.v2
-rw-r--r--plugins/extraction/ExtrOcamlNatInt.v2
-rw-r--r--plugins/extraction/ExtrOcamlString.v2
-rw-r--r--plugins/extraction/ExtrOcamlZBigInt.v2
-rw-r--r--plugins/extraction/ExtrOcamlZInt.v2
-rw-r--r--plugins/extraction/big.ml2
-rw-r--r--plugins/extraction/common.ml7
-rw-r--r--plugins/extraction/common.mli2
-rw-r--r--plugins/extraction/extract_env.ml138
-rw-r--r--plugins/extraction/extract_env.mli2
-rw-r--r--plugins/extraction/extraction.ml176
-rw-r--r--plugins/extraction/extraction.mli2
-rw-r--r--plugins/extraction/g_extraction.ml42
-rw-r--r--plugins/extraction/haskell.ml89
-rw-r--r--plugins/extraction/haskell.mli2
-rw-r--r--plugins/extraction/json.ml2
-rw-r--r--plugins/extraction/miniml.mli17
-rw-r--r--plugins/extraction/mlutil.ml243
-rw-r--r--plugins/extraction/mlutil.mli9
-rw-r--r--plugins/extraction/modutil.ml50
-rw-r--r--plugins/extraction/modutil.mli2
-rw-r--r--plugins/extraction/ocaml.ml169
-rw-r--r--plugins/extraction/ocaml.mli2
-rw-r--r--plugins/extraction/scheme.ml7
-rw-r--r--plugins/extraction/scheme.mli2
-rw-r--r--plugins/extraction/table.ml121
-rw-r--r--plugins/extraction/table.mli29
-rw-r--r--plugins/firstorder/formula.ml2
-rw-r--r--plugins/firstorder/formula.mli2
-rw-r--r--plugins/firstorder/g_ground.ml42
-rw-r--r--plugins/firstorder/ground.ml2
-rw-r--r--plugins/firstorder/ground.mli2
-rw-r--r--plugins/firstorder/instances.ml2
-rw-r--r--plugins/firstorder/instances.mli2
-rw-r--r--plugins/firstorder/rules.ml2
-rw-r--r--plugins/firstorder/rules.mli2
-rw-r--r--plugins/firstorder/sequent.ml2
-rw-r--r--plugins/firstorder/sequent.mli4
-rw-r--r--plugins/firstorder/unify.ml2
-rw-r--r--plugins/firstorder/unify.mli2
-rw-r--r--plugins/fourier/Fourier.v2
-rw-r--r--plugins/fourier/Fourier_util.v2
-rw-r--r--plugins/fourier/fourier.ml2
-rw-r--r--plugins/fourier/fourierR.ml2
-rw-r--r--plugins/fourier/g_fourier.ml42
-rw-r--r--plugins/funind/Recdef.v2
-rw-r--r--plugins/funind/functional_principles_proofs.mli2
-rw-r--r--plugins/funind/functional_principles_types.mli2
-rw-r--r--plugins/funind/g_indfun.ml42
-rw-r--r--plugins/funind/glob_term_to_relation.ml2
-rw-r--r--plugins/funind/invfun.ml2
-rw-r--r--plugins/funind/merge.ml2
-rw-r--r--plugins/funind/recdef.ml14
-rw-r--r--plugins/micromega/Env.v2
-rw-r--r--plugins/micromega/EnvRing.v2
-rw-r--r--plugins/micromega/Lia.v2
-rw-r--r--plugins/micromega/MExtraction.v2
-rw-r--r--plugins/micromega/OrderedRing.v2
-rw-r--r--plugins/micromega/Psatz.v2
-rw-r--r--plugins/micromega/QMicromega.v2
-rw-r--r--plugins/micromega/RMicromega.v2
-rw-r--r--plugins/micromega/Refl.v2
-rw-r--r--plugins/micromega/RingMicromega.v2
-rw-r--r--plugins/micromega/Tauto.v2
-rw-r--r--plugins/micromega/VarMap.v2
-rw-r--r--plugins/micromega/ZCoeff.v2
-rw-r--r--plugins/micromega/ZMicromega.v2
-rw-r--r--plugins/micromega/certificate.ml2
-rw-r--r--plugins/micromega/coq_micromega.ml2
-rw-r--r--plugins/micromega/csdpcert.ml2
-rw-r--r--plugins/micromega/g_micromega.ml42
-rw-r--r--plugins/micromega/mutils.ml2
-rw-r--r--plugins/micromega/persistent_cache.ml2
-rw-r--r--plugins/micromega/polynomial.ml2
-rw-r--r--plugins/micromega/sos.mli2
-rw-r--r--plugins/micromega/sos_types.ml2
-rw-r--r--plugins/nsatz/Nsatz.v2
-rw-r--r--plugins/nsatz/ideal.ml2
-rw-r--r--plugins/nsatz/nsatz.ml42
-rw-r--r--plugins/nsatz/polynom.ml2
-rw-r--r--plugins/nsatz/polynom.mli2
-rw-r--r--plugins/omega/Omega.v2
-rw-r--r--plugins/omega/OmegaPlugin.v2
-rw-r--r--plugins/omega/OmegaTactic.v2
-rw-r--r--plugins/omega/PreOmega.v2
-rw-r--r--plugins/omega/coq_omega.ml2
-rw-r--r--plugins/omega/g_omega.ml42
-rw-r--r--plugins/omega/omega.ml2
-rw-r--r--plugins/quote/Quote.v2
-rw-r--r--plugins/quote/g_quote.ml42
-rw-r--r--plugins/quote/quote.ml6
-rw-r--r--plugins/romega/refl_omega.ml8
-rw-r--r--plugins/rtauto/Bintree.v2
-rw-r--r--plugins/rtauto/Rtauto.v2
-rw-r--r--plugins/rtauto/g_rtauto.ml42
-rw-r--r--plugins/rtauto/proof_search.ml2
-rw-r--r--plugins/rtauto/proof_search.mli2
-rw-r--r--plugins/rtauto/refl_tauto.ml2
-rw-r--r--plugins/rtauto/refl_tauto.mli2
-rw-r--r--plugins/setoid_ring/ArithRing.v2
-rw-r--r--plugins/setoid_ring/BinList.v2
-rw-r--r--plugins/setoid_ring/Cring.v2
-rw-r--r--plugins/setoid_ring/Field.v2
-rw-r--r--plugins/setoid_ring/Field_tac.v2
-rw-r--r--plugins/setoid_ring/Field_theory.v2
-rw-r--r--plugins/setoid_ring/InitialRing.v8
-rw-r--r--plugins/setoid_ring/NArithRing.v2
-rw-r--r--plugins/setoid_ring/Ncring.v2
-rw-r--r--plugins/setoid_ring/Ncring_initial.v6
-rw-r--r--plugins/setoid_ring/Ncring_polynom.v2
-rw-r--r--plugins/setoid_ring/Ncring_tac.v2
-rw-r--r--plugins/setoid_ring/Ring.v2
-rw-r--r--plugins/setoid_ring/Ring_base.v2
-rw-r--r--plugins/setoid_ring/Ring_polynom.v2
-rw-r--r--plugins/setoid_ring/Ring_theory.v2
-rw-r--r--plugins/setoid_ring/ZArithRing.v2
-rw-r--r--plugins/setoid_ring/newring.ml42
-rw-r--r--plugins/syntax/nat_syntax.ml2
-rw-r--r--plugins/syntax/numbers_syntax.ml2
-rw-r--r--plugins/syntax/r_syntax.ml2
-rw-r--r--plugins/syntax/z_syntax.ml2
-rw-r--r--plugins/xml/README19
144 files changed, 757 insertions, 623 deletions
diff --git a/plugins/btauto/g_btauto.ml4 b/plugins/btauto/g_btauto.ml4
index 8e00b1c1..f3e2c99f 100644
--- a/plugins/btauto/g_btauto.ml4
+++ b/plugins/btauto/g_btauto.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index 97ea5fdc..bc3d9ed5 100644
--- a/plugins/cc/ccalgo.ml
+++ b/plugins/cc/ccalgo.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/ccalgo.mli b/plugins/cc/ccalgo.mli
index 0dcf3a87..b73c8eef 100644
--- a/plugins/cc/ccalgo.mli
+++ b/plugins/cc/ccalgo.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -20,8 +20,8 @@ type pa_fun=
fnargs:int}
-module PafMap : Map.S with type key = pa_fun
-module PacMap : Map.S with type key = pa_constructor
+module PafMap : CSig.MapS with type key = pa_fun
+module PacMap : CSig.MapS with type key = pa_constructor
type cinfo =
{ci_constr: pconstructor; (* inductive type *)
@@ -185,7 +185,7 @@ val empty_forest: unit -> forest
(*type pa_constructor
-module PacMap:Map.S with type key=pa_constructor
+module PacMap:CSig.MapS with type key=pa_constructor
type term =
Symb of Term.constr
diff --git a/plugins/cc/ccproof.ml b/plugins/cc/ccproof.ml
index 42c03234..c188bf3b 100644
--- a/plugins/cc/ccproof.ml
+++ b/plugins/cc/ccproof.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/ccproof.mli b/plugins/cc/ccproof.mli
index 2ff2bd38..eacbfeac 100644
--- a/plugins/cc/ccproof.mli
+++ b/plugins/cc/ccproof.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index 068cb25c..0baa5337 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -501,9 +501,9 @@ let f_equal =
let concl = Proofview.Goal.concl gl in
let cut_eq c1 c2 =
try (* type_of can raise an exception *)
- Tacticals.New.tclTHEN
+ Tacticals.New.tclTHENS
(mk_eq _eq c1 c2 Tactics.cut)
- (Tacticals.New.tclTRY ((new_app_global _refl_equal [||]) apply))
+ [Proofview.tclUNIT ();Tacticals.New.tclTRY ((new_app_global _refl_equal [||]) apply)]
with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e
in
Proofview.tclORELSE
diff --git a/plugins/cc/g_congruence.ml4 b/plugins/cc/g_congruence.ml4
index aa31c6f0..5dbc340c 100644
--- a/plugins/cc/g_congruence.ml4
+++ b/plugins/cc/g_congruence.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_expr.mli b/plugins/decl_mode/decl_expr.mli
index 3c4cacbc..79ef3d18 100644
--- a/plugins/decl_mode/decl_expr.mli
+++ b/plugins/decl_mode/decl_expr.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_interp.ml b/plugins/decl_mode/decl_interp.ml
index 1c56586c..2a44dca2 100644
--- a/plugins/decl_mode/decl_interp.ml
+++ b/plugins/decl_mode/decl_interp.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_interp.mli b/plugins/decl_mode/decl_interp.mli
index b3d6f82b..4303ecdb 100644
--- a/plugins/decl_mode/decl_interp.mli
+++ b/plugins/decl_mode/decl_interp.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_mode.ml b/plugins/decl_mode/decl_mode.ml
index 774c20c9..acee3d6c 100644
--- a/plugins/decl_mode/decl_mode.ml
+++ b/plugins/decl_mode/decl_mode.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_mode.mli b/plugins/decl_mode/decl_mode.mli
index fd7e15c1..dfeee833 100644
--- a/plugins/decl_mode/decl_mode.mli
+++ b/plugins/decl_mode/decl_mode.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_proof_instr.ml b/plugins/decl_mode/decl_proof_instr.ml
index 1a908064..ba9fb728 100644
--- a/plugins/decl_mode/decl_proof_instr.ml
+++ b/plugins/decl_mode/decl_proof_instr.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/decl_proof_instr.mli b/plugins/decl_mode/decl_proof_instr.mli
index f86bfea7..325969da 100644
--- a/plugins/decl_mode/decl_proof_instr.mli
+++ b/plugins/decl_mode/decl_proof_instr.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/g_decl_mode.ml4 b/plugins/decl_mode/g_decl_mode.ml4
index d598e7c3..b62cfd6a 100644
--- a/plugins/decl_mode/g_decl_mode.ml4
+++ b/plugins/decl_mode/g_decl_mode.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/decl_mode/ppdecl_proof.ml b/plugins/decl_mode/ppdecl_proof.ml
index b3198dbf..4c71f041 100644
--- a/plugins/decl_mode/ppdecl_proof.ml
+++ b/plugins/decl_mode/ppdecl_proof.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/derive/derive.ml b/plugins/derive/derive.ml
index d6c29283..ce93c5a3 100644
--- a/plugins/derive/derive.ml
+++ b/plugins/derive/derive.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/derive/derive.mli b/plugins/derive/derive.mli
index b49ef6b9..9ea876f1 100644
--- a/plugins/derive/derive.mli
+++ b/plugins/derive/derive.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/derive/g_derive.ml4 b/plugins/derive/g_derive.ml4
index c031e3bc..18570a68 100644
--- a/plugins/derive/g_derive.ml4
+++ b/plugins/derive/g_derive.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlBasic.v b/plugins/extraction/ExtrOcamlBasic.v
index 9dbda821..d9b000c2 100644
--- a/plugins/extraction/ExtrOcamlBasic.v
+++ b/plugins/extraction/ExtrOcamlBasic.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlBigIntConv.v b/plugins/extraction/ExtrOcamlBigIntConv.v
index 4cc76d86..c42938c8 100644
--- a/plugins/extraction/ExtrOcamlBigIntConv.v
+++ b/plugins/extraction/ExtrOcamlBigIntConv.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlIntConv.v b/plugins/extraction/ExtrOcamlIntConv.v
index eb43d69f..515fa52d 100644
--- a/plugins/extraction/ExtrOcamlIntConv.v
+++ b/plugins/extraction/ExtrOcamlIntConv.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlNatBigInt.v b/plugins/extraction/ExtrOcamlNatBigInt.v
index 1386c2ad..3149e702 100644
--- a/plugins/extraction/ExtrOcamlNatBigInt.v
+++ b/plugins/extraction/ExtrOcamlNatBigInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlNatInt.v b/plugins/extraction/ExtrOcamlNatInt.v
index a0930f15..7c607f7a 100644
--- a/plugins/extraction/ExtrOcamlNatInt.v
+++ b/plugins/extraction/ExtrOcamlNatInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlString.v b/plugins/extraction/ExtrOcamlString.v
index ce8025bf..6af591ee 100644
--- a/plugins/extraction/ExtrOcamlString.v
+++ b/plugins/extraction/ExtrOcamlString.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlZBigInt.v b/plugins/extraction/ExtrOcamlZBigInt.v
index 3d59669a..9a1a4aa0 100644
--- a/plugins/extraction/ExtrOcamlZBigInt.v
+++ b/plugins/extraction/ExtrOcamlZBigInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ExtrOcamlZInt.v b/plugins/extraction/ExtrOcamlZInt.v
index 79d67495..4d33174b 100644
--- a/plugins/extraction/ExtrOcamlZInt.v
+++ b/plugins/extraction/ExtrOcamlZInt.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/big.ml b/plugins/extraction/big.ml
index f2a965c9..44b81d76 100644
--- a/plugins/extraction/big.ml
+++ b/plugins/extraction/big.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/common.ml b/plugins/extraction/common.ml
index 97f85694..bb9e8e5f 100644
--- a/plugins/extraction/common.ml
+++ b/plugins/extraction/common.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -171,10 +171,7 @@ let push_vars ids (db,avoid) =
let ids',avoid' = rename_vars avoid ids in
ids', (ids' @ db, avoid')
-let get_db_name n (db,_) =
- let id = List.nth db (pred n) in
- if Id.equal id dummy_name then Id.of_string "__" else id
-
+let get_db_name n (db,_) = List.nth db (pred n)
(*S Renamings of global objects. *)
diff --git a/plugins/extraction/common.mli b/plugins/extraction/common.mli
index a8ab4fd3..2f560196 100644
--- a/plugins/extraction/common.mli
+++ b/plugins/extraction/common.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 0f846013..41a068ff 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -78,56 +78,51 @@ module type VISIT = sig
(* Add reference / ... in the visit lists.
These functions silently add the mp of their arg in the mp list *)
val add_ref : global_reference -> unit
+ val add_kn : kernel_name -> unit
val add_decl_deps : ml_decl -> unit
val add_spec_deps : ml_spec -> unit
(* Test functions:
is a particular object a needed dependency for the current extraction ? *)
val needed_ind : mutual_inductive -> bool
- val needed_con : constant -> bool
+ val needed_cst : constant -> bool
val needed_mp : module_path -> bool
val needed_mp_all : module_path -> bool
end
module Visit : VISIT = struct
type must_visit =
- { mutable ind : KNset.t; mutable con : KNset.t;
- mutable mp : MPset.t; mutable mp_all : MPset.t }
+ { mutable kn : KNset.t;
+ mutable mp : MPset.t;
+ mutable mp_all : MPset.t }
(* the imperative internal visit lists *)
- let v = { ind = KNset.empty ; con = KNset.empty ;
- mp = MPset.empty; mp_all = MPset.empty }
+ let v = { kn = KNset.empty; mp = MPset.empty; mp_all = MPset.empty }
(* the accessor functions *)
let reset () =
- v.ind <- KNset.empty;
- v.con <- KNset.empty;
+ v.kn <- KNset.empty;
v.mp <- MPset.empty;
v.mp_all <- MPset.empty
- let needed_ind i = KNset.mem (user_mind i) v.ind
- let needed_con c = KNset.mem (user_con c) v.con
+ let needed_ind i = KNset.mem (user_mind i) v.kn
+ let needed_cst c = KNset.mem (user_con c) v.kn
let needed_mp mp = MPset.mem mp v.mp || MPset.mem mp v.mp_all
let needed_mp_all mp = MPset.mem mp v.mp_all
let add_mp mp =
check_loaded_modfile mp; v.mp <- MPset.union (prefixes_mp mp) v.mp
let add_mp_all mp =
- check_loaded_modfile mp; v.mp <- MPset.union (prefixes_mp mp) v.mp;
+ check_loaded_modfile mp;
+ v.mp <- MPset.union (prefixes_mp mp) v.mp;
v.mp_all <- MPset.add mp v.mp_all
- let add_ind i =
- let kn = user_mind i in
- v.ind <- KNset.add kn v.ind; add_mp (modpath kn)
- let add_con c =
- let kn = user_con c in
- v.con <- KNset.add kn v.con; add_mp (modpath kn)
+ let add_kn kn = v.kn <- KNset.add kn v.kn; add_mp (modpath kn)
let add_ref = function
- | ConstRef c -> add_con c
- | IndRef (ind,_) | ConstructRef ((ind,_),_) -> add_ind ind
+ | ConstRef c -> add_kn (user_con c)
+ | IndRef (ind,_) | ConstructRef ((ind,_),_) -> add_kn (user_mind ind)
| VarRef _ -> assert false
let add_decl_deps = decl_iter_references add_ref add_ref add_ref
let add_spec_deps = spec_iter_references add_ref add_ref add_ref
end
let add_field_label mp = function
- | (lab, SFBconst _) -> Visit.add_ref (ConstRef (Constant.make2 mp lab))
- | (lab, SFBmind _) -> Visit.add_ref (IndRef (MutInd.make2 mp lab, 0))
+ | (lab, (SFBconst _|SFBmind _)) -> Visit.add_kn (KerName.make2 mp lab)
| (lab, (SFBmodule _|SFBmodtype _)) -> Visit.add_mp_all (MPdot (mp,lab))
let rec add_labels mp = function
@@ -182,8 +177,7 @@ let factor_fix env l cb msb =
let expand_mexpr env mp me =
let inl = Some (Flags.get_inline_level()) in
- let sign,_,_,_ = Mod_typing.translate_mse env (Some mp) inl me in
- sign
+ Mod_typing.translate_mse env (Some mp) inl me
(** Ad-hoc update of environment, inspired by [Mod_type.check_with_aux_def].
To check with Elie. *)
@@ -193,45 +187,52 @@ let rec mp_of_mexpr = function
| MEwith (seb,_) -> mp_of_mexpr seb
| _ -> assert false
+let no_delta = Mod_subst.empty_delta_resolver
+
let env_for_mtb_with_def env mp me idl =
let struc = Modops.destr_nofunctor me in
let l = Label.of_id (List.hd idl) in
let spot = function (l',SFBconst _) -> Label.equal l l' | _ -> false in
let before = fst (List.split_when spot struc) in
- Modops.add_structure mp before empty_delta_resolver env
+ Modops.add_structure mp before no_delta env
+
+let make_cst resolver mp l =
+ Mod_subst.constant_of_delta_kn resolver (KerName.make2 mp l)
+
+let make_mind resolver mp l =
+ Mod_subst.mind_of_delta_kn resolver (KerName.make2 mp l)
(* From a [structure_body] (i.e. a list of [structure_field_body])
to specifications. *)
-let rec extract_structure_spec env mp = function
+let rec extract_structure_spec env mp reso = function
| [] -> []
| (l,SFBconst cb) :: msig ->
- let kn = Constant.make2 mp l in
- let s = extract_constant_spec env kn cb in
- let specs = extract_structure_spec env mp msig in
+ let c = make_cst reso mp l in
+ let s = extract_constant_spec env c cb in
+ let specs = extract_structure_spec env mp reso msig in
if logical_spec s then specs
else begin Visit.add_spec_deps s; (l,Spec s) :: specs end
| (l,SFBmind _) :: msig ->
- let mind = MutInd.make2 mp l in
+ let mind = make_mind reso mp l in
let s = Sind (mind, extract_inductive env mind) in
- let specs = extract_structure_spec env mp msig in
+ let specs = extract_structure_spec env mp reso msig in
if logical_spec s then specs
else begin Visit.add_spec_deps s; (l,Spec s) :: specs end
| (l,SFBmodule mb) :: msig ->
- let specs = extract_structure_spec env mp msig in
+ let specs = extract_structure_spec env mp reso msig in
let spec = extract_mbody_spec env mb.mod_mp mb in
(l,Smodule spec) :: specs
| (l,SFBmodtype mtb) :: msig ->
- let specs = extract_structure_spec env mp msig in
+ let specs = extract_structure_spec env mp reso msig in
let spec = extract_mbody_spec env mtb.mod_mp mtb in
(l,Smodtype spec) :: specs
(* From [module_expression] to specifications *)
-(* Invariant: the [me] given to [extract_mexpr_spec] should either come
- from a [mod_type] or [type_expr] field, or their [_alg] counterparts.
- This way, any encountered [MEident] should be a true module type.
-*)
+(* Invariant: the [me_alg] given to [extract_mexpr_spec] and
+ [extract_mexpression_spec] should come from a [mod_type_alg] field.
+ This way, any encountered [MEident] should be a true module type. *)
and extract_mexpr_spec env mp1 (me_struct,me_alg) = match me_alg with
| MEident mp -> Visit.add_mp_all mp; MTident mp
@@ -244,7 +245,9 @@ and extract_mexpr_spec env mp1 (me_struct,me_alg) = match me_alg with
| MEwith(me',WithMod(idl,mp))->
Visit.add_mp_all mp;
MTwith(extract_mexpr_spec env mp1 (me_struct,me'), ML_With_module(idl,mp))
- | MEapply _ -> extract_msignature_spec env mp1 me_struct
+ | MEapply _ ->
+ (* No higher-order module type in OCaml : we use the expanded version *)
+ extract_msignature_spec env mp1 no_delta (*TODO*) me_struct
and extract_mexpression_spec env mp1 (me_struct,me_alg) = match me_alg with
| MoreFunctor (mbid, mtb, me_alg') ->
@@ -258,19 +261,19 @@ and extract_mexpression_spec env mp1 (me_struct,me_alg) = match me_alg with
extract_mexpression_spec env' mp1 (me_struct',me_alg'))
| NoFunctor m -> extract_mexpr_spec env mp1 (me_struct,m)
-and extract_msignature_spec env mp1 = function
+and extract_msignature_spec env mp1 reso = function
| NoFunctor struc ->
- let env' = Modops.add_structure mp1 struc empty_delta_resolver env in
- MTsig (mp1, extract_structure_spec env' mp1 struc)
+ let env' = Modops.add_structure mp1 struc reso env in
+ MTsig (mp1, extract_structure_spec env' mp1 reso struc)
| MoreFunctor (mbid, mtb, me) ->
let mp = MPbound mbid in
let env' = Modops.add_module_type mp mtb env in
MTfunsig (mbid, extract_mbody_spec env mp mtb,
- extract_msignature_spec env' mp1 me)
+ extract_msignature_spec env' mp1 reso me)
and extract_mbody_spec env mp mb = match mb.mod_type_alg with
| Some ty -> extract_mexpression_spec env mp (mb.mod_type,ty)
- | None -> extract_msignature_spec env mp mb.mod_type
+ | None -> extract_msignature_spec env mp mb.mod_delta mb.mod_type
(* From a [structure_body] (i.e. a list of [structure_field_body])
to implementations.
@@ -279,31 +282,31 @@ and extract_mbody_spec env mp mb = match mb.mod_type_alg with
important: last to first ensures correct dependencies.
*)
-let rec extract_structure env mp ~all = function
+let rec extract_structure env mp reso ~all = function
| [] -> []
| (l,SFBconst cb) :: struc ->
(try
let vl,recd,struc = factor_fix env l cb struc in
- let vc = Array.map (Constant.make2 mp) vl in
- let ms = extract_structure env mp ~all struc in
- let b = Array.exists Visit.needed_con vc in
+ let vc = Array.map (make_cst reso mp) vl in
+ let ms = extract_structure env mp reso ~all struc in
+ let b = Array.exists Visit.needed_cst vc in
if all || b then
let d = extract_fixpoint env vc recd in
if (not b) && (logical_decl d) then ms
else begin Visit.add_decl_deps d; (l,SEdecl d) :: ms end
else ms
with Impossible ->
- let ms = extract_structure env mp ~all struc in
- let c = Constant.make2 mp l in
- let b = Visit.needed_con c in
+ let ms = extract_structure env mp reso ~all struc in
+ let c = make_cst reso mp l in
+ let b = Visit.needed_cst c in
if all || b then
let d = extract_constant env c cb in
if (not b) && (logical_decl d) then ms
else begin Visit.add_decl_deps d; (l,SEdecl d) :: ms end
else ms)
| (l,SFBmind mib) :: struc ->
- let ms = extract_structure env mp ~all struc in
- let mind = MutInd.make2 mp l in
+ let ms = extract_structure env mp reso ~all struc in
+ let mind = make_mind reso mp l in
let b = Visit.needed_ind mind in
if all || b then
let d = Dind (mind, extract_inductive env mind) in
@@ -311,14 +314,14 @@ let rec extract_structure env mp ~all = function
else begin Visit.add_decl_deps d; (l,SEdecl d) :: ms end
else ms
| (l,SFBmodule mb) :: struc ->
- let ms = extract_structure env mp ~all struc in
+ let ms = extract_structure env mp reso ~all struc in
let mp = MPdot (mp,l) in
let all' = all || Visit.needed_mp_all mp in
if all' || Visit.needed_mp mp then
(l,SEmodule (extract_module env mp ~all:all' mb)) :: ms
else ms
| (l,SFBmodtype mtb) :: struc ->
- let ms = extract_structure env mp ~all struc in
+ let ms = extract_structure env mp reso ~all struc in
let mp = MPdot (mp,l) in
if all || Visit.needed_mp mp then
(l,SEmodtype (extract_mbody_spec env mp mtb)) :: ms
@@ -332,7 +335,8 @@ and extract_mexpr env mp = function
(* In Haskell/Scheme, we expand everything.
For now, we also extract everything, dead code will be removed later
(see [Modutil.optimize_struct]. *)
- extract_msignature env mp ~all:true (expand_mexpr env mp me)
+ let sign,_,delta,_ = expand_mexpr env mp me in
+ extract_msignature env mp delta ~all:true sign
| MEident mp ->
if is_modfile mp && not (modular ()) then error_MPfile_as_mod mp false;
Visit.add_mp_all mp; Miniml.MEident mp
@@ -350,17 +354,17 @@ and extract_mexpression env mp = function
extract_mbody_spec env mp1 mtb,
extract_mexpression env' mp me)
-and extract_msignature env mp ~all = function
+and extract_msignature env mp reso ~all = function
| NoFunctor struc ->
- let env' = Modops.add_structure mp struc empty_delta_resolver env in
- Miniml.MEstruct (mp,extract_structure env' mp ~all struc)
+ let env' = Modops.add_structure mp struc reso env in
+ Miniml.MEstruct (mp,extract_structure env' mp reso ~all struc)
| MoreFunctor (mbid, mtb, me) ->
let mp1 = MPbound mbid in
let env' = Modops.add_module_type mp1 mtb env in
Miniml.MEfunctor
(mbid,
extract_mbody_spec env mp1 mtb,
- extract_msignature env' mp ~all me)
+ extract_msignature env' mp reso ~all me)
and extract_module env mp ~all mb =
(* A module has an empty [mod_expr] when :
@@ -376,8 +380,8 @@ and extract_module env mp ~all mb =
(* This module has a signature, otherwise it would be FullStruct.
We extract just the elements required by this signature. *)
let () = add_labels mp mb.mod_type in
- extract_msignature env mp ~all:false sign
- | FullStruct -> extract_msignature env mp ~all mb.mod_type
+ extract_msignature env mp mb.mod_delta ~all:false sign
+ | FullStruct -> extract_msignature env mp mb.mod_delta ~all mb.mod_type
in
(* Slight optimization: for modules without explicit signatures
([FullStruct] case), we build the type out of the extracted
@@ -399,7 +403,7 @@ let mono_environment refs mpl =
let l = List.rev (environment_until None) in
List.rev_map
(fun (mp,struc) ->
- mp, extract_structure env mp ~all:(Visit.needed_mp_all mp) struc)
+ mp, extract_structure env mp no_delta ~all:(Visit.needed_mp_all mp) struc)
l
(**************************************)
@@ -455,7 +459,7 @@ let print_one_decl struc mp decl =
push_visible mp [];
let ans = d.pp_decl decl in
pop_visible ();
- ans
+ v 0 ans
(*s Extraction of a ml struct to a file. *)
@@ -495,8 +499,8 @@ let print_structure_to_file (fn,si,mo) dry struc =
let d = descr () in
reset_renaming_tables AllButExternal;
let unsafe_needs = {
- mldummy = struct_ast_search ((==) MLdummy) struc;
- tdummy = struct_type_search Mlutil.isDummy struc;
+ mldummy = struct_ast_search Mlutil.isMLdummy struc;
+ tdummy = struct_type_search Mlutil.isTdummy struc;
tunknown = struct_type_search ((==) Tunknown) struc;
magic =
if lang () != Haskell then false
@@ -538,7 +542,7 @@ let print_structure_to_file (fn,si,mo) dry struc =
(if dry then None else si);
(* Print the buffer content via Coq standard formatter (ok with coqide). *)
if not (Int.equal (Buffer.length buf) 0) then begin
- Pp.msg_info (str (Buffer.contents buf));
+ Pp.msg_notice (str (Buffer.contents buf));
Buffer.reset buf
end
@@ -632,7 +636,7 @@ let simple_extraction r =
in
let ans = flag ++ print_one_decl struc (modpath_of_r r) d in
reset ();
- Pp.msg_info ans
+ Pp.msg_notice ans
| _ -> assert false
@@ -650,7 +654,7 @@ let extraction_library is_rec m =
let l = List.rev (environment_until (Some dir_m)) in
let select l (mp,struc) =
if Visit.needed_mp mp
- then (mp, extract_structure env mp true struc) :: l
+ then (mp, extract_structure env mp no_delta true struc) :: l
else l
in
let struc = List.fold_left select [] l in
diff --git a/plugins/extraction/extract_env.mli b/plugins/extraction/extract_env.mli
index e5fe76f5..90f4f911 100644
--- a/plugins/extraction/extract_env.mli
+++ b/plugins/extraction/extract_env.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index 6ae519ef..10644da2 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -91,7 +91,7 @@ exception NotDefault of kill_reason
let check_default env t =
match flag_of_type env t with
| _,TypeScheme -> raise (NotDefault Ktype)
- | Logic,_ -> raise (NotDefault Kother)
+ | Logic,_ -> raise (NotDefault Kprop)
| _ -> ()
let is_info_scheme env t = match flag_of_type env t with
@@ -103,7 +103,7 @@ let is_info_scheme env t = match flag_of_type env t with
let rec type_sign env c =
match kind_of_term (whd_betadeltaiota env none c) with
| Prod (n,t,d) ->
- (if is_info_scheme env t then Keep else Kill Kother)
+ (if is_info_scheme env t then Keep else Kill Kprop)
:: (type_sign (push_rel_assum (n,t) env) d)
| _ -> []
@@ -137,7 +137,7 @@ let rec type_sign_vl env c =
match kind_of_term (whd_betadeltaiota env none c) with
| Prod (n,t,d) ->
let s,vl = type_sign_vl (push_rel_assum (n,t) env) d in
- if not (is_info_scheme env t) then Kill Kother::s, vl
+ if not (is_info_scheme env t) then Kill Kprop::s, vl
else Keep::s, (make_typvar n vl) :: vl
| _ -> [],[]
@@ -154,25 +154,12 @@ let sign_with_implicits r s nb_params =
let implicits = implicits_of_global r in
let rec add_impl i = function
| [] -> []
- | sign::s ->
- let sign' =
- if sign == Keep && Int.List.mem i implicits
- then Kill Kother else sign
- in sign' :: add_impl (succ i) s
+ | Keep::s when Int.Set.mem i implicits ->
+ Kill (Kimplicit (r,i)) :: add_impl (i+1) s
+ | sign::s -> sign :: add_impl (i+1) s
in
add_impl (1+nb_params) s
-(* Enriching a exception message *)
-
-let rec handle_exn r n fn_name = function
- | MLexn s ->
- (try Scanf.sscanf s "UNBOUND %d%!"
- (fun i ->
- assert ((0 < i) && (i <= n));
- MLexn ("IMPLICIT "^ msg_non_implicit r (n+1-i) (fn_name i)))
- with Scanf.Scan_failure _ | End_of_file -> MLexn s)
- | a -> ast_map (handle_exn r n fn_name) a
-
(*S Management of type variable contexts. *)
(* A De Bruijn variable context (db) is a context for translating Coq [Rel]
@@ -214,36 +201,6 @@ let parse_ind_args si args relmax =
| _ -> parse (i+1) (j+1) s)
in parse 1 1 si
-let oib_equal o1 o2 =
- Id.equal o1.mind_typename o2.mind_typename &&
- List.equal eq_rel_declaration o1.mind_arity_ctxt o2.mind_arity_ctxt &&
- begin
- match o1.mind_arity, o2.mind_arity with
- | RegularArity {mind_user_arity=c1; mind_sort=s1}, RegularArity {mind_user_arity=c2; mind_sort=s2} ->
- eq_constr c1 c2 && Sorts.equal s1 s2
- | TemplateArity p1, TemplateArity p2 ->
- let eq o1 o2 = Option.equal Univ.Level.equal o1 o2 in
- List.equal eq p1.template_param_levels p2.template_param_levels &&
- Univ.Universe.equal p1.template_level p2.template_level
- | _, _ -> false
- end &&
- Array.equal Id.equal o1.mind_consnames o2.mind_consnames
-
-let eq_record x y =
- Option.equal (Option.equal (fun (_, x, y) (_, x', y') -> Array.for_all2 eq_constant x x')) x y
-
-let mib_equal m1 m2 =
- Array.equal oib_equal m1.mind_packets m1.mind_packets &&
- eq_record m1.mind_record m2.mind_record &&
- (m1.mind_finite : Decl_kinds.recursivity_kind) == m2.mind_finite &&
- Int.equal m1.mind_ntypes m2.mind_ntypes &&
- List.equal eq_named_declaration m1.mind_hyps m2.mind_hyps &&
- Int.equal m1.mind_nparams m2.mind_nparams &&
- Int.equal m1.mind_nparams_rec m2.mind_nparams_rec &&
- List.equal eq_rel_declaration m1.mind_params_ctxt m2.mind_params_ctxt &&
- (* Univ.UContext.eq *) m1.mind_universes == m2.mind_universes (** FIXME *)
- (* m1.mind_universes = m2.mind_universes *)
-
(*S Extraction of a type. *)
(* [extract_type env db c args] is used to produce an ML type from the
@@ -285,10 +242,10 @@ let rec extract_type env db j c args =
(match expand env mld with
| Tdummy d -> Tdummy d
| _ ->
- let reason = if lvl == TypeScheme then Ktype else Kother in
+ let reason = if lvl == TypeScheme then Ktype else Kprop in
Tarr (Tdummy reason, mld)))
| Sort _ -> Tdummy Ktype (* The two logical cases. *)
- | _ when sort_of env (applist (c, args)) == InProp -> Tdummy Kother
+ | _ when sort_of env (applist (c, args)) == InProp -> Tdummy Kprop
| Rel n ->
(match lookup_rel n env with
| (_,Some t,_) -> extract_type env db j (lift n t) args
@@ -373,14 +330,9 @@ and extract_type_scheme env db c p =
and extract_ind env kn = (* kn is supposed to be in long form *)
let mib = Environ.lookup_mind kn env in
- try
- (* For a same kn, we can get various bodies due to module substitutions.
- We hence check that the mib has not changed from recording
- time to retrieving time. Ideally we should also check the env. *)
- let (mib0,ml_ind) = lookup_ind kn in
- if not (mib_equal mib mib0) then raise Not_found;
- ml_ind
- with Not_found ->
+ match lookup_ind kn mib with
+ | Some ml_ind -> ml_ind
+ | None ->
(* First, if this inductive is aliased via a Module,
we process the original inductive if possible.
When at toplevel of the monolithic case, we cannot do much
@@ -458,7 +410,7 @@ and extract_ind env kn = (* kn is supposed to be in long form *)
if p.ip_logical then raise (I Standard);
if not (Int.equal (Array.length p.ip_types) 1) then raise (I Standard);
let typ = p.ip_types.(0) in
- let l = List.filter (fun t -> not (isDummy (expand env t))) typ in
+ let l = List.filter (fun t -> not (isTdummy (expand env t))) typ in
if not (keep_singleton ()) &&
Int.equal (List.length l) 1 && not (type_mem_kn kn (List.hd l))
then raise (I Singleton);
@@ -479,7 +431,7 @@ and extract_ind env kn = (* kn is supposed to be in long form *)
let mp = MutInd.modpath kn in
let rec select_fields l typs = match l,typs with
| [],[] -> []
- | _::l, typ::typs when isDummy (expand env typ) ->
+ | _::l, typ::typs when isTdummy (expand env typ) ->
select_fields l typs
| Anonymous::l, typ::typs ->
None :: (select_fields l typs)
@@ -536,28 +488,25 @@ and extract_type_cons env db dbmap c i =
(*s Recording the ML type abbreviation of a Coq type scheme constant. *)
and mlt_env env r = match r with
+ | IndRef _ | ConstructRef _ | VarRef _ -> None
| ConstRef kn ->
- (try
- if not (visible_con kn) then raise Not_found;
- match lookup_term kn with
- | Dtype (_,vl,mlt) -> Some mlt
+ let cb = Environ.lookup_constant kn env in
+ match cb.const_body with
+ | Undef _ | OpaqueDef _ -> None
+ | Def l_body ->
+ match lookup_typedef kn cb with
+ | Some _ as o -> o
+ | None ->
+ let typ = Typeops.type_of_constant_type env cb.const_type
+ (* FIXME not sure if we should instantiate univs here *) in
+ match flag_of_type env typ with
+ | Info,TypeScheme ->
+ let body = Mod_subst.force_constr l_body in
+ let s = type_sign env typ in
+ let db = db_from_sign s in
+ let t = extract_type_scheme env db body (List.length s)
+ in add_typedef kn cb t; Some t
| _ -> None
- with Not_found ->
- let cb = Environ.lookup_constant kn env in
- let typ = Typeops.type_of_constant_type env cb.const_type
- (* FIXME not sure if we should instantiate univs here *) in
- match cb.const_body with
- | Undef _ | OpaqueDef _ -> None
- | Def l_body ->
- (match flag_of_type env typ with
- | Info,TypeScheme ->
- let body = Mod_subst.force_constr l_body in
- let s,vl = type_sign_vl env typ in
- let db = db_from_sign s in
- let t = extract_type_scheme env db body (List.length s)
- in add_term kn (Dtype (r, vl, t)); Some t
- | _ -> None))
- | _ -> None
and expand env = type_expand (mlt_env env)
and type2signature env = type_to_signature (mlt_env env)
@@ -568,16 +517,18 @@ let type_expunge_from_sign env = type_expunge_from_sign (mlt_env env)
(*s Extraction of the type of a constant. *)
let record_constant_type env kn opt_typ =
- try
- if not (visible_con kn) then raise Not_found;
- lookup_type kn
- with Not_found ->
- let typ = match opt_typ with
- | None -> Typeops.type_of_constant_type env (lookup_constant kn env).const_type
- | Some typ -> typ
- in let mlt = extract_type env [] 1 typ []
- in let schema = (type_maxvar mlt, mlt)
- in add_type kn schema; schema
+ let cb = lookup_constant kn env in
+ match lookup_cst_type kn cb with
+ | Some schema -> schema
+ | None ->
+ let typ = match opt_typ with
+ | None -> Typeops.type_of_constant_type env cb.const_type
+ | Some typ -> typ
+ in
+ let mlt = extract_type env [] 1 typ [] in
+ let schema = (type_maxvar mlt, mlt) in
+ let () = add_cst_type kn cb schema in
+ schema
(*S Extraction of a term. *)
@@ -655,7 +606,7 @@ and extract_maybe_term env mle mlt c =
try check_default env (type_of env c);
extract_term env mle mlt c []
with NotDefault d ->
- put_magic (mlt, Tdummy d) MLdummy
+ put_magic (mlt, Tdummy d) (MLdummy d)
(*s Generic way to deal with an application. *)
@@ -723,18 +674,18 @@ and extract_cst_app env mle mlt kn u args =
else mla
with e when Errors.noncritical e -> mla
in
- (* For strict languages, purely logical signatures with at least
- one [Kill Kother] lead to a dummy lam. So a [MLdummy] is left
+ (* For strict languages, purely logical signatures lead to a dummy lam
+ (except when [Kill Ktype] everywhere). So a [MLdummy] is left
accordingly. *)
let optdummy = match sign_kind s_full with
- | UnsafeLogicalSig when lang () != Haskell -> [MLdummy]
+ | UnsafeLogicalSig when lang () != Haskell -> [MLdummy Kprop]
| _ -> []
in
(* Different situations depending of the number of arguments: *)
if la >= ls
then
(* Enough args, cleanup already done in [mla], we only add the
- additionnal dummy if needed. *)
+ additional dummy if needed. *)
put_magic_if (magic2 && not magic1) (mlapp head (optdummy @ mla))
else
(* Partially applied function with some logical arg missing.
@@ -748,7 +699,7 @@ and extract_cst_app env mle mlt kn u args =
(*s Extraction of an inductive constructor applied to arguments. *)
(* \begin{itemize}
- \item In ML, contructor arguments are uncurryfied.
+ \item In ML, constructor arguments are uncurryfied.
\item We managed to suppress logical parts inside inductive definitions,
but they must appears outside (for partial applications for instance)
\item We also suppressed all Coq parameters to the inductives, since
@@ -826,8 +777,8 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt =
(* Logical singleton case: *)
(* [match c with C i j k -> t] becomes [t'] *)
assert (Int.equal br_size 1);
- let s = iterate (fun l -> Kill Kother :: l) ni.(0) [] in
- let mlt = iterate (fun t -> Tarr (Tdummy Kother, t)) ni.(0) mlt in
+ let s = iterate (fun l -> Kill Kprop :: l) ni.(0) [] in
+ let mlt = iterate (fun t -> Tarr (Tdummy Kprop, t)) ni.(0) mlt in
let e = extract_maybe_term env mle mlt br.(0) in
snd (case_expunge s e)
end
@@ -851,8 +802,7 @@ and extract_case env mle ((kn,i) as ip,c,br) mlt =
let e = extract_maybe_term env mle (type_recomp (l,mlt)) br.(i) in
(* We suppress dummy arguments according to signature. *)
let ids,e = case_expunge s e in
- let e' = handle_exn r (List.length s) (fun _ -> Anonymous) e in
- (List.rev ids, Pusual r, e')
+ (List.rev ids, Pusual r, e)
in
if mi.ind_kind == Singleton then
begin
@@ -960,8 +910,6 @@ let extract_std_constant env kn body typ =
let e = extract_term env mle t' c [] in
(* Expunging term and type from dummy lambdas. *)
let trm = term_expunge s (ids,e) in
- let trm = handle_exn (ConstRef kn) n (fun i -> fst (List.nth rels (i-1))) trm
- in
trm, type_expunge_from_sign env s t
(* Extracts the type of an axiom, honors the Extraction Implicit declaration. *)
@@ -979,8 +927,8 @@ let extract_axiom env kn typ =
let extract_fixpoint env vkn (fi,ti,ci) =
let n = Array.length vkn in
- let types = Array.make n (Tdummy Kother)
- and terms = Array.make n MLdummy in
+ let types = Array.make n (Tdummy Kprop)
+ and terms = Array.make n (MLdummy Kprop) in
let kns = Array.to_list vkn in
current_fixpoints := kns;
(* for replacing recursive calls [Rel ..] by the corresponding [Const]: *)
@@ -1022,7 +970,7 @@ let extract_constant env kn cb =
in
match flag_of_type env typ with
| (Logic,TypeScheme) -> warn_log (); Dtype (r, [], Tdummy Ktype)
- | (Logic,Default) -> warn_log (); Dterm (r, MLdummy, Tdummy Kother)
+ | (Logic,Default) -> warn_log (); Dterm (r, MLdummy Kprop, Tdummy Kprop)
| (Info,TypeScheme) ->
(match cb.const_body with
| Undef _ -> warn_info (); mk_typ_ax ()
@@ -1047,7 +995,7 @@ let extract_constant_spec env kn cb =
let typ = Typeops.type_of_constant_type env cb.const_type in
match flag_of_type env typ with
| (Logic, TypeScheme) -> Stype (r, [], Some (Tdummy Ktype))
- | (Logic, Default) -> Sval (r, Tdummy Kother)
+ | (Logic, Default) -> Sval (r, Tdummy Kprop)
| (Info, TypeScheme) ->
let s,vl = type_sign_vl env typ in
(match cb.const_body with
@@ -1075,8 +1023,8 @@ let extract_constr env c =
reset_meta_count ();
let typ = type_of env c in
match flag_of_type env typ with
- | (_,TypeScheme) -> MLdummy, Tdummy Ktype
- | (Logic,_) -> MLdummy, Tdummy Kother
+ | (_,TypeScheme) -> MLdummy Ktype, Tdummy Ktype
+ | (Logic,_) -> MLdummy Kprop, Tdummy Kprop
| (Info,Default) ->
let mlt = extract_type env [] 1 typ [] in
extract_term env Mlenv.empty mlt c [], mlt
@@ -1090,7 +1038,7 @@ let extract_inductive env kn =
| [] -> []
| t::l ->
let l' = filter (succ i) l in
- if isDummy (expand env t) || Int.List.mem i implicits then l'
+ if isTdummy (expand env t) || Int.Set.mem i implicits then l'
else t::l'
in filter (1+ind.ind_nparams) l
in
@@ -1102,11 +1050,11 @@ let extract_inductive env kn =
(*s Is a [ml_decl] logical ? *)
let logical_decl = function
- | Dterm (_,MLdummy,Tdummy _) -> true
+ | Dterm (_,MLdummy _,Tdummy _) -> true
| Dtype (_,[],Tdummy _) -> true
| Dfix (_,av,tv) ->
- (Array.for_all ((==) MLdummy) av) &&
- (Array.for_all isDummy tv)
+ (Array.for_all isMLdummy av) &&
+ (Array.for_all isTdummy tv)
| Dind (_,i) -> Array.for_all (fun ip -> ip.ip_logical) i.ind_packets
| _ -> false
diff --git a/plugins/extraction/extraction.mli b/plugins/extraction/extraction.mli
index 6bd2541b..cdda777a 100644
--- a/plugins/extraction/extraction.mli
+++ b/plugins/extraction/extraction.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/g_extraction.ml4 b/plugins/extraction/g_extraction.ml4
index 3fe5a8c0..aec95868 100644
--- a/plugins/extraction/g_extraction.ml4
+++ b/plugins/extraction/g_extraction.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml
index 37b41420..22519e34 100644
--- a/plugins/extraction/haskell.ml
+++ b/plugins/extraction/haskell.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -35,56 +35,59 @@ let keywords =
let pp_comment s = str "-- " ++ s ++ fnl ()
let pp_bracket_comment s = str"{- " ++ hov 0 s ++ str" -}"
+(* Note: do not shorten [str "foo" ++ fnl ()] into [str "foo\n"],
+ the '\n' character interacts badly with the Format boxing mechanism *)
+
let preamble mod_name comment used_modules usf =
- let pp_import mp = str ("import qualified "^ string_of_modfile mp ^"\n")
+ let pp_import mp = str ("import qualified "^ string_of_modfile mp) ++ fnl ()
in
(if not (usf.magic || usf.tunknown) then mt ()
else
str "{-# OPTIONS_GHC -cpp -XMagicHash #-}" ++ fnl () ++
- str "{- For Hugs, use the option -F\"cpp -P -traditional\" -}")
- ++ fnl () ++ fnl ()
+ str "{- For Hugs, use the option -F\"cpp -P -traditional\" -}" ++ fnl2 ())
++
(match comment with
| None -> mt ()
- | Some com -> pp_bracket_comment com ++ fnl () ++ fnl ())
+ | Some com -> pp_bracket_comment com ++ fnl2 ())
++
str "module " ++ pr_upper_id mod_name ++ str " where" ++ fnl2 () ++
str "import qualified Prelude" ++ fnl () ++
- prlist pp_import used_modules ++ fnl () ++
- (if List.is_empty used_modules then mt () else fnl ()) ++
+ prlist pp_import used_modules ++ fnl ()
+ ++
(if not (usf.magic || usf.tunknown) then mt ()
- else str "\
-\n#ifdef __GLASGOW_HASKELL__\
-\nimport qualified GHC.Base\
-\nimport qualified GHC.Prim\
-\n#else\
-\n-- HUGS\
-\nimport qualified IOExts\
-\n#endif" ++ fnl2 ())
+ else
+ str "#ifdef __GLASGOW_HASKELL__" ++ fnl () ++
+ str "import qualified GHC.Base" ++ fnl () ++
+ str "import qualified GHC.Prim" ++ fnl () ++
+ str "#else" ++ fnl () ++
+ str "-- HUGS" ++ fnl () ++
+ str "import qualified IOExts" ++ fnl () ++
+ str "#endif" ++ fnl2 ())
++
(if not usf.magic then mt ()
- else str "\
-\n#ifdef __GLASGOW_HASKELL__\
-\nunsafeCoerce :: a -> b\
-\nunsafeCoerce = GHC.Base.unsafeCoerce#\
-\n#else\
-\n-- HUGS\
-\nunsafeCoerce :: a -> b\
-\nunsafeCoerce = IOExts.unsafeCoerce\
-\n#endif" ++ fnl2 ())
+ else
+ str "#ifdef __GLASGOW_HASKELL__" ++ fnl () ++
+ str "unsafeCoerce :: a -> b" ++ fnl () ++
+ str "unsafeCoerce = GHC.Base.unsafeCoerce#" ++ fnl () ++
+ str "#else" ++ fnl () ++
+ str "-- HUGS" ++ fnl () ++
+ str "unsafeCoerce :: a -> b" ++ fnl () ++
+ str "unsafeCoerce = IOExts.unsafeCoerce" ++ fnl () ++
+ str "#endif" ++ fnl2 ())
++
(if not usf.tunknown then mt ()
- else str "\
-\n#ifdef __GLASGOW_HASKELL__\
-\ntype Any = GHC.Prim.Any\
-\n#else\
-\n-- HUGS\
-\ntype Any = ()\
-\n#endif" ++ fnl2 ())
+ else
+ str "#ifdef __GLASGOW_HASKELL__" ++ fnl () ++
+ str "type Any = GHC.Prim.Any" ++ fnl () ++
+ str "#else" ++ fnl () ++
+ str "-- HUGS" ++ fnl () ++
+ str "type Any = ()" ++ fnl () ++
+ str "#endif" ++ fnl2 ())
++
(if not usf.mldummy then mt ()
- else str "__ :: any" ++ fnl () ++
- str "__ = Prelude.error \"Logical or arity value used\"" ++ fnl2 ())
+ else
+ str "__ :: any" ++ fnl () ++
+ str "__ = Prelude.error \"Logical or arity value used\"" ++ fnl2 ())
let pp_abst = function
| [] -> (mt ())
@@ -120,7 +123,7 @@ let rec pp_type par vl t =
(pp_rec true t1 ++ spc () ++ str "->" ++ spc () ++ pp_rec false t2)
| Tdummy _ -> str "()"
| Tunknown -> str "Any"
- | Taxiom -> str "() -- AXIOM TO BE REALIZED\n"
+ | Taxiom -> str "() -- AXIOM TO BE REALIZED" ++ fnl ()
in
hov 0 (pp_rec par t)
@@ -140,7 +143,11 @@ let rec pp_expr par env args =
and apply2 st = pp_apply2 st par args in
function
| MLrel n ->
- let id = get_db_name n env in apply (pr_id id)
+ let id = get_db_name n env in
+ (* Try to survive to the occurrence of a Dummy rel.
+ TODO: we should get rid of this hack (cf. #592) *)
+ let id = if Id.equal id dummy_name then Id.of_string "__" else id in
+ apply (pr_id id)
| MLapp (f,args') ->
let stl = List.map (pp_expr true env []) args' in
pp_expr par env (stl @ args) f
@@ -200,8 +207,11 @@ let rec pp_expr par env args =
| MLexn s ->
(* An [MLexn] may be applied, but I don't really care. *)
pp_par par (str "Prelude.error" ++ spc () ++ qs s)
- | MLdummy ->
- str "__" (* An [MLdummy] may be applied, but I don't really care. *)
+ | MLdummy k ->
+ (* An [MLdummy] may be applied, but I don't really care. *)
+ (match msg_of_implicit k with
+ | "" -> str "__"
+ | s -> str "__" ++ spc () ++ pp_bracket_comment (str s))
| MLmagic a ->
pp_apply (str "unsafeCoerce") par (pp_expr true env [] a :: args)
| MLaxiom -> pp_par par (str "Prelude.error \"AXIOM TO BE REALIZED\"")
@@ -320,7 +330,7 @@ let pp_decl = function
prlist (fun id -> str (id^" ")) ids ++ str "=" ++ spc () ++ str s
with Not_found ->
prlist (fun id -> pr_id id ++ str " ") l ++
- if t == Taxiom then str "= () -- AXIOM TO BE REALIZED\n"
+ if t == Taxiom then str "= () -- AXIOM TO BE REALIZED" ++ fnl ()
else str "=" ++ spc () ++ pp_type false l t
in
hov 2 (str "type " ++ pp_global Type r ++ spc () ++ st) ++ fnl2 ()
@@ -331,7 +341,8 @@ let pp_decl = function
prvecti
(fun i r ->
let void = is_inline_custom r ||
- (not (is_custom r) && match defs.(i) with MLexn "UNUSED" -> true | _ -> false)
+ (not (is_custom r) &&
+ match defs.(i) with MLexn "UNUSED" -> true | _ -> false)
in
if void then mt ()
else
diff --git a/plugins/extraction/haskell.mli b/plugins/extraction/haskell.mli
index 99559bce..6f493206 100644
--- a/plugins/extraction/haskell.mli
+++ b/plugins/extraction/haskell.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/json.ml b/plugins/extraction/json.ml
index 125dc86b..df79c585 100644
--- a/plugins/extraction/json.ml
+++ b/plugins/extraction/json.ml
@@ -153,7 +153,7 @@ let rec json_expr env = function
("what", json_str "expr:exception");
("msg", json_str s)
]
- | MLdummy -> json_dict [("what", json_str "expr:dummy")]
+ | MLdummy _ -> json_dict [("what", json_str "expr:dummy")]
| MLmagic a -> json_dict [
("what", json_str "expr:coerce");
("value", json_expr env a)
diff --git a/plugins/extraction/miniml.mli b/plugins/extraction/miniml.mli
index b7dee6cb..db336152 100644
--- a/plugins/extraction/miniml.mli
+++ b/plugins/extraction/miniml.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -16,11 +16,16 @@ open Globnames
object expects, and what these arguments will become in the ML
object. *)
-(* We eliminate from terms: 1) types 2) logical parts.
- [Kother] stands both for logical or other reasons
- (for instance user-declared implicit arguments w.r.t. extraction). *)
+(* We eliminate from terms:
+ 1) types
+ 2) logical parts
+ 3) user-declared implicit arguments of a constant of constructor
+*)
-type kill_reason = Ktype | Kother
+type kill_reason =
+ | Ktype
+ | Kprop
+ | Kimplicit of global_reference * int (* n-th arg of a cst or construct *)
type sign = Keep | Kill of kill_reason
@@ -118,7 +123,7 @@ and ml_ast =
| MLcase of ml_type * ml_ast * ml_branch array
| MLfix of int * Id.t array * ml_ast array
| MLexn of string
- | MLdummy
+ | MLdummy of kill_reason
| MLaxiom
| MLmagic of ml_ast
diff --git a/plugins/extraction/mlutil.ml b/plugins/extraction/mlutil.ml
index 6fc1195f..402fe4ff 100644
--- a/plugins/extraction/mlutil.ml
+++ b/plugins/extraction/mlutil.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -299,10 +299,12 @@ let type_to_signature env t =
let isKill = function Kill _ -> true | _ -> false
-let isDummy = function Tdummy _ -> true | _ -> false
+let isTdummy = function Tdummy _ -> true | _ -> false
+
+let isMLdummy = function MLdummy _ -> true | _ -> false
let sign_of_id = function
- | Dummy -> Kill Kother
+ | Dummy -> Kill Kprop
| _ -> Keep
(* Classification of signatures *)
@@ -310,45 +312,44 @@ let sign_of_id = function
type sign_kind =
| EmptySig
| NonLogicalSig (* at least a [Keep] *)
- | UnsafeLogicalSig (* No [Keep], at least a [Kill Kother] *)
| SafeLogicalSig (* only [Kill Ktype] *)
+ | UnsafeLogicalSig (* No [Keep], not all [Kill Ktype] *)
let rec sign_kind = function
| [] -> EmptySig
| Keep :: _ -> NonLogicalSig
| Kill k :: s ->
- match sign_kind s with
- | NonLogicalSig -> NonLogicalSig
- | UnsafeLogicalSig -> UnsafeLogicalSig
- | SafeLogicalSig | EmptySig ->
- if k == Kother then UnsafeLogicalSig else SafeLogicalSig
+ match k, sign_kind s with
+ | _, NonLogicalSig -> NonLogicalSig
+ | Ktype, (SafeLogicalSig | EmptySig) -> SafeLogicalSig
+ | _, _ -> UnsafeLogicalSig
(* Removing the final [Keep] in a signature *)
let rec sign_no_final_keeps = function
| [] -> []
| k :: s ->
- let s' = k :: sign_no_final_keeps s in
- match s' with [Keep] -> [] | _ -> s'
+ match k, sign_no_final_keeps s with
+ | Keep, [] -> []
+ | k, l -> k::l
(*s Removing [Tdummy] from the top level of a ML type. *)
let type_expunge_from_sign env s t =
- let rec expunge s t =
- if List.is_empty s then t else match t with
- | Tmeta {contents = Some t} -> expunge s t
- | Tarr (a,b) ->
- let t = expunge (List.tl s) b in
- if List.hd s == Keep then Tarr (a, t) else t
- | Tglob (r,l) ->
- (match env r with
- | Some mlt -> expunge s (type_subst_list l mlt)
- | None -> assert false)
- | _ -> assert false
+ let rec expunge s t = match s, t with
+ | [], _ -> t
+ | Keep :: s, Tarr(a,b) -> Tarr (a, expunge s b)
+ | Kill _ :: s, Tarr(a,b) -> expunge s b
+ | _, Tmeta {contents = Some t} -> expunge s t
+ | _, Tglob (r,l) ->
+ (match env r with
+ | Some mlt -> expunge s (type_subst_list l mlt)
+ | None -> assert false)
+ | _ -> assert false
in
let t = expunge (sign_no_final_keeps s) t in
if lang () != Haskell && sign_kind s == UnsafeLogicalSig then
- Tarr (Tdummy Kother, t)
+ Tarr (Tdummy Kprop, t)
else t
let type_expunge env t =
@@ -385,7 +386,7 @@ let rec eq_ml_ast t1 t2 = match t1, t2 with
| MLfix (i1, id1, t1), MLfix (i2, id2, t2) ->
Int.equal i1 i2 && Array.equal Id.equal id1 id2 && Array.equal eq_ml_ast t1 t2
| MLexn e1, MLexn e2 -> String.equal e1 e2
-| MLdummy, MLdummy -> true
+| MLdummy k1, MLdummy k2 -> k1 == k2
| MLaxiom, MLaxiom -> true
| MLmagic t1, MLmagic t2 -> eq_ml_ast t1 t2
| _ -> false
@@ -420,7 +421,7 @@ let ast_iter_rel f =
| MLapp (a,l) -> iter n a; List.iter (iter n) l
| MLcons (_,_,l) | MLtuple l -> List.iter (iter n) l
| MLmagic a -> iter n a
- | MLglob _ | MLexn _ | MLdummy | MLaxiom -> ()
+ | MLglob _ | MLexn _ | MLdummy _ | MLaxiom -> ()
in iter 0
(*s Map over asts. *)
@@ -439,7 +440,7 @@ let ast_map f = function
| MLcons (typ,c,l) -> MLcons (typ,c, List.map f l)
| MLtuple l -> MLtuple (List.map f l)
| MLmagic a -> MLmagic (f a)
- | MLrel _ | MLglob _ | MLexn _ | MLdummy | MLaxiom as a -> a
+ | MLrel _ | MLglob _ | MLexn _ | MLdummy _ | MLaxiom as a -> a
(*s Map over asts, with binding depth as parameter. *)
@@ -457,7 +458,7 @@ let ast_map_lift f n = function
| MLcons (typ,c,l) -> MLcons (typ,c, List.map (f n) l)
| MLtuple l -> MLtuple (List.map (f n) l)
| MLmagic a -> MLmagic (f n a)
- | MLrel _ | MLglob _ | MLexn _ | MLdummy | MLaxiom as a -> a
+ | MLrel _ | MLglob _ | MLexn _ | MLdummy _ | MLaxiom as a -> a
(*s Iter over asts. *)
@@ -471,7 +472,7 @@ let ast_iter f = function
| MLapp (a,l) -> f a; List.iter f l
| MLcons (_,_,l) | MLtuple l -> List.iter f l
| MLmagic a -> f a
- | MLrel _ | MLglob _ | MLexn _ | MLdummy | MLaxiom -> ()
+ | MLrel _ | MLglob _ | MLexn _ | MLdummy _ | MLaxiom -> ()
(*S Operations concerning De Bruijn indices. *)
@@ -507,9 +508,73 @@ let nb_occur_match =
| MLapp (a,l) -> List.fold_left (fun r a -> r+(nb k a)) (nb k a) l
| MLcons (_,_,l) | MLtuple l -> List.fold_left (fun r a -> r+(nb k a)) 0 l
| MLmagic a -> nb k a
- | MLglob _ | MLexn _ | MLdummy | MLaxiom -> 0
+ | MLglob _ | MLexn _ | MLdummy _ | MLaxiom -> 0
in nb 1
+(* Replace unused variables by _ *)
+
+let dump_unused_vars a =
+ let rec ren env a = match a with
+ | MLrel i ->
+ let () = (List.nth env (i-1)) := true in a
+
+ | MLlam (id,b) ->
+ let occ_id = ref false in
+ let b' = ren (occ_id::env) b in
+ if !occ_id then if b' == b then a else MLlam(id,b')
+ else MLlam(Dummy,b')
+
+ | MLletin (id,b,c) ->
+ let occ_id = ref false in
+ let b' = ren env b in
+ let c' = ren (occ_id::env) c in
+ if !occ_id then
+ if b' == b && c' == c then a else MLletin(id,b',c')
+ else
+ (* 'let' without occurrence: shouldn't happen after simpl *)
+ MLletin(Dummy,b',c')
+
+ | MLcase (t,e,br) ->
+ let e' = ren env e in
+ let br' = Array.smartmap (ren_branch env) br in
+ if e' == e && br' == br then a else MLcase (t,e',br')
+
+ | MLfix (i,ids,v) ->
+ let env' = List.init (Array.length ids) (fun _ -> ref false) @ env in
+ let v' = Array.smartmap (ren env') v in
+ if v' == v then a else MLfix (i,ids,v')
+
+ | MLapp (b,l) ->
+ let b' = ren env b and l' = List.smartmap (ren env) l in
+ if b' == b && l' == l then a else MLapp (b',l')
+
+ | MLcons(t,r,l) ->
+ let l' = List.smartmap (ren env) l in
+ if l' == l then a else MLcons (t,r,l')
+
+ | MLtuple l ->
+ let l' = List.smartmap (ren env) l in
+ if l' == l then a else MLtuple l'
+
+ | MLmagic b ->
+ let b' = ren env b in
+ if b' == b then a else MLmagic b'
+
+ | MLglob _ | MLexn _ | MLdummy _ | MLaxiom -> a
+
+ and ren_branch env ((ids,p,b) as tr) =
+ let occs = List.map (fun _ -> ref false) ids in
+ let b' = ren (List.rev_append occs env) b in
+ let ids' =
+ List.map2
+ (fun id occ -> if !occ then id else Dummy)
+ ids occs
+ in
+ if b' == b && List.equal eq_ml_ident ids ids' then tr
+ else (ids',p,b')
+ in
+ ren [] a
+
(*s Lifting on terms.
[ast_lift k t] lifts the binding depth of [t] across [k] bindings. *)
@@ -559,7 +624,7 @@ let gen_subst v d t =
if i' < 1 then a
else if i' <= Array.length v then
match v.(i'-1) with
- | None -> MLexn ("UNBOUND " ^ string_of_int i')
+ | None -> assert false
| Some u -> ast_lift n u
else MLrel (i+d)
| a -> ast_map_lift subst n a
@@ -813,8 +878,8 @@ let census_add, census_max, census_clean =
try h := add k i !h
with Not_found -> h := (k, Int.Set.singleton i) :: !h
in
- let maxf k =
- let len = ref 0 and lst = ref Int.Set.empty and elm = ref k in
+ let maxf () =
+ let len = ref 0 and lst = ref Int.Set.empty and elm = ref MLaxiom in
List.iter
(fun (e, s) ->
let n = Int.Set.cardinal s in
@@ -843,7 +908,7 @@ let factor_branches o typ br =
if o.opt_case_cst then
(try census_add (branch_as_cst br.(i)) i with Impossible -> ());
done;
- let br_factor, br_set = census_max MLdummy in
+ let br_factor, br_set = census_max () in
census_clean ();
let n = Int.Set.cardinal br_set in
if Int.equal n 0 then None
@@ -926,7 +991,7 @@ let iota_gen br hd =
in iota 0 hd
let is_atomic = function
- | MLrel _ | MLglob _ | MLexn _ | MLdummy -> true
+ | MLrel _ | MLglob _ | MLexn _ | MLdummy _ -> true
| _ -> false
let is_imm_apply = function MLapp (MLrel 1, _) -> true | _ -> false
@@ -948,9 +1013,20 @@ let expand_linear_let o id e =
(* Some beta-iota reductions + simplifications. *)
+let rec unmagic = function MLmagic e -> unmagic e | e -> e
+let is_magic = function MLmagic _ -> true | _ -> false
+let magic_hd a = match a with
+ | MLmagic _ :: _ -> a
+ | e :: a -> MLmagic e :: a
+ | [] -> assert false
+
let rec simpl o = function
| MLapp (f, []) -> simpl o f
- | MLapp (f, a) -> simpl_app o (List.map (simpl o) a) (simpl o f)
+ | MLapp (MLapp(f,a),a') -> simpl o (MLapp(f,a@a'))
+ | MLapp (f, a) ->
+ (* When the head of the application is magic, no need for magic on args *)
+ let a = if is_magic f then List.map unmagic a else a in
+ simpl_app o (List.map (simpl o) a) (simpl o f)
| MLcase (typ,e,br) ->
let br = Array.map (fun (l,p,t) -> (l,p,simpl o t)) br in
simpl_case o typ br (simpl o e)
@@ -970,12 +1046,18 @@ let rec simpl o = function
if ast_occurs_itvl 1 n c.(i) then
MLfix (i, ids, Array.map (simpl o) c)
else simpl o (ast_lift (-n) c.(i)) (* Dummy fixpoint *)
+ | MLmagic(MLmagic _ as e) -> simpl o e
+ | MLmagic(MLapp (f,l)) -> simpl o (MLapp (MLmagic f, l))
+ | MLmagic(MLletin(id,c,e)) -> simpl o (MLletin(id,c,MLmagic e))
+ | MLmagic(MLcase(typ,e,br)) ->
+ let br' = Array.map (fun (ids,p,c) -> (ids,p,MLmagic c)) br in
+ simpl o (MLcase(typ,e,br'))
+ | MLmagic(MLexn _ as e) -> e
| a -> ast_map (simpl o) a
(* invariant : list [a] of arguments is non-empty *)
and simpl_app o a = function
- | MLapp (f',a') -> simpl_app o (a'@a) f'
| MLlam (Dummy,t) ->
simpl o (MLapp (ast_pop t, List.tl a))
| MLlam (id,t) -> (* Beta redex *)
@@ -986,6 +1068,11 @@ and simpl_app o a = function
| _ ->
let a' = List.map (ast_lift 1) (List.tl a) in
simpl o (MLletin (id, List.hd a, MLapp (t, a'))))
+ | MLmagic (MLlam (id,t)) ->
+ (* When we've at least one argument, we permute the magic
+ and the lambda, to simplify things a bit (see #2795).
+ Alas, the 1st argument must also be magic then. *)
+ simpl_app o (magic_hd a) (MLlam (id,MLmagic t))
| MLletin (id,e1,e2) when o.opt_let_app ->
(* Application of a letin: we push arguments inside *)
MLletin (id, e1, simpl o (MLapp (e2, List.map (ast_lift 1) a)))
@@ -998,7 +1085,7 @@ and simpl_app o a = function
let a' = List.map (ast_lift k) a in
(l, p, simpl o (MLapp (t,a')))) br
in simpl o (MLcase (typ,e,br'))
- | (MLdummy | MLexn _) as e -> e
+ | (MLdummy _ | MLexn _) as e -> e
(* We just discard arguments in those cases. *)
| f -> MLapp (f,a)
@@ -1049,20 +1136,26 @@ let rec select_via_bl l args = match l,args with
(*s [kill_some_lams] removes some head lambdas according to the signature [bl].
This list is build on the identifier list model: outermost lambda
is on the right.
- [Rels] corresponding to removed lambdas are supposed not to occur, and
+ [Rels] corresponding to removed lambdas are not supposed to occur
+ (except maybe in the case of Kimplicit), and
the other [Rels] are made correct via a [gen_subst].
Output is not directly a [ml_ast], compose with [named_lams] if needed. *)
+let is_impl_kill = function Kill (Kimplicit _) -> true | _ -> false
+
let kill_some_lams bl (ids,c) =
let n = List.length bl in
let n' = List.fold_left (fun n b -> if b == Keep then (n+1) else n) 0 bl in
if Int.equal n n' then ids,c
- else if Int.equal n' 0 then [],ast_lift (-n) c
+ else if Int.equal n' 0 && not (List.exists is_impl_kill bl)
+ then [],ast_lift (-n) c
else begin
let v = Array.make n None in
let rec parse_ids i j = function
| [] -> ()
| Keep :: l -> v.(i) <- Some (MLrel j); parse_ids (i+1) (j+1) l
+ | Kill (Kimplicit _ as k) :: l ->
+ v.(i) <- Some (MLdummy k); parse_ids (i+1) j l
| Kill _ :: l -> parse_ids (i+1) j l
in parse_ids 0 1 bl;
select_via_bl bl ids, gen_subst v (n'-n) c
@@ -1070,11 +1163,19 @@ let kill_some_lams bl (ids,c) =
(*s [kill_dummy_lams] uses the last function to kill the lambdas corresponding
to a [dummy_name]. It can raise [Impossible] if there is nothing to do, or
- if there is no lambda left at all. *)
+ if there is no lambda left at all. In addition, it now accepts a signature
+ that may mention some implicits. *)
-let kill_dummy_lams c =
+let rec merge_implicits ids s = match ids, s with
+ | [],_ -> []
+ | _,[] -> List.map sign_of_id ids
+ | Dummy::ids, _::s -> Kill Kprop :: merge_implicits ids s
+ | _::ids, (Kill (Kimplicit _) as k)::s -> k :: merge_implicits ids s
+ | _::ids, _::s -> Keep :: merge_implicits ids s
+
+let kill_dummy_lams sign c =
let ids,c = collect_lams c in
- let bl = List.map sign_of_id ids in
+ let bl = merge_implicits ids (List.rev sign) in
if not (List.memq Keep bl) then raise Impossible;
let rec fst_kill n = function
| [] -> raise Impossible
@@ -1086,7 +1187,7 @@ let kill_dummy_lams c =
let _, bl = List.chop skip bl in
let c = named_lams ids_skip c in
let ids',c = kill_some_lams bl (ids,c) in
- ids, named_lams ids' c
+ (ids,bl), named_lams ids' c
(*s [eta_expansion_sign] takes a function [fun idn ... id1 -> c]
and a signature [s] and builds a eta-long version. *)
@@ -1100,12 +1201,12 @@ let eta_expansion_sign s (ids,c) =
let a = List.rev_map (function MLrel x -> MLrel (i-x) | a -> a) rels
in ids, MLapp (ast_lift (i-1) c, a)
| Keep :: l -> abs (anonymous :: ids) (MLrel i :: rels) (i+1) l
- | Kill _ :: l -> abs (Dummy :: ids) (MLdummy :: rels) (i+1) l
+ | Kill k :: l -> abs (Dummy :: ids) (MLdummy k :: rels) (i+1) l
in abs ids [] 1 s
(*s If [s = [b1; ... ; bn]] then [case_expunge] decomposes [e]
in [n] lambdas (with eta-expansion if needed) and removes all dummy lambdas
- corresponding to [Del] in [s]. *)
+ corresponding to [Kill _] in [s]. *)
let case_expunge s e =
let m = List.length s in
@@ -1123,17 +1224,18 @@ let term_expunge s (ids,c) =
if List.is_empty s then c
else
let ids,c = kill_some_lams (List.rev s) (ids,c) in
- if List.is_empty ids && lang () != Haskell && List.mem (Kill Kother) s then
- MLlam (Dummy, ast_lift 1 c)
+ if List.is_empty ids && lang () != Haskell &&
+ sign_kind s == UnsafeLogicalSig
+ then MLlam (Dummy, ast_lift 1 c)
else named_lams ids c
-(*s [kill_dummy_args ids r t] looks for occurrences of [MLrel r] in [t] and
- purge the args of [MLrel r] corresponding to a [dummy_name].
+(*s [kill_dummy_args (ids,bl) r t] looks for occurrences of [MLrel r] in [t]
+ and purge the args of [MLrel r] corresponding to a [Kill] in [bl].
It makes eta-expansion if needed. *)
-let kill_dummy_args ids r t =
+let kill_dummy_args (ids,bl) r t =
let m = List.length ids in
- let bl = List.rev_map sign_of_id ids in
+ let sign = List.rev bl in
let rec found n = function
| MLrel r' when Int.equal r' (r + n) -> true
| MLmagic e -> found n e
@@ -1144,41 +1246,46 @@ let kill_dummy_args ids r t =
let k = max 0 (m - (List.length a)) in
let a = List.map (killrec n) a in
let a = List.map (ast_lift k) a in
- let a = select_via_bl bl (a @ (eta_args k)) in
+ let a = select_via_bl sign (a @ (eta_args k)) in
named_lams (List.firstn k ids) (MLapp (ast_lift k e, a))
| e when found n e ->
- let a = select_via_bl bl (eta_args m) in
+ let a = select_via_bl sign (eta_args m) in
named_lams ids (MLapp (ast_lift m e, a))
| e -> ast_map_lift killrec n e
in killrec 0 t
(*s The main function for local [dummy] elimination. *)
+let sign_of_args a =
+ List.map (function MLdummy k -> Kill k | _ -> Keep) a
+
let rec kill_dummy = function
| MLfix(i,fi,c) ->
(try
- let ids,c = kill_dummy_fix i c in
- ast_subst (MLfix (i,fi,c)) (kill_dummy_args ids 1 (MLrel 1))
+ let k,c = kill_dummy_fix i c [] in
+ ast_subst (MLfix (i,fi,c)) (kill_dummy_args k 1 (MLrel 1))
with Impossible -> MLfix (i,fi,Array.map kill_dummy c))
| MLapp (MLfix (i,fi,c),a) ->
let a = List.map kill_dummy a in
+ (* Heuristics: if some arguments are implicit args, we try to
+ eliminate the corresponding arguments of the fixpoint *)
(try
- let ids,c = kill_dummy_fix i c in
+ let k,c = kill_dummy_fix i c (sign_of_args a) in
let fake = MLapp (MLrel 1, List.map (ast_lift 1) a) in
- let fake' = kill_dummy_args ids 1 fake in
+ let fake' = kill_dummy_args k 1 fake in
ast_subst (MLfix (i,fi,c)) fake'
with Impossible -> MLapp(MLfix(i,fi,Array.map kill_dummy c),a))
| MLletin(id, MLfix (i,fi,c),e) ->
(try
- let ids,c = kill_dummy_fix i c in
- let e = kill_dummy (kill_dummy_args ids 1 e) in
+ let k,c = kill_dummy_fix i c [] in
+ let e = kill_dummy (kill_dummy_args k 1 e) in
MLletin(id, MLfix(i,fi,c),e)
with Impossible ->
MLletin(id, MLfix(i,fi,Array.map kill_dummy c),kill_dummy e))
| MLletin(id,c,e) ->
(try
- let ids,c = kill_dummy_lams (kill_dummy_hd c) in
- let e = kill_dummy (kill_dummy_args ids 1 e) in
+ let k,c = kill_dummy_lams [] (kill_dummy_hd c) in
+ let e = kill_dummy (kill_dummy_args k 1 e) in
let c = kill_dummy c in
if is_atomic c then ast_subst c e else MLletin (id, c, e)
with Impossible -> MLletin(id,kill_dummy c,kill_dummy e))
@@ -1190,21 +1297,21 @@ and kill_dummy_hd = function
| MLlam(id,e) -> MLlam(id, kill_dummy_hd e)
| MLletin(id,c,e) ->
(try
- let ids,c = kill_dummy_lams (kill_dummy_hd c) in
- let e = kill_dummy_hd (kill_dummy_args ids 1 e) in
+ let k,c = kill_dummy_lams [] (kill_dummy_hd c) in
+ let e = kill_dummy_hd (kill_dummy_args k 1 e) in
let c = kill_dummy c in
if is_atomic c then ast_subst c e else MLletin (id, c, e)
with Impossible -> MLletin(id,kill_dummy c,kill_dummy_hd e))
| a -> a
-and kill_dummy_fix i c =
+and kill_dummy_fix i c s =
let n = Array.length c in
- let ids,ci = kill_dummy_lams (kill_dummy_hd c.(i)) in
+ let k,ci = kill_dummy_lams s (kill_dummy_hd c.(i)) in
let c = Array.copy c in c.(i) <- ci;
for j = 0 to (n-1) do
- c.(j) <- kill_dummy (kill_dummy_args ids (n-i) c.(j))
+ c.(j) <- kill_dummy (kill_dummy_args k (n-i) c.(j))
done;
- ids,c
+ k,c
(*s Putting things together. *)
@@ -1267,7 +1374,7 @@ let rec ml_size = function
| MLfix(_,_,f) -> ml_size_array f
| MLletin (_,_,t) -> ml_size t
| MLmagic t -> ml_size t
- | MLglob _ | MLrel _ | MLexn _ | MLdummy | MLaxiom -> 0
+ | MLglob _ | MLrel _ | MLexn _ | MLdummy _ | MLaxiom -> 0
and ml_size_list l = List.fold_left (fun a t -> a + ml_size t) 0 l
diff --git a/plugins/extraction/mlutil.mli b/plugins/extraction/mlutil.mli
index 0a71d2c8..c6675524 100644
--- a/plugins/extraction/mlutil.mli
+++ b/plugins/extraction/mlutil.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -67,7 +67,8 @@ val type_expunge : abbrev_map -> ml_type -> ml_type
val type_expunge_from_sign : abbrev_map -> signature -> ml_type -> ml_type
val eq_ml_type : ml_type -> ml_type -> bool
-val isDummy : ml_type -> bool
+val isTdummy : ml_type -> bool
+val isMLdummy : ml_ast -> bool
val isKill : sign -> bool
val case_expunge : signature -> ml_ast -> ml_ident list * ml_ast
@@ -110,6 +111,8 @@ val ast_subst : ml_ast -> ml_ast -> ml_ast
val ast_glob_subst : ml_ast Refmap'.t -> ml_ast -> ml_ast
+val dump_unused_vars : ml_ast -> ml_ast
+
val normalize : ml_ast -> ml_ast
val optimize_fix : ml_ast -> ml_ast
val inline : global_reference -> ml_ast -> bool
@@ -125,8 +128,8 @@ exception Impossible
type sign_kind =
| EmptySig
| NonLogicalSig (* at least a [Keep] *)
- | UnsafeLogicalSig (* No [Keep], at least a [Kill Kother] *)
| SafeLogicalSig (* only [Kill Ktype] *)
+ | UnsafeLogicalSig (* No [Keep], not all [Kill Ktype] *)
val sign_kind : signature -> sign_kind
diff --git a/plugins/extraction/modutil.ml b/plugins/extraction/modutil.ml
index 8158ac64..b5e8b480 100644
--- a/plugins/extraction/modutil.ml
+++ b/plugins/extraction/modutil.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -100,7 +100,7 @@ let ast_iter_references do_term do_cons do_type a =
Array.iter (fun (_,p,_) -> patt_iter_references do_cons p) v
| MLrel _ | MLlam _ | MLapp _ | MLletin _ | MLtuple _ | MLfix _ | MLexn _
- | MLdummy | MLaxiom | MLmagic _ -> ()
+ | MLdummy _ | MLaxiom | MLmagic _ -> ()
in iter a
let ind_iter_references do_term do_cons do_type kn ind =
@@ -269,7 +269,7 @@ let rec optim_se top to_appear s = function
let a = normalize (ast_glob_subst !s a) in
let i = inline r a in
if i then s := Refmap'.add r a !s;
- let d = match optimize_fix a with
+ let d = match dump_unused_vars (optimize_fix a) with
| MLfix (0, _, [|c|]) ->
Dfix ([|r|], [|ast_subst (MLglob r) c|], [|t|])
| a -> Dterm (r, a, t)
@@ -283,7 +283,8 @@ let rec optim_se top to_appear s = function
if inline rv.(i) fake_body
then s := Refmap'.add rv.(i) (dfix_to_mlfix rv av i) !s
done;
- (l,SEdecl (Dfix (rv, av, tv))) :: (optim_se top to_appear s lse)
+ let av' = Array.map dump_unused_vars av in
+ (l,SEdecl (Dfix (rv, av', tv))) :: (optim_se top to_appear s lse)
| (l,SEmodule m) :: lse ->
let m = { m with ml_mod_expr = optim_me to_appear s m.ml_mod_expr}
in (l,SEmodule m) :: (optim_se top to_appear s lse)
@@ -387,16 +388,15 @@ let is_prefix pre s =
in
is_prefix_aux 0
-let check_implicits = function
- | MLexn s ->
- if String.length s > 8 && (s.[0] == 'U' || s.[0] == 'I') then
- begin
- if is_prefix "UNBOUND" s then assert false;
- if is_prefix "IMPLICIT" s then
- error_non_implicit (String.sub s 9 (String.length s - 9));
- end;
- false
- | _ -> false
+exception RemainingImplicit of kill_reason
+
+let check_for_remaining_implicits struc =
+ let check = function
+ | MLdummy (Kimplicit _ as k) -> raise (RemainingImplicit k)
+ | _ -> false
+ in
+ try ignore (struct_ast_search check struc)
+ with RemainingImplicit k -> err_or_warn_remaining_implicit k
let optimize_struct to_appear struc =
let subst = ref (Refmap'.empty : ml_ast Refmap'.t) in
@@ -404,12 +404,16 @@ let optimize_struct to_appear struc =
List.map (fun (mp,lse) -> (mp, optim_se true (fst to_appear) subst lse))
struc
in
- ignore (struct_ast_search check_implicits opt_struc);
- if library () then
- List.filter (fun (_,lse) -> not (List.is_empty lse)) opt_struc
- else begin
- reset_needed ();
- List.iter add_needed (fst to_appear);
- List.iter add_needed_mp (snd to_appear);
- depcheck_struct opt_struc
- end
+ let mini_struc =
+ if library () then
+ List.filter (fun (_,lse) -> not (List.is_empty lse)) opt_struc
+ else
+ begin
+ reset_needed ();
+ List.iter add_needed (fst to_appear);
+ List.iter add_needed_mp (snd to_appear);
+ depcheck_struct opt_struc
+ end
+ in
+ let () = check_for_remaining_implicits mini_struc in
+ mini_struc
diff --git a/plugins/extraction/modutil.mli b/plugins/extraction/modutil.mli
index ca32f029..dc870824 100644
--- a/plugins/extraction/modutil.mli
+++ b/plugins/extraction/modutil.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml
index 8c482b4b..3cb3810c 100644
--- a/plugins/extraction/ocaml.ml
+++ b/plugins/extraction/ocaml.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -55,29 +55,36 @@ let keywords =
"land"; "lor"; "lxor"; "lsl"; "lsr"; "asr" ; "unit" ; "_" ; "__" ]
Id.Set.empty
-let pp_open mp = str ("open "^ string_of_modfile mp ^"\n")
+(* Note: do not shorten [str "foo" ++ fnl ()] into [str "foo\n"],
+ the '\n' character interacts badly with the Format boxing mechanism *)
+
+let pp_open mp = str ("open "^ string_of_modfile mp) ++ fnl ()
let pp_comment s = str "(* " ++ hov 0 s ++ str " *)"
let pp_header_comment = function
| None -> mt ()
- | Some com -> pp_comment com ++ fnl () ++ fnl ()
+ | Some com -> pp_comment com ++ fnl2 ()
+
+let then_nl pp = if Pp.is_empty pp then mt () else pp ++ fnl ()
+
+let pp_tdummy usf =
+ if usf.tdummy || usf.tunknown then str "type __ = Obj.t" ++ fnl () else mt ()
+
+let pp_mldummy usf =
+ if usf.mldummy then
+ str "let __ = let rec f _ = Obj.repr f in Obj.repr f" ++ fnl ()
+ else mt ()
let preamble _ comment used_modules usf =
pp_header_comment comment ++
- prlist pp_open used_modules ++
- (if List.is_empty used_modules then mt () else fnl ()) ++
- (if usf.tdummy || usf.tunknown then str "type __ = Obj.t\n" else mt()) ++
- (if usf.mldummy then
- str "let __ = let rec f _ = Obj.repr f in Obj.repr f\n"
- else mt ()) ++
- (if usf.tdummy || usf.tunknown || usf.mldummy then fnl () else mt ())
+ then_nl (prlist pp_open used_modules) ++
+ then_nl (pp_tdummy usf ++ pp_mldummy usf)
let sig_preamble _ comment used_modules usf =
- pp_header_comment comment ++ fnl () ++ fnl () ++
- prlist pp_open used_modules ++
- (if List.is_empty used_modules then mt () else fnl ()) ++
- (if usf.tdummy || usf.tunknown then str "type __ = Obj.t\n\n" else mt())
+ pp_header_comment comment ++
+ then_nl (prlist pp_open used_modules) ++
+ then_nl (pp_tdummy usf)
(*s The pretty-printer for Ocaml syntax*)
@@ -171,7 +178,11 @@ let rec pp_expr par env args =
and apply2 st = pp_apply2 st par args in
function
| MLrel n ->
- let id = get_db_name n env in apply (pr_id id)
+ let id = get_db_name n env in
+ (* Try to survive to the occurrence of a Dummy rel.
+ TODO: we should get rid of this hack (cf. #592) *)
+ let id = if Id.equal id dummy_name then Id.of_string "__" else id in
+ apply (pr_id id)
| MLapp (f,args') ->
let stl = List.map (pp_expr true env []) args' in
pp_expr par env (stl @ args) f
@@ -199,8 +210,11 @@ let rec pp_expr par env args =
| MLexn s ->
(* An [MLexn] may be applied, but I don't really care. *)
pp_par par (str "assert false" ++ spc () ++ str ("(* "^s^" *)"))
- | MLdummy ->
- str "__" (* An [MLdummy] may be applied, but I don't really care. *)
+ | MLdummy k ->
+ (* An [MLdummy] may be applied, but I don't really care. *)
+ (match msg_of_implicit k with
+ | "" -> str "__"
+ | s -> str "__" ++ spc () ++ str ("(* "^s^" *)"))
| MLmagic a ->
pp_apply (str "Obj.magic") par (pp_expr true env [] a :: args)
| MLaxiom ->
@@ -352,7 +366,7 @@ and pp_function env t =
| MLcase(Tglob(r,_),MLrel 1,pv) when
not (is_coinductive r) && List.is_empty (get_record_fields r) &&
not (is_custom_match pv) ->
- if not (ast_occurs 1 (MLcase(Tunknown,MLdummy,pv))) then
+ if not (ast_occurs 1 (MLcase(Tunknown,MLaxiom,pv))) then
pr_binding (List.rev (List.tl bl)) ++
str " = function" ++ fnl () ++
v 0 (pp_pat env' pv)
@@ -378,9 +392,14 @@ and pp_fix par env i (ids,bl) args =
fnl () ++
hov 2 (str "in " ++ pp_apply (pr_id ids.(i)) false args)))
+(* Ad-hoc double-newline in v boxes, with enough negative whitespace
+ to avoid indenting the intermediate blank line *)
+
+let cut2 () = brk (0,-100000) ++ brk (0,0)
+
let pp_val e typ =
hov 4 (str "(** val " ++ e ++ str " :" ++ spc () ++ pp_type false [] typ ++
- str " **)") ++ fnl2 ()
+ str " **)") ++ cut2 ()
(*s Pretty-printing of [Dfix] *)
@@ -389,11 +408,11 @@ let pp_Dfix (rv,c,t) =
(fun r -> if is_inline_custom r then mt () else pp_global Term r) rv
in
let rec pp init i =
- if i >= Array.length rv then
- (if init then failwith "empty phrase" else mt ())
+ if i >= Array.length rv then mt ()
else
let void = is_inline_custom rv.(i) ||
- (not (is_custom rv.(i)) && match c.(i) with MLexn "UNUSED" -> true | _ -> false)
+ (not (is_custom rv.(i)) &&
+ match c.(i) with MLexn "UNUSED" -> true | _ -> false)
in
if void then pp init (i+1)
else
@@ -401,7 +420,7 @@ let pp_Dfix (rv,c,t) =
if is_custom rv.(i) then str " = " ++ str (find_custom rv.(i))
else pp_function (empty_env ()) c.(i)
in
- (if init then mt () else fnl2 ()) ++
+ (if init then mt () else cut2 ()) ++
pp_val names.(i) t.(i) ++
str (if init then "let rec " else "and ") ++ names.(i) ++ def ++
pp false (i+1)
@@ -466,8 +485,8 @@ let pp_coind pl name =
let pp_ind co kn ind =
let prefix = if co then "__" else "" in
- let some = ref false in
- let init= ref (str "type ") in
+ let initkwd = str "type " in
+ let nextkwd = fnl () ++ str "and " in
let names =
Array.mapi (fun i p -> if p.ip_logical then mt () else
pp_global Type (IndRef (kn,i)))
@@ -480,29 +499,20 @@ let pp_ind co kn ind =
p.ip_types)
ind.ind_packets
in
- let rec pp i =
+ let rec pp i kwd =
if i >= Array.length ind.ind_packets then mt ()
else
let ip = (kn,i) in
let ip_equiv = ind.ind_equiv, i in
let p = ind.ind_packets.(i) in
- if is_custom (IndRef ip) then pp (i+1)
- else begin
- some := true;
- if p.ip_logical then pp_logical_ind p ++ pp (i+1)
- else
- let s = !init in
- begin
- init := (fnl () ++ str "and ");
- s ++
- (if co then pp_coind p.ip_vars names.(i) else mt ()) ++
- pp_one_ind
- prefix ip_equiv p.ip_vars names.(i) cnames.(i) p.ip_types ++
- pp (i+1)
- end
- end
+ if is_custom (IndRef ip) then pp (i+1) kwd
+ else if p.ip_logical then pp_logical_ind p ++ pp (i+1) kwd
+ else
+ kwd ++ (if co then pp_coind p.ip_vars names.(i) else mt ()) ++
+ pp_one_ind prefix ip_equiv p.ip_vars names.(i) cnames.(i) p.ip_types ++
+ pp (i+1) nextkwd
in
- let st = pp 0 in if !some then st else failwith "empty phrase"
+ pp 0 initkwd
(*s Pretty-printing of a declaration. *)
@@ -515,8 +525,8 @@ let pp_mind kn i =
| Standard -> pp_ind false kn i
let pp_decl = function
- | Dtype (r,_,_) when is_inline_custom r -> failwith "empty phrase"
- | Dterm (r,_,_) when is_inline_custom r -> failwith "empty phrase"
+ | Dtype (r,_,_) when is_inline_custom r -> mt ()
+ | Dterm (r,_,_) when is_inline_custom r -> mt ()
| Dind (kn,i) -> pp_mind kn i
| Dtype (r, l, t) ->
let name = pp_global Type r in
@@ -524,13 +534,13 @@ let pp_decl = function
let ids, def =
try
let ids,s = find_type_custom r in
- pp_string_parameters ids, str "=" ++ spc () ++ str s
+ pp_string_parameters ids, str " =" ++ spc () ++ str s
with Not_found ->
pp_parameters l,
- if t == Taxiom then str "(* AXIOM TO BE REALIZED *)"
- else str "=" ++ spc () ++ pp_type false l t
+ if t == Taxiom then str " (* AXIOM TO BE REALIZED *)"
+ else str " =" ++ spc () ++ pp_type false l t
in
- hov 2 (str "type " ++ ids ++ name ++ spc () ++ def)
+ hov 2 (str "type " ++ ids ++ name ++ def)
| Dterm (r, a, t) ->
let def =
if is_custom r then str (" = " ^ find_custom r)
@@ -564,8 +574,8 @@ let pp_alias_decl ren = function
rv
let pp_spec = function
- | Sval (r,_) when is_inline_custom r -> failwith "empty phrase"
- | Stype (r,_,_) when is_inline_custom r -> failwith "empty phrase"
+ | Sval (r,_) when is_inline_custom r -> mt ()
+ | Stype (r,_,_) when is_inline_custom r -> mt ()
| Sind (kn,i) -> pp_mind kn i
| Sval (r,t) ->
let def = pp_type false [] t in
@@ -577,15 +587,15 @@ let pp_spec = function
let ids, def =
try
let ids, s = find_type_custom r in
- pp_string_parameters ids, str "= " ++ str s
+ pp_string_parameters ids, str " =" ++ spc () ++ str s
with Not_found ->
let ids = pp_parameters l in
match ot with
| None -> ids, mt ()
- | Some Taxiom -> ids, str "(* AXIOM TO BE REALIZED *)"
- | Some t -> ids, str "=" ++ spc () ++ pp_type false l t
+ | Some Taxiom -> ids, str " (* AXIOM TO BE REALIZED *)"
+ | Some t -> ids, str " =" ++ spc () ++ pp_type false l t
in
- hov 2 (str "type " ++ ids ++ name ++ spc () ++ def)
+ hov 2 (str "type " ++ ids ++ name ++ def)
let pp_alias_spec ren = function
| Sind (kn,i) -> pp_mind kn { i with ind_equiv = RenEquiv ren }
@@ -602,7 +612,7 @@ let rec pp_specif = function
| (l,Spec s) ->
(try
let ren = Common.check_duplicate (top_visible_mp ()) l in
- hov 1 (str ("module "^ren^" : sig ") ++ fnl () ++ pp_spec s) ++
+ hov 1 (str ("module "^ren^" : sig") ++ fnl () ++ pp_spec s) ++
fnl () ++ str "end" ++ fnl () ++
pp_alias_spec ren s
with Not_found -> pp_spec s)
@@ -610,15 +620,15 @@ let rec pp_specif = function
let def = pp_module_type [] mt in
let def' = pp_module_type [] mt in
let name = pp_modname (MPdot (top_visible_mp (), l)) in
- hov 1 (str "module " ++ name ++ str " : " ++ fnl () ++ def) ++
+ hov 1 (str "module " ++ name ++ str " :" ++ fnl () ++ def) ++
(try
let ren = Common.check_duplicate (top_visible_mp ()) l in
- fnl () ++ hov 1 (str ("module "^ren^" : ") ++ fnl () ++ def')
+ fnl () ++ hov 1 (str ("module "^ren^" :") ++ fnl () ++ def')
with Not_found -> Pp.mt ())
| (l,Smodtype mt) ->
let def = pp_module_type [] mt in
let name = pp_modname (MPdot (top_visible_mp (), l)) in
- hov 1 (str "module type " ++ name ++ str " = " ++ fnl () ++ def) ++
+ hov 1 (str "module type " ++ name ++ str " =" ++ fnl () ++ def) ++
(try
let ren = Common.check_duplicate (top_visible_mp ()) l in
fnl () ++ str ("module type "^ren^" = ") ++ name
@@ -635,14 +645,15 @@ and pp_module_type params = function
| MTsig (mp, sign) ->
push_visible mp params;
let try_pp_specif l x =
- try pp_specif x :: l with Failure "empty phrase" -> l
+ let px = pp_specif x in
+ if Pp.is_empty px then l else px::l
in
(* We cannot use fold_right here due to side effects in pp_specif *)
let l = List.fold_left try_pp_specif [] sign in
let l = List.rev l in
pop_visible ();
- str "sig " ++ fnl () ++
- v 1 (str " " ++ prlist_with_sep fnl2 identity l) ++
+ str "sig" ++ fnl () ++
+ v 1 (str " " ++ prlist_with_sep cut2 identity l) ++
fnl () ++ str "end"
| MTwith(mt,ML_With_type(idl,vl,typ)) ->
let ids = pp_parameters (rename_tvars keywords vl) in
@@ -672,7 +683,7 @@ let rec pp_structure_elem = function
| (l,SEdecl d) ->
(try
let ren = Common.check_duplicate (top_visible_mp ()) l in
- hov 1 (str ("module "^ren^" = struct ") ++ fnl () ++ pp_decl d) ++
+ hov 1 (str ("module "^ren^" = struct") ++ fnl () ++ pp_decl d) ++
fnl () ++ str "end" ++ fnl () ++
pp_alias_decl ren d
with Not_found -> pp_decl d)
@@ -686,8 +697,8 @@ let rec pp_structure_elem = function
let def = pp_module_expr [] m.ml_mod_expr in
let name = pp_modname (MPdot (top_visible_mp (), l)) in
hov 1
- (str "module " ++ name ++ typ ++ str " = " ++
- (if (is_short m.ml_mod_expr) then mt () else fnl ()) ++ def) ++
+ (str "module " ++ name ++ typ ++ str " =" ++
+ (if is_short m.ml_mod_expr then spc () else fnl ()) ++ def) ++
(try
let ren = Common.check_duplicate (top_visible_mp ()) l in
fnl () ++ str ("module "^ren^" = ") ++ name
@@ -695,7 +706,7 @@ let rec pp_structure_elem = function
| (l,SEmodtype m) ->
let def = pp_module_type [] m in
let name = pp_modname (MPdot (top_visible_mp (), l)) in
- hov 1 (str "module type " ++ name ++ str " = " ++ fnl () ++ def) ++
+ hov 1 (str "module type " ++ name ++ str " =" ++ fnl () ++ def) ++
(try
let ren = Common.check_duplicate (top_visible_mp ()) l in
fnl () ++ str ("module type "^ren^" = ") ++ name
@@ -713,36 +724,42 @@ and pp_module_expr params = function
| MEstruct (mp, sel) ->
push_visible mp params;
let try_pp_structure_elem l x =
- try pp_structure_elem x :: l with Failure "empty phrase" -> l
+ let px = pp_structure_elem x in
+ if Pp.is_empty px then l else px::l
in
(* We cannot use fold_right here due to side effects in pp_structure_elem *)
let l = List.fold_left try_pp_structure_elem [] sel in
let l = List.rev l in
pop_visible ();
- str "struct " ++ fnl () ++
- v 1 (str " " ++ prlist_with_sep fnl2 identity l) ++
+ str "struct" ++ fnl () ++
+ v 1 (str " " ++ prlist_with_sep cut2 identity l) ++
fnl () ++ str "end"
+let rec prlist_sep_nonempty sep f = function
+ | [] -> mt ()
+ | [h] -> f h
+ | h::t ->
+ let e = f h in
+ let r = prlist_sep_nonempty sep f t in
+ if Pp.is_empty e then r
+ else e ++ sep () ++ r
+
let do_struct f s =
- let pp s = try f s ++ fnl2 () with Failure "empty phrase" -> mt ()
- in
let ppl (mp,sel) =
push_visible mp [];
- let p = prlist_strict pp sel in
+ let p = prlist_sep_nonempty cut2 f sel in
(* for monolithic extraction, we try to simulate the unavailability
of [MPfile] in names by artificially nesting these [MPfile] *)
(if modular () then pop_visible ()); p
in
- let p = prlist_strict ppl s in
+ let p = prlist_sep_nonempty cut2 ppl s in
(if not (modular ()) then repeat (List.length s) pop_visible ());
- p
+ v 0 p ++ fnl ()
let pp_struct s = do_struct pp_structure_elem s
let pp_signature s = do_struct pp_specif s
-let pp_decl d = try pp_decl d with Failure "empty phrase" -> mt ()
-
let ocaml_descr = {
keywords = keywords;
file_suffix = ".ml";
@@ -754,5 +771,3 @@ let ocaml_descr = {
pp_sig = pp_signature;
pp_decl = pp_decl;
}
-
-
diff --git a/plugins/extraction/ocaml.mli b/plugins/extraction/ocaml.mli
index 4e796792..f579a54b 100644
--- a/plugins/extraction/ocaml.mli
+++ b/plugins/extraction/ocaml.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml
index cc8b6d8e..7b0f14df 100644
--- a/plugins/extraction/scheme.ml
+++ b/plugins/extraction/scheme.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -126,7 +126,7 @@ let rec pp_expr env args =
| MLexn s ->
(* An [MLexn] may be applied, but I don't really care. *)
paren (str "error" ++ spc () ++ qs s)
- | MLdummy ->
+ | MLdummy _ ->
str "__" (* An [MLdummy] may be applied, but I don't really care. *)
| MLmagic a ->
pp_expr env args a
@@ -183,7 +183,8 @@ let pp_decl = function
prvecti
(fun i r ->
let void = is_inline_custom r ||
- (not (is_custom r) && match defs.(i) with MLexn "UNUSED" -> true | _ -> false)
+ (not (is_custom r) &&
+ match defs.(i) with MLexn "UNUSED" -> true | _ -> false)
in
if void then mt ()
else
diff --git a/plugins/extraction/scheme.mli b/plugins/extraction/scheme.mli
index f0e36e09..5e1ec0d5 100644
--- a/plugins/extraction/scheme.mli
+++ b/plugins/extraction/scheme.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index a57c39ee..d7842e12 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -72,8 +72,6 @@ let mp_length mp =
| _ -> 1
in len mp
-let visible_con kn = at_toplevel (base_mp (con_modpath kn))
-
let rec prefixes_mp mp = match mp with
| MPdot (mp',_) -> MPset.add mp (prefixes_mp mp')
| _ -> MPset.singleton mp
@@ -105,17 +103,30 @@ let labels_of_ref r =
(* Theses tables are not registered within coq save/undo mechanism
since we reset their contents at each run of Extraction *)
-(*s Constants tables. *)
+(* We use [constant_body] (resp. [mutual_inductive_body]) as checksum
+ to ensure that the table contents aren't outdated. *)
-let terms = ref (Cmap_env.empty : ml_decl Cmap_env.t)
-let init_terms () = terms := Cmap_env.empty
-let add_term kn d = terms := Cmap_env.add kn d !terms
-let lookup_term kn = Cmap_env.find kn !terms
+(*s Constants tables. *)
-let types = ref (Cmap_env.empty : ml_schema Cmap_env.t)
-let init_types () = types := Cmap_env.empty
-let add_type kn s = types := Cmap_env.add kn s !types
-let lookup_type kn = Cmap_env.find kn !types
+let typedefs = ref (Cmap_env.empty : (constant_body * ml_type) Cmap_env.t)
+let init_typedefs () = typedefs := Cmap_env.empty
+let add_typedef kn cb t =
+ typedefs := Cmap_env.add kn (cb,t) !typedefs
+let lookup_typedef kn cb =
+ try
+ let (cb0,t) = Cmap_env.find kn !typedefs in
+ if cb0 == cb then Some t else None
+ with Not_found -> None
+
+let cst_types =
+ ref (Cmap_env.empty : (constant_body * ml_schema) Cmap_env.t)
+let init_cst_types () = cst_types := Cmap_env.empty
+let add_cst_type kn cb s = cst_types := Cmap_env.add kn (cb,s) !cst_types
+let lookup_cst_type kn cb =
+ try
+ let (cb0,s) = Cmap_env.find kn !cst_types in
+ if cb0 == cb then Some s else None
+ with Not_found -> None
(*s Inductives table. *)
@@ -124,7 +135,14 @@ let inductives =
let init_inductives () = inductives := Mindmap_env.empty
let add_ind kn mib ml_ind =
inductives := Mindmap_env.add kn (mib,ml_ind) !inductives
-let lookup_ind kn = Mindmap_env.find kn !inductives
+let lookup_ind kn mib =
+ try
+ let (mib0,ml_ind) = Mindmap_env.find kn !inductives in
+ if mib == mib0 then Some ml_ind
+ else None
+ with Not_found -> None
+
+let unsafe_lookup_ind kn = snd (Mindmap_env.find kn !inductives)
let inductive_kinds =
ref (Mindmap_env.empty : inductive_kind Mindmap_env.t)
@@ -244,10 +262,10 @@ let safe_basename_of_global r =
| ConstRef kn -> Label.to_id (con_label kn)
| IndRef (kn,0) -> Label.to_id (mind_label kn)
| IndRef (kn,i) ->
- (try (snd (lookup_ind kn)).ind_packets.(i).ip_typename
+ (try (unsafe_lookup_ind kn).ind_packets.(i).ip_typename
with Not_found -> last_chance r)
| ConstructRef ((kn,i),j) ->
- (try (snd (lookup_ind kn)).ind_packets.(i).ip_consnames.(j-1)
+ (try (unsafe_lookup_ind kn).ind_packets.(i).ip_consnames.(j-1)
with Not_found -> last_chance r)
| VarRef _ -> assert false
@@ -401,16 +419,34 @@ let error_MPfile_as_mod mp b =
"Monolithic Extraction cannot deal with this situation.\n"^
"Please "^s2^"use (Recursive) Extraction Library instead.\n"))
-let msg_non_implicit r n id =
- let name = match id with
- | Anonymous -> ""
- | Name id -> "(" ^ Id.to_string id ^ ") "
- in
- "The " ^ (String.ordinal n) ^ " argument " ^ name ^ "of " ^ (string_of_global r)
-
-let error_non_implicit msg =
- err (str (msg ^ " still occurs after extraction.") ++
- fnl () ++ str "Please check the Extraction Implicit declarations.")
+let argnames_of_global r =
+ let typ = Global.type_of_global_unsafe r in
+ let rels,_ =
+ decompose_prod (Reduction.whd_betadeltaiota (Global.env ()) typ) in
+ List.rev_map fst rels
+
+let msg_of_implicit = function
+ | Kimplicit (r,i) ->
+ let name = match List.nth (argnames_of_global r) (i-1) with
+ | Anonymous -> ""
+ | Name id -> "(" ^ Id.to_string id ^ ") "
+ in
+ (String.ordinal i)^" argument "^name^"of "^(string_of_global r)
+ | Ktype | Kprop -> ""
+
+let error_remaining_implicit k =
+ let s = msg_of_implicit k in
+ err (str ("An implicit occurs after extraction : "^s^".") ++ fnl () ++
+ str "Please check your Extraction Implicit declarations." ++ fnl() ++
+ str "You might also try Unset Extraction SafeImplicits to force" ++
+ fnl() ++ str "the extraction of unsafe code and review it manually.")
+
+let warning_remaining_implicit k =
+ let s = msg_of_implicit k in
+ msg_warning
+ (str ("At least an implicit occurs after extraction : "^s^".") ++ fnl () ++
+ str "Extraction SafeImplicits is unset, extracting nonetheless," ++ fnl ()
+ ++ str "but this code is potentially unsafe, please review it manually.")
let check_loaded_modfile mp = match base_mp mp with
| MPfile dp ->
@@ -635,32 +671,39 @@ let reset_extraction_inline () = Lib.add_anonymous_leaf (reset_inline ())
(*s Extraction Implicit *)
+let safe_implicit = my_bool_option "SafeImplicits" true
+
+let err_or_warn_remaining_implicit k =
+ if safe_implicit () then
+ error_remaining_implicit k
+ else
+ warning_remaining_implicit k
+
type int_or_id = ArgInt of int | ArgId of Id.t
let implicits_table = Summary.ref Refmap'.empty ~name:"ExtrImplicit"
let implicits_of_global r =
- try Refmap'.find r !implicits_table with Not_found -> []
+ try Refmap'.find r !implicits_table with Not_found -> Int.Set.empty
let add_implicits r l =
- let typ = Global.type_of_global_unsafe r in
- let rels,_ =
- decompose_prod (Reduction.whd_betadeltaiota (Global.env ()) typ) in
- let names = List.rev_map fst rels in
+ let names = argnames_of_global r in
let n = List.length names in
- let check = function
+ let add_arg s = function
| ArgInt i ->
- if 1 <= i && i <= n then i
+ if 1 <= i && i <= n then Int.Set.add i s
else err (int i ++ str " is not a valid argument number for " ++
safe_pr_global r)
| ArgId id ->
- (try List.index Name.equal (Name id) names
- with Not_found ->
- err (str "No argument " ++ pr_id id ++ str " for " ++
- safe_pr_global r))
+ try
+ let i = List.index Name.equal (Name id) names in
+ Int.Set.add i s
+ with Not_found ->
+ err (str "No argument " ++ pr_id id ++ str " for " ++
+ safe_pr_global r)
in
- let l' = List.map check l in
- implicits_table := Refmap'.add r l' !implicits_table
+ let ints = List.fold_left add_arg Int.Set.empty l in
+ implicits_table := Refmap'.add r ints !implicits_table
(* Registration of operations for rollback. *)
@@ -851,6 +894,6 @@ let extract_inductive r s l optstr =
(*s Tables synchronization. *)
let reset_tables () =
- init_terms (); init_types (); init_inductives ();
+ init_typedefs (); init_cst_types (); init_inductives ();
init_inductive_kinds (); init_recursors ();
init_projs (); init_axioms (); init_opaques (); reset_modfile ()
diff --git a/plugins/extraction/table.mli b/plugins/extraction/table.mli
index 648f2321..2b163610 100644
--- a/plugins/extraction/table.mli
+++ b/plugins/extraction/table.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -13,7 +13,7 @@ open Miniml
open Declarations
module Refset' : CSig.SetS with type elt = global_reference
-module Refmap' : Map.S with type key = global_reference
+module Refmap' : CSig.MapS with type key = global_reference
val safe_basename_of_global : global_reference -> Id.t
@@ -38,8 +38,8 @@ val error_MPfile_as_mod : module_path -> bool -> 'a
val check_inside_module : unit -> unit
val check_inside_section : unit -> unit
val check_loaded_modfile : module_path -> unit
-val msg_non_implicit : global_reference -> int -> Name.t -> string
-val error_non_implicit : string -> 'a
+val msg_of_implicit : kill_reason -> string
+val err_or_warn_remaining_implicit : kill_reason -> unit
val info_file : string -> unit
@@ -55,7 +55,6 @@ val string_of_modfile : module_path -> string
val file_of_modfile : module_path -> string
val is_toplevel : module_path -> bool
val at_toplevel : module_path -> bool
-val visible_con : constant -> bool
val mp_length : module_path -> int
val prefixes_mp : module_path -> MPset.t
val common_prefix_from_list :
@@ -65,14 +64,22 @@ val labels_of_ref : global_reference -> module_path * Label.t list
(*s Some table-related operations *)
-val add_term : constant -> ml_decl -> unit
-val lookup_term : constant -> ml_decl
+(* For avoiding repeated extraction of the same constant or inductive,
+ we use cache functions below. Indexing by constant name isn't enough,
+ due to modules we could have a same constant name but different
+ content. So we check that the [constant_body] hasn't changed from
+ recording time to retrieving time. Same for inductive : we store
+ [mutual_inductive_body] as checksum. In both case, we should ideally
+ also check the env *)
-val add_type : constant -> ml_schema -> unit
-val lookup_type : constant -> ml_schema
+val add_typedef : constant -> constant_body -> ml_type -> unit
+val lookup_typedef : constant -> constant_body -> ml_type option
+
+val add_cst_type : constant -> constant_body -> ml_schema -> unit
+val lookup_cst_type : constant -> constant_body -> ml_schema option
val add_ind : mutual_inductive -> mutual_inductive_body -> ml_ind -> unit
-val lookup_ind : mutual_inductive -> mutual_inductive_body * ml_ind
+val lookup_ind : mutual_inductive -> mutual_inductive_body -> ml_ind option
val add_inductive_kind : mutual_inductive -> inductive_kind -> unit
val is_coinductive : global_reference -> bool
@@ -166,7 +173,7 @@ val to_keep : global_reference -> bool
(*s Table for implicits arguments *)
-val implicits_of_global : global_reference -> int list
+val implicits_of_global : global_reference -> Int.Set.t
(*s Table for user-given custom ML extractions. *)
diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml
index 62a8605a..ae2d059f 100644
--- a/plugins/firstorder/formula.ml
+++ b/plugins/firstorder/formula.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/formula.mli b/plugins/firstorder/formula.mli
index 6c7b0938..39d99d2e 100644
--- a/plugins/firstorder/formula.mli
+++ b/plugins/firstorder/formula.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4
index c28da42a..04152688 100644
--- a/plugins/firstorder/g_ground.ml4
+++ b/plugins/firstorder/g_ground.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml
index 2248b669..3b9f67f6 100644
--- a/plugins/firstorder/ground.ml
+++ b/plugins/firstorder/ground.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/ground.mli b/plugins/firstorder/ground.mli
index 5b320786..b5669463 100644
--- a/plugins/firstorder/ground.mli
+++ b/plugins/firstorder/ground.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml
index c80a8081..a717cc91 100644
--- a/plugins/firstorder/instances.ml
+++ b/plugins/firstorder/instances.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/instances.mli b/plugins/firstorder/instances.mli
index 2f69ad7b..ce711f3f 100644
--- a/plugins/firstorder/instances.mli
+++ b/plugins/firstorder/instances.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml
index 382d5409..e676a8a9 100644
--- a/plugins/firstorder/rules.ml
+++ b/plugins/firstorder/rules.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/rules.mli b/plugins/firstorder/rules.mli
index 596e8535..381b7cd8 100644
--- a/plugins/firstorder/rules.mli
+++ b/plugins/firstorder/rules.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml
index a77af03d..3e8033da 100644
--- a/plugins/firstorder/sequent.ml
+++ b/plugins/firstorder/sequent.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/sequent.mli b/plugins/firstorder/sequent.mli
index dc3f05be..06c9251e 100644
--- a/plugins/firstorder/sequent.mli
+++ b/plugins/firstorder/sequent.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -13,7 +13,7 @@ open Globnames
module OrderedConstr: Set.OrderedType with type t=constr
-module CM: Map.S with type key=constr
+module CM: CSig.MapS with type key=constr
type h_item = global_reference * (int*constr) option
diff --git a/plugins/firstorder/unify.ml b/plugins/firstorder/unify.ml
index 0a172034..d9ab36ad 100644
--- a/plugins/firstorder/unify.ml
+++ b/plugins/firstorder/unify.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/firstorder/unify.mli b/plugins/firstorder/unify.mli
index 15318546..4fe9ad38 100644
--- a/plugins/firstorder/unify.mli
+++ b/plugins/firstorder/unify.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/Fourier.v b/plugins/fourier/Fourier.v
index 1832de85..1d7ee93e 100644
--- a/plugins/fourier/Fourier.v
+++ b/plugins/fourier/Fourier.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/Fourier_util.v b/plugins/fourier/Fourier_util.v
index 284d220a..d4b0e2e1 100644
--- a/plugins/fourier/Fourier_util.v
+++ b/plugins/fourier/Fourier_util.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/fourier.ml b/plugins/fourier/fourier.ml
index 50a5150d..4919232c 100644
--- a/plugins/fourier/fourier.ml
+++ b/plugins/fourier/fourier.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/fourierR.ml b/plugins/fourier/fourierR.ml
index 7a56cd66..72e9371b 100644
--- a/plugins/fourier/fourierR.ml
+++ b/plugins/fourier/fourierR.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/fourier/g_fourier.ml4 b/plugins/fourier/g_fourier.ml4
index d00f0564..7c665ae7 100644
--- a/plugins/fourier/g_fourier.ml4
+++ b/plugins/fourier/g_fourier.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/Recdef.v b/plugins/funind/Recdef.v
index a63941f0..e4433247 100644
--- a/plugins/funind/Recdef.v
+++ b/plugins/funind/Recdef.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/functional_principles_proofs.mli b/plugins/funind/functional_principles_proofs.mli
index 61fce267..34ce6696 100644
--- a/plugins/funind/functional_principles_proofs.mli
+++ b/plugins/funind/functional_principles_proofs.mli
@@ -8,7 +8,7 @@ val prove_princ_for_struct :
val prove_principle_for_gen :
- constant*constant*constant -> (* name of the function, the fonctionnal and the fixpoint equation *)
+ constant*constant*constant -> (* name of the function, the functional and the fixpoint equation *)
constr option ref -> (* a pointer to the obligation proofs lemma *)
bool -> (* is that function uses measure *)
int -> (* the number of recursive argument *)
diff --git a/plugins/funind/functional_principles_types.mli b/plugins/funind/functional_principles_types.mli
index bc082f07..3fa2644c 100644
--- a/plugins/funind/functional_principles_types.mli
+++ b/plugins/funind/functional_principles_types.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4
index 045beb37..a15e46bf 100644
--- a/plugins/funind/g_indfun.ml4
+++ b/plugins/funind/g_indfun.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 1b12cd42..5d92fca5 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -681,7 +681,7 @@ and build_entry_lc_from_case env funname make_discr
let case_resl =
List.fold_right
(fun (case_arg,_) ctxt_argsl ->
- let arg_res = build_entry_lc env funname avoid case_arg in
+ let arg_res = build_entry_lc env funname ctxt_argsl.to_avoid case_arg in
combine_results combine_args arg_res ctxt_argsl
)
el
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index d9794014..a800c186 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml
index e3455e77..87d7ca76 100644
--- a/plugins/funind/merge.ml
+++ b/plugins/funind/merge.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index 5d41ec72..065d0fe5 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -203,7 +203,7 @@ let (declare_f : Id.t -> logical_kind -> constr list -> global_reference -> glob
-(* Debuging mechanism *)
+(* Debugging mechanism *)
let debug_queue = Stack.create ()
let rec print_debug_queue b e =
@@ -291,9 +291,9 @@ let tclUSER_if_not_mes concl_tac is_mes names_to_suppress =
-(* Travelling term.
+(* Traveling term.
Both definitions of [f_terminate] and [f_equation] use the same generic
- travelling mechanism.
+ traveling mechanism.
*)
(* [check_not_nested forbidden e] checks that [e] does not contains any variable
@@ -327,7 +327,7 @@ let check_not_nested forbidden e =
with UserError(_,p) ->
errorlabstrm "_" (str "on expr : " ++ Printer.pr_lconstr e ++ str " " ++ p)
-(* ['a info] contains the local information for travelling *)
+(* ['a info] contains the local information for traveling *)
type 'a infos =
{ nb_arg : int; (* function number of arguments *)
concl_tac : tactic; (* final tactic to finish proofs *)
@@ -337,7 +337,7 @@ type 'a infos =
f_id : Id.t; (* function name *)
f_constr : constr; (* function term *)
f_terminate : constr; (* termination proof term *)
- func : global_reference; (* functionnal reference *)
+ func : global_reference; (* functional reference *)
info : 'a;
is_main_branch : bool; (* on the main branch or on a matched expression *)
is_final : bool; (* final first order term or not *)
@@ -357,7 +357,7 @@ type ('a,'b) journey_info_tac =
'b infos -> (* argument of the tactic *)
tactic
-(* journey_info : specifies the actions to do on the different term constructors during the travelling of the term
+(* journey_info : specifies the actions to do on the different term constructors during the traveling of the term
*)
type journey_info =
{ letiN : ((Name.t*constr*types*constr),constr) journey_info_tac;
diff --git a/plugins/micromega/Env.v b/plugins/micromega/Env.v
index dd4d596f..a19e9df9 100644
--- a/plugins/micromega/Env.v
+++ b/plugins/micromega/Env.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/EnvRing.v b/plugins/micromega/EnvRing.v
index 62a7333d..fd4bb248 100644
--- a/plugins/micromega/EnvRing.v
+++ b/plugins/micromega/EnvRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/Lia.v b/plugins/micromega/Lia.v
index 72425585..3e58e81a 100644
--- a/plugins/micromega/Lia.v
+++ b/plugins/micromega/Lia.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/MExtraction.v b/plugins/micromega/MExtraction.v
index 8b959c27..0a41af45 100644
--- a/plugins/micromega/MExtraction.v
+++ b/plugins/micromega/MExtraction.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/OrderedRing.v b/plugins/micromega/OrderedRing.v
index 34b8bbdd..72b4dcb6 100644
--- a/plugins/micromega/OrderedRing.v
+++ b/plugins/micromega/OrderedRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/Psatz.v b/plugins/micromega/Psatz.v
index 675321d9..a461b26a 100644
--- a/plugins/micromega/Psatz.v
+++ b/plugins/micromega/Psatz.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/QMicromega.v b/plugins/micromega/QMicromega.v
index 6c157def..43268363 100644
--- a/plugins/micromega/QMicromega.v
+++ b/plugins/micromega/QMicromega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/RMicromega.v b/plugins/micromega/RMicromega.v
index e9ab6962..72353a99 100644
--- a/plugins/micromega/RMicromega.v
+++ b/plugins/micromega/RMicromega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/Refl.v b/plugins/micromega/Refl.v
index 499a8c4c..32ddb3cf 100644
--- a/plugins/micromega/Refl.v
+++ b/plugins/micromega/Refl.v
@@ -1,7 +1,7 @@
(* -*- coding: utf-8 -*- *)
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/RingMicromega.v b/plugins/micromega/RingMicromega.v
index a0545637..751a81df 100644
--- a/plugins/micromega/RingMicromega.v
+++ b/plugins/micromega/RingMicromega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/Tauto.v b/plugins/micromega/Tauto.v
index 39d0c6b1..391231af 100644
--- a/plugins/micromega/Tauto.v
+++ b/plugins/micromega/Tauto.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/VarMap.v b/plugins/micromega/VarMap.v
index 6e1fe222..4981ddb3 100644
--- a/plugins/micromega/VarMap.v
+++ b/plugins/micromega/VarMap.v
@@ -1,7 +1,7 @@
(* -*- coding: utf-8 -*- *)
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/ZCoeff.v b/plugins/micromega/ZCoeff.v
index 4c4b81a0..bd425e6b 100644
--- a/plugins/micromega/ZCoeff.v
+++ b/plugins/micromega/ZCoeff.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/ZMicromega.v b/plugins/micromega/ZMicromega.v
index 84a8d13c..d7ddef2b 100644
--- a/plugins/micromega/ZMicromega.v
+++ b/plugins/micromega/ZMicromega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/certificate.ml b/plugins/micromega/certificate.ml
index b4f305dd..a5fceb56 100644
--- a/plugins/micromega/certificate.ml
+++ b/plugins/micromega/certificate.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index 2812e36e..cce0a728 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/csdpcert.ml b/plugins/micromega/csdpcert.ml
index b41f29c9..2536005e 100644
--- a/plugins/micromega/csdpcert.ml
+++ b/plugins/micromega/csdpcert.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/g_micromega.ml4 b/plugins/micromega/g_micromega.ml4
index 1ac44a42..75237aaa 100644
--- a/plugins/micromega/g_micromega.ml4
+++ b/plugins/micromega/g_micromega.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/mutils.ml b/plugins/micromega/mutils.ml
index a07cbec6..2dd443f0 100644
--- a/plugins/micromega/mutils.ml
+++ b/plugins/micromega/mutils.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/persistent_cache.ml b/plugins/micromega/persistent_cache.ml
index 2dc0d003..6a03e2d6 100644
--- a/plugins/micromega/persistent_cache.ml
+++ b/plugins/micromega/persistent_cache.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/polynomial.ml b/plugins/micromega/polynomial.ml
index b8b42a3f..90a108a3 100644
--- a/plugins/micromega/polynomial.ml
+++ b/plugins/micromega/polynomial.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/sos.mli b/plugins/micromega/sos.mli
index fc0b2fd4..1ca27ea2 100644
--- a/plugins/micromega/sos.mli
+++ b/plugins/micromega/sos.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/micromega/sos_types.ml b/plugins/micromega/sos_types.ml
index e9543714..615ac5a2 100644
--- a/plugins/micromega/sos_types.ml
+++ b/plugins/micromega/sos_types.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/Nsatz.v b/plugins/nsatz/Nsatz.v
index eaf95e94..3068b534 100644
--- a/plugins/nsatz/Nsatz.v
+++ b/plugins/nsatz/Nsatz.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/ideal.ml b/plugins/nsatz/ideal.ml
index 8ff82454..482ce505 100644
--- a/plugins/nsatz/ideal.ml
+++ b/plugins/nsatz/ideal.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/nsatz.ml4 b/plugins/nsatz/nsatz.ml4
index b4eb57ec..ced53d82 100644
--- a/plugins/nsatz/nsatz.ml4
+++ b/plugins/nsatz/nsatz.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/polynom.ml b/plugins/nsatz/polynom.ml
index a9651304..dbd9005c 100644
--- a/plugins/nsatz/polynom.ml
+++ b/plugins/nsatz/polynom.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/nsatz/polynom.mli b/plugins/nsatz/polynom.mli
index 9d46cd99..433ab591 100644
--- a/plugins/nsatz/polynom.mli
+++ b/plugins/nsatz/polynom.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/Omega.v b/plugins/omega/Omega.v
index a5f90dd6..9988c858 100644
--- a/plugins/omega/Omega.v
+++ b/plugins/omega/Omega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/OmegaPlugin.v b/plugins/omega/OmegaPlugin.v
index 9f101dbf..cd162498 100644
--- a/plugins/omega/OmegaPlugin.v
+++ b/plugins/omega/OmegaPlugin.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/OmegaTactic.v b/plugins/omega/OmegaTactic.v
index 9f101dbf..cd162498 100644
--- a/plugins/omega/OmegaTactic.v
+++ b/plugins/omega/OmegaTactic.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/PreOmega.v b/plugins/omega/PreOmega.v
index ee0f841c..5f5f548f 100644
--- a/plugins/omega/PreOmega.v
+++ b/plugins/omega/PreOmega.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index aac9a7d3..8a2a957c 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/g_omega.ml4 b/plugins/omega/g_omega.ml4
index 46bbe2fd..c96b4a4f 100644
--- a/plugins/omega/g_omega.ml4
+++ b/plugins/omega/g_omega.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/omega/omega.ml b/plugins/omega/omega.ml
index 67a1ff96..bd991a95 100644
--- a/plugins/omega/omega.ml
+++ b/plugins/omega/omega.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/quote/Quote.v b/plugins/quote/Quote.v
index ca1a18e8..2d154adc 100644
--- a/plugins/quote/Quote.v
+++ b/plugins/quote/Quote.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.ml4
index e27fe7f4..fdc5c2bb 100644
--- a/plugins/quote/g_quote.ml4
+++ b/plugins/quote/g_quote.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/quote/quote.ml b/plugins/quote/quote.ml
index 2a2ef30f..ff6acf13 100644
--- a/plugins/quote/quote.ml
+++ b/plugins/quote/quote.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -211,9 +211,9 @@ let compute_rhs bodyi index_of_f =
let i = destRel (Array.last args) in
PMeta (Some (coerce_meta_in i))
| App (f,args) ->
- PApp (pi3 (pattern_of_constr (Global.env()) Evd.empty f), Array.map aux args)
+ PApp (pattern_of_constr (Global.env()) Evd.empty f, Array.map aux args)
| Cast (c,_,_) -> aux c
- | _ -> pi3 (pattern_of_constr (Global.env())(*FIXME*) Evd.empty c)
+ | _ -> pattern_of_constr (Global.env())(*FIXME*) Evd.empty c
in
aux bodyi
diff --git a/plugins/romega/refl_omega.ml b/plugins/romega/refl_omega.ml
index 95407c5f..560e6a89 100644
--- a/plugins/romega/refl_omega.ml
+++ b/plugins/romega/refl_omega.ml
@@ -46,7 +46,7 @@ let occ_step_eq s1 s2 = match s1, s2 with
d'une liste de pas à partir de la racine de l'hypothèse *)
type occurrence = {o_hyp : Names.Id.t; o_path : occ_path}
-(* \subsection{refiable formulas} *)
+(* \subsection{reifiable formulas} *)
type oformula =
(* integer *)
| Oint of Bigint.bigint
@@ -55,7 +55,7 @@ type oformula =
| Omult of oformula * oformula
| Ominus of oformula * oformula
| Oopp of oformula
- (* an atome in the environment *)
+ (* an atom in the environment *)
| Oatom of int
(* weird expression that cannot be translated *)
| Oufo of oformula
@@ -75,7 +75,7 @@ type oproposition =
| Pimp of int * oproposition * oproposition
| Pprop of Term.constr
-(* Les équations ou proposiitions atomiques utiles du calcul *)
+(* Les équations ou propositions atomiques utiles du calcul *)
and oequation = {
e_comp: comparaison; (* comparaison *)
e_left: oformula; (* formule brute gauche *)
@@ -1266,7 +1266,7 @@ let resolution env full_reified_goal systems_list =
| (O_right :: l) -> app coq_p_right [| loop l |] in
let correct_index =
let i = List.index0 Names.Id.equal e.e_origin.o_hyp l_hyps in
- (* PL: it seems that additionnally introduced hyps are in the way during
+ (* PL: it seems that additionally introduced hyps are in the way during
normalization, hence this index shifting... *)
if Int.equal i 0 then 0 else Pervasives.(+) i (List.length to_introduce)
in
diff --git a/plugins/rtauto/Bintree.v b/plugins/rtauto/Bintree.v
index 267cd472..7394cebd 100644
--- a/plugins/rtauto/Bintree.v
+++ b/plugins/rtauto/Bintree.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/Rtauto.v b/plugins/rtauto/Rtauto.v
index 61a160b2..0dc6e31b 100644
--- a/plugins/rtauto/Rtauto.v
+++ b/plugins/rtauto/Rtauto.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/g_rtauto.ml4 b/plugins/rtauto/g_rtauto.ml4
index 7fefab3e..d27b0483 100644
--- a/plugins/rtauto/g_rtauto.ml4
+++ b/plugins/rtauto/g_rtauto.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/proof_search.ml b/plugins/rtauto/proof_search.ml
index 23510117..3ba92b9f 100644
--- a/plugins/rtauto/proof_search.ml
+++ b/plugins/rtauto/proof_search.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/proof_search.mli b/plugins/rtauto/proof_search.mli
index 86a2fb66..31f8e7b5 100644
--- a/plugins/rtauto/proof_search.mli
+++ b/plugins/rtauto/proof_search.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 4ffc1f33..9c22b5ad 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/rtauto/refl_tauto.mli b/plugins/rtauto/refl_tauto.mli
index 45fb50dc..c9e591bb 100644
--- a/plugins/rtauto/refl_tauto.mli
+++ b/plugins/rtauto/refl_tauto.mli
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/ArithRing.v b/plugins/setoid_ring/ArithRing.v
index e7d0cd8e..04decbce 100644
--- a/plugins/setoid_ring/ArithRing.v
+++ b/plugins/setoid_ring/ArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/BinList.v b/plugins/setoid_ring/BinList.v
index 5dd1b86d..d639f608 100644
--- a/plugins/setoid_ring/BinList.v
+++ b/plugins/setoid_ring/BinList.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Cring.v b/plugins/setoid_ring/Cring.v
index 4872c776..17a57e62 100644
--- a/plugins/setoid_ring/Cring.v
+++ b/plugins/setoid_ring/Cring.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Field.v b/plugins/setoid_ring/Field.v
index 4de2efe3..73a13139 100644
--- a/plugins/setoid_ring/Field.v
+++ b/plugins/setoid_ring/Field.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Field_tac.v b/plugins/setoid_ring/Field_tac.v
index f867c6d0..babbb86a 100644
--- a/plugins/setoid_ring/Field_tac.v
+++ b/plugins/setoid_ring/Field_tac.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Field_theory.v b/plugins/setoid_ring/Field_theory.v
index 0f5c49b0..2932d379 100644
--- a/plugins/setoid_ring/Field_theory.v
+++ b/plugins/setoid_ring/Field_theory.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/InitialRing.v b/plugins/setoid_ring/InitialRing.v
index b92b847b..8362c8c2 100644
--- a/plugins/setoid_ring/InitialRing.v
+++ b/plugins/setoid_ring/InitialRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -155,7 +155,7 @@ Section ZMORPHISM.
Ltac norm := gen_srewrite Rsth Reqe ARth.
Ltac add_push := gen_add_push radd Rsth Reqe ARth.
-(*morphisms are extensionaly equal*)
+(*morphisms are extensionally equal*)
Lemma same_genZ : forall x, [x] == gen_phiZ1 x.
Proof.
destruct x;simpl; try rewrite (same_gen ARth);rrefl.
@@ -246,7 +246,7 @@ Proof (SRth_ARth Nsth Nth).
Lemma Neqb_ok : forall x y, N.eqb x y = true -> x = y.
Proof. exact (fun x y => proj1 (N.eqb_eq x y)). Qed.
-(**Same as above : definition of two,extensionaly equal, generic morphisms *)
+(**Same as above : definition of two, extensionally equal, generic morphisms *)
(**from N to any semi-ring*)
Section NMORPHISM.
Variable R : Type.
@@ -671,7 +671,7 @@ End GEN_DIV.
end.
(* A simple tactic recognizing only 0 and 1. The inv_gen_phiX above
- are only optimisations that directly returns the reifid constant
+ are only optimisations that directly returns the reified constant
instead of resorting to the constant propagation of the simplification
algorithm. *)
Ltac inv_gen_phi rO rI cO cI t :=
diff --git a/plugins/setoid_ring/NArithRing.v b/plugins/setoid_ring/NArithRing.v
index a10eeecc..6c1a79e4 100644
--- a/plugins/setoid_ring/NArithRing.v
+++ b/plugins/setoid_ring/NArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ncring.v b/plugins/setoid_ring/Ncring.v
index 2dc3197d..cd3bef43 100644
--- a/plugins/setoid_ring/Ncring.v
+++ b/plugins/setoid_ring/Ncring.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ncring_initial.v b/plugins/setoid_ring/Ncring_initial.v
index c40e0ffb..96885d2f 100644
--- a/plugins/setoid_ring/Ncring_initial.v
+++ b/plugins/setoid_ring/Ncring_initial.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
@@ -42,7 +42,7 @@ Defined.
(*Instance ZEquality: @Equality Z:= (@eq Z).*)
-(** Two generic morphisms from Z to (abrbitrary) rings, *)
+(** Two generic morphisms from Z to (arbitrary) rings, *)
(**second one is more convenient for proofs but they are ext. equal*)
Section ZMORPHISM.
Context {R:Type}`{Ring R}.
@@ -130,7 +130,7 @@ Ltac rsimpl := simpl.
Qed.
-(*morphisms are extensionaly equal*)
+(*morphisms are extensionally equal*)
Lemma same_genZ : forall x, [x] == gen_phiZ1 x.
Proof.
destruct x;rsimpl; try rewrite same_gen; reflexivity.
diff --git a/plugins/setoid_ring/Ncring_polynom.v b/plugins/setoid_ring/Ncring_polynom.v
index 5845b629..109808ee 100644
--- a/plugins/setoid_ring/Ncring_polynom.v
+++ b/plugins/setoid_ring/Ncring_polynom.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ncring_tac.v b/plugins/setoid_ring/Ncring_tac.v
index 31c9e54d..5e30a130 100644
--- a/plugins/setoid_ring/Ncring_tac.v
+++ b/plugins/setoid_ring/Ncring_tac.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ring.v b/plugins/setoid_ring/Ring.v
index b2417db6..a0844100 100644
--- a/plugins/setoid_ring/Ring.v
+++ b/plugins/setoid_ring/Ring.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ring_base.v b/plugins/setoid_ring/Ring_base.v
index 9508b8e7..dc7c10cc 100644
--- a/plugins/setoid_ring/Ring_base.v
+++ b/plugins/setoid_ring/Ring_base.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ring_polynom.v b/plugins/setoid_ring/Ring_polynom.v
index 2d2756b1..760ad4da 100644
--- a/plugins/setoid_ring/Ring_polynom.v
+++ b/plugins/setoid_ring/Ring_polynom.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/Ring_theory.v b/plugins/setoid_ring/Ring_theory.v
index 4f05f0d4..7fcd6c08 100644
--- a/plugins/setoid_ring/Ring_theory.v
+++ b/plugins/setoid_ring/Ring_theory.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/ZArithRing.v b/plugins/setoid_ring/ZArithRing.v
index 848e06a7..91484372 100644
--- a/plugins/setoid_ring/ZArithRing.v
+++ b/plugins/setoid_ring/ZArithRing.v
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/setoid_ring/newring.ml4 b/plugins/setoid_ring/newring.ml4
index c7185ff2..e704c466 100644
--- a/plugins/setoid_ring/newring.ml4
+++ b/plugins/setoid_ring/newring.ml4
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml
index 0f280aad..5f44904c 100644
--- a/plugins/syntax/nat_syntax.ml
+++ b/plugins/syntax/nat_syntax.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/syntax/numbers_syntax.ml b/plugins/syntax/numbers_syntax.ml
index b990c0d2..fe9f1319 100644
--- a/plugins/syntax/numbers_syntax.ml
+++ b/plugins/syntax/numbers_syntax.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml
index 2c195755..05d73f9e 100644
--- a/plugins/syntax/r_syntax.ml
+++ b/plugins/syntax/r_syntax.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/syntax/z_syntax.ml b/plugins/syntax/z_syntax.ml
index e3721362..53c1b5d7 100644
--- a/plugins/syntax/z_syntax.ml
+++ b/plugins/syntax/z_syntax.ml
@@ -1,6 +1,6 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
diff --git a/plugins/xml/README b/plugins/xml/README
index e3bcdaf0..31281899 100644
--- a/plugins/xml/README
+++ b/plugins/xml/README
@@ -1,15 +1,4 @@
-The xml export plugin for Coq has been discontinued for lack of users:
-it was most certainly broken while imposing a non-negligible cost on
-Coq development. Its purpose was to give export Coq's kernel objects
-in xml form for treatment by external tools.
-
-If you are looking for such a tool, you may want to look at commit
-7cfe0a70eda671ada6a46cd779ef9308f7e0fdb9 responsible for the deletion
-of this plugin (for instance, git checkout
-7cfe0a70eda671ada6a46cd779ef9308f7e0fdb9^ including the "^", will lead
-you to the last commit before the xml plugin was deleted).
-
-Bear in mind, however, that the plugin was not working properly at the
-time. You may want instead to write to the original author of the
-plugin, Claudio Sacerdoti-Coen at sacerdot@cs.unibo.it. He has a
-stable version of the plugin for an old version of Coq.
+The xml export plugin for Coq has been removed from the sources.
+A backward compatible plug-in will be provided as a third-party plugin.
+For more informations, contact
+Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>.