aboutsummaryrefslogtreecommitdiffhomepage
path: root/proofs
diff options
context:
space:
mode:
authorGravatar letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7>2011-07-04 18:04:58 +0000
committerGravatar letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7>2011-07-04 18:04:58 +0000
commit7382948497f1ae935bd2b16596e468605a3d8033 (patch)
treebfcc2f4ec453b7989f0d47b15a1ff1667b99d385 /proofs
parentb639dd55cc3bc6ef4cf77a549786209e094830a2 (diff)
Extraction: forbid Prop-polymorphism of inductives when extracting to Ocaml
A particular case in sort-polymorphism of inductive types allows an informative type (such as prod) to have instances in Prop: (I,I) : True * True : Prop This is due to the fact that prod is a singleton type: indeed (I,I) has no informative content. But this invalidates an important invariant for the correctness of the extraction: inductive constructors stop having always the same sort as their inductive type. Consider for instance: Definition f (X:Type)(x:X*X)(g:X->nat) := g (fst x). Definition test := f _ (I,I) (fun _ => 0). Then the inductive element (I,I) is extracted as a logical part __, but during a strict evaluation (i.e. in Ocaml, not Haskell), this __ will be given to fst, and hence to a match, leading to a nasty result (potentially segfault). Haskell is not affected, since fst is never evaluated. This patch adds a check for this situation during any Ocaml extraction, leading for the moment to a fatal error. Some functions in inductive.ml and retyping.ml now have an extra optional argument ?(polyprop=true) that should stay untouched in regular Coq usage, while type-checking done during extraction will disable this prop-polymorphism. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14256 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'proofs')
-rw-r--r--proofs/logic.ml3
1 files changed, 2 insertions, 1 deletions
diff --git a/proofs/logic.ml b/proofs/logic.ml
index b482628b9..e72580e69 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -321,7 +321,8 @@ let check_conv_leq_goal env sigma arg ty conclty =
raise (RefinerError (BadType (arg,ty,conclty)))
let goal_type_of env sigma c =
- (if !check then type_of else Retyping.get_type_of ~refresh:true) env sigma c
+ if !check then type_of env sigma c
+ else Retyping.get_type_of ~refresh:true env sigma c
let rec mk_refgoals sigma goal goalacc conclty trm =
let env = Goal.V82.env sigma goal in