aboutsummaryrefslogtreecommitdiffhomepage
path: root/test-suite/bugs
diff options
context:
space:
mode:
authorGravatar herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>2011-11-21 11:41:31 +0000
committerGravatar herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7>2011-11-21 11:41:31 +0000
commit9cd97943a5db0967778163b9a701ccaf9c5a6b19 (patch)
tree257cd9c3709256dfa51f7e89aa1d239e016ba582 /test-suite/bugs
parent8cd666c100ae757b70d73f502878e4c939864ecc (diff)
Extend the computation of dependencies in pattern-matching compilation
to the dependencies in the real arguments (a.k.a. indices) of the terms to match. This allows in particular to make the example from bug report #2404 work. TODO: move the computation of dependencies in compile_branch at the time of splitting a branch (where the computation is done now, it does not allow to support dependent matching on the second argument of a constructor of type "forall b, (if b then Vector.t n else nat) -> Vector.t n -> foo"). TODO: take dependencies in Var's into account and take dependencies within non-Rel arguments also into account (as in "match v (f t) with ... end" where v is a Var and the type of (f t) depends on it). git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14711 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'test-suite/bugs')
-rw-r--r--test-suite/bugs/closed/shouldsucceed/2404.v46
1 files changed, 46 insertions, 0 deletions
diff --git a/test-suite/bugs/closed/shouldsucceed/2404.v b/test-suite/bugs/closed/shouldsucceed/2404.v
new file mode 100644
index 000000000..fe8eba549
--- /dev/null
+++ b/test-suite/bugs/closed/shouldsucceed/2404.v
@@ -0,0 +1,46 @@
+(* Check that dependencies in the indices of the type of the terms to
+ match are taken into account and correctly generalized *)
+
+Require Import Relations.Relation_Definitions.
+Require Import Basics.
+
+Record Base := mkBase
+ {(* Primitives *)
+ World : Set
+ (* Names are real, links are theoretical *)
+ ; Name : World -> Set
+
+ ; wweak : World -> World -> Prop
+
+ ; exportw : forall a b : World, (wweak a b) -> (Name b) -> option (Name a)
+}.
+
+Section Derived.
+ Variable base : Base.
+ Definition bWorld := World base.
+ Definition bName := Name base.
+ Definition bexportw := exportw base.
+ Definition bwweak := wweak base.
+
+ Implicit Arguments bexportw [a b].
+
+Inductive RstarSetProof {I : Type} (T : I -> I -> Type) : I -> I -> Type :=
+ starReflS : forall a, RstarSetProof T a a
+| starTransS : forall i j k, T i j -> (RstarSetProof T j k) -> RstarSetProof T i k.
+
+Implicit Arguments starTransS [I T i j k].
+
+Definition RstarInv {A : Set} (rel : relation A) : A -> A -> Type := (flip (RstarSetProof (flip rel))).
+
+Definition bwweakFlip (b a : bWorld) : Prop := (bwweak a b).
+Definition Rweak : forall a b : bWorld, Type := RstarInv bwweak.
+
+Fixpoint exportRweak {a b} (aRWb : Rweak a b) (y : bName b) : option (bName a) :=
+ match aRWb,y with
+ | starReflS a, y' => Some y'
+ | starTransS i j k jWk jRWi, y' =>
+ match (bexportw jWk y) with
+ | Some x => exportRweak jRWi x
+ | None => None
+ end
+ end.