aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre Letouzey2015-05-12 16:48:01 +0200
committerPierre Letouzey2015-05-12 17:08:25 +0200
commit95b4a54ec6a9aacffe8c11df1b443d36b9f6dda7 (patch)
tree5413999a61ff5eb635a581fc1d2ae41ebe74d54a
parent20fd4f91c5096d2f9c06f2bdca23127be4d81aad (diff)
Extraction: fix the detection of the "polyprop" situation
The ~polyprop argument wasn't propagated properly anymore, leading the extraction to try to operate on situations it cannot handle (yet). Cf Table.error_singleton_become_prop for more details. Regression test added.
-rw-r--r--kernel/inductive.ml2
-rw-r--r--test-suite/success/extraction_polyprop.v11
2 files changed, 12 insertions, 1 deletions
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index ca814f497c..088b99b9e0 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -214,7 +214,7 @@ let constrained_type_of_inductive_knowing_parameters env ((mib,mip),u as pind) a
(ty, cst)
let type_of_inductive_knowing_parameters env ?(polyprop=false) mip args =
- type_of_inductive_gen env mip args
+ type_of_inductive_gen ~polyprop env mip args
(* The max of an array of universes *)
diff --git a/test-suite/success/extraction_polyprop.v b/test-suite/success/extraction_polyprop.v
new file mode 100644
index 0000000000..7215bd9905
--- /dev/null
+++ b/test-suite/success/extraction_polyprop.v
@@ -0,0 +1,11 @@
+(* The current extraction cannot handle this situation,
+ and shouldn't try, otherwise it might produce some Ocaml
+ code that segfaults. See Table.error_singleton_become_prop
+ or S. Glondu's thesis for more details. *)
+
+Definition f {X} (p : (nat -> X) * True) : X * nat :=
+ (fst p 0, 0).
+
+Definition f_prop := f ((fun _ => I),I).
+
+Fail Extraction f_prop.