[commit: ghc] master: parser: allow type-level cons in prefix position (012ea0b)
git at git.haskell.org
git at git.haskell.org
Fri Apr 3 05:49:52 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/012ea0b96cc041bced4565d74bef7ccb75f1af0d/ghc
>---------------------------------------------------------------
commit 012ea0b96cc041bced4565d74bef7ccb75f1af0d
Author: Kinokkory <y.skm24t at gmail.com>
Date: Fri Apr 3 00:47:15 2015 -0500
parser: allow type-level cons in prefix position
Reviewed By: austin
Differential Revision: https://phabricator.haskell.org/D768
GHC Trac Issues: #10188
>---------------------------------------------------------------
012ea0b96cc041bced4565d74bef7ccb75f1af0d
compiler/parser/Parser.y | 48 +++++++++++++++----------
testsuite/tests/parser/should_compile/T10188.hs | 13 +++++++
testsuite/tests/parser/should_compile/all.T | 1 +
3 files changed, 44 insertions(+), 18 deletions(-)
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index d6b7ed6..67c90d5 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -89,10 +89,10 @@ import Util ( looksLikePackageName )
}
-{- Last updated: 03 Mar 2015
+{- Last updated: 30 Mar 2015
-Conflicts: 48 shift/reduce
- 1 reduce/reduce
+Conflicts: 50 shift/reduce
+ 2 reduce/reduce
If you modify this parser and add a conflict, please update this comment.
You can learn more about the conflicts by passing 'happy' the -i flag:
@@ -124,7 +124,7 @@ follows. Shift parses as if the 'module' keyword follows.
-------------------------------------------------------------------------------
-state 49 contains 10 shift/reduce conflicts.
+state 49 contains 11 shift/reduce conflicts.
context -> btype . '~' btype (rule 279)
context -> btype . (rule 280)
@@ -137,7 +137,7 @@ state 49 contains 10 shift/reduce conflicts.
type -> btype . SIMPLEQUOTE varop type (rule 287)
btype -> btype . atype (rule 299)
- Conflicts: '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
+ Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
Example of ambiguity: 'e :: a `b` c'; does this mean
(e::a) `b` c, or
@@ -197,7 +197,7 @@ a rule instructing how to rewrite the expression '[0] f'.
-------------------------------------------------------------------------------
-state 285 contains 10 shift/reduce conflicts.
+state 285 contains 11 shift/reduce conflicts.
*** type -> btype . (rule 281)
type -> btype . qtyconop type (rule 282)
@@ -208,7 +208,7 @@ state 285 contains 10 shift/reduce conflicts.
type -> btype . SIMPLEQUOTE varop type (rule 287)
btype -> btype . atype (rule 299)
- Conflicts: [elided]
+ Conflicts: ':' '->' '-' '!' '*' '.' '`' VARSYM CONSYM QVARSYM QCONSYM
Same as State 49, but minus the context productions.
@@ -218,7 +218,7 @@ state 320 contains 1 shift/reduce conflicts.
tup_exprs -> commas . tup_tail (rule 502)
sysdcon -> '(' commas . ')' (rule 610)
- commas -> commas . ',' (rule 724)
+ commas -> commas . ',' (rule 725)
Conflict: ')' (empty tup_tail reduces)
@@ -265,7 +265,7 @@ TODO: Why?
-------------------------------------------------------------------------------
-state 461 contains 1 shift/reduce conflicts.
+state 462 contains 1 shift/reduce conflicts.
*** strict_mark -> '{-# NOUNPACK' '#-}' . (rule 268)
strict_mark -> '{-# NOUNPACK' '#-}' . '!' (rule 270)
@@ -276,7 +276,7 @@ TODO: Why?
-------------------------------------------------------------------------------
-state 462 contains 1 shift/reduce conflicts.
+state 463 contains 1 shift/reduce conflicts.
*** strict_mark -> '{-# UNPACK' '#-}' . (rule 267)
strict_mark -> '{-# UNPACK' '#-}' . '!' (rule 269)
@@ -287,7 +287,7 @@ Same as State 462
-------------------------------------------------------------------------------
-state 493 contains 1 shift/reduce conflicts.
+state 494 contains 1 shift/reduce conflicts.
context -> btype '~' btype . (rule 279)
*** type -> btype '~' btype . (rule 285)
@@ -299,7 +299,7 @@ TODO: Why?
-------------------------------------------------------------------------------
-state 628 contains 1 shift/reduce conflicts.
+state 629 contains 1 shift/reduce conflicts.
*** aexp2 -> ipvar . (rule 462)
dbind -> ipvar . '=' exp (rule 587)
@@ -314,7 +314,7 @@ sensible meaning, namely the lhs of an implicit binding.
-------------------------------------------------------------------------------
-state 695 contains 1 shift/reduce conflicts.
+state 696 contains 1 shift/reduce conflicts.
rule -> STRING rule_activation . rule_forall infixexp '=' exp (rule 214)
@@ -331,7 +331,7 @@ doesn't include 'forall'.
-------------------------------------------------------------------------------
-state 768 contains 1 shift/reduce conflicts.
+state 769 contains 1 shift/reduce conflicts.
*** type -> btype '~' btype . (rule 285)
btype -> btype . atype (rule 299)
@@ -342,11 +342,11 @@ TODO: Why?
-------------------------------------------------------------------------------
-state 951 contains 1 shift/reduce conflicts.
+state 952 contains 1 shift/reduce conflicts.
transformqual -> 'then' 'group' . 'using' exp (rule 525)
transformqual -> 'then' 'group' . 'by' exp 'using' exp (rule 526)
- *** special_id -> 'group' . (rule 700)
+ *** special_id -> 'group' . (rule 701)
Conflict: 'by'
@@ -354,10 +354,21 @@ TODO: Why?
-------------------------------------------------------------------------------
-state 1228 contains 1 reduce/reduce conflicts.
+state 1229 contains 1 reduce/reduce conflicts.
+
+ *** tyconsym -> ':' . (rule 642)
+ consym -> ':' . (rule 712)
+
+ Conflict: ')'
+
+TODO: Same as State 1230
+
+-------------------------------------------------------------------------------
+
+state 1230 contains 1 reduce/reduce conflicts.
*** tyconsym -> CONSYM . (rule 640)
- consym -> CONSYM . (rule 710)
+ consym -> CONSYM . (rule 711)
Conflict: ')'
@@ -2857,6 +2868,7 @@ qtyconsym :: { Located RdrName }
tyconsym :: { Located RdrName }
: CONSYM { sL1 $1 $! mkUnqual tcClsName (getCONSYM $1) }
| VARSYM { sL1 $1 $! mkUnqual tcClsName (getVARSYM $1) }
+ | ':' { sL1 $1 $! consDataCon_RDR }
| '*' { sL1 $1 $! mkUnqual tcClsName (fsLit "*") }
| '-' { sL1 $1 $! mkUnqual tcClsName (fsLit "-") }
diff --git a/testsuite/tests/parser/should_compile/T10188.hs b/testsuite/tests/parser/should_compile/T10188.hs
new file mode 100644
index 0000000..f12a197
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T10188.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies #-}
+
+module T10188 where
+
+data Peano = Zero | Succ Peano
+
+type family Length (as :: [k]) :: Peano where
+ Length (a : as) = Succ (Length as)
+ Length '[] = Zero
+
+type family Length' (as :: [k]) :: Peano where
+ Length' ((:) a as) = Succ (Length' as)
+ Length' '[] = Zero
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 6eb593a..9e7612c 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -100,3 +100,4 @@ test('RdrNoStaticPointers01', when(compiler_lt('ghc', '7.9'), skip), compile, ['
test('T5682', normal, compile, [''])
test('T9723a', normal, compile, [''])
test('T9723b', normal, compile, [''])
+test('T10188', normal, compile, [''])
More information about the ghc-commits
mailing list