diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2015-05-06 08:07:31 -0500 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2015-05-08 17:39:30 +0200 |
| commit | ad0551c66bb7e8135e1b116a111f37176955e9f4 (patch) | |
| tree | 8ee2ca9d7052368d3bde060f6d8e558befd0f82a | |
| parent | a3dfa1742223585ca77acbd58dc60a3eadcb9ee0 (diff) | |
| download | haskell-ad0551c66bb7e8135e1b116a111f37176955e9f4.tar.gz | |
Correct parsing of lifted empty list constructor
See #10299
Previously `'[]` was parsed to a `HsTyVar` rather than a
`HsExplicitListTy`. This patch fixes the
shift-reduce conflict which caused this problem.
Reviewed By: alanz, austin
Differential Revision: https://phabricator.haskell.org/D840
(cherry picked from commit caeae1a33e28745b51d952b034e253d3e51e0605)
Conflicts:
compiler/parser/Parser.y
| -rw-r--r-- | compiler/parser/Parser.y | 28 | ||||
| -rw-r--r-- | testsuite/tests/th/TH_RichKinds2.stderr | 2 |
2 files changed, 22 insertions, 8 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 9d794c9b28..98457915ef 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1549,7 +1549,7 @@ atype :: { LHsType RdrName } | TH_ID_SPLICE { sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $ mkUnqual varName (getTH_ID_SPLICE $1) } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon { sLL $1 $> $ HsTyVar $ unLoc $2 } + | SIMPLEQUOTE qcon_nowiredlist { sLL $1 $> $ HsTyVar $ unLoc $2 } | SIMPLEQUOTE '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $3) AnnComma (gl $4) >> ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5)) @@ -2625,11 +2625,22 @@ name_var : var { $1 } ----------------------------------------- -- Data constructors -qcon :: { Located RdrName } - : qconid { $1 } - | '(' qconsym ')' {% ams (sLL $1 $> (unLoc $2)) - [mop $1,mj AnnVal $2,mcp $3] } - | sysdcon { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } +-- There are two different productions here as lifted list constructors +-- are parsed differently. + +qcon_nowiredlist :: { Located RdrName } + : gen_qcon { $1 } + | sysdcon_nolist { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } + +qcon :: { Located RdrName } + : gen_qcon { $1} + | sysdcon { sL1 $1 $ nameRdrName (dataConName (unLoc $1)) } + +gen_qcon :: { Located RdrName } + : qconid { $1 } + | '(' qconsym ')' {% ams (sLL $1 $> (unLoc $2)) + [mop $1,mj AnnVal $2,mcp $3] } + -- The case of '[:' ':]' is part of the production `parr' con :: { Located RdrName } @@ -2643,13 +2654,16 @@ con_list : con { sL1 $1 [$1] } | con ',' con_list {% addAnnotation (gl $1) AnnComma (gl $2) >> return (sLL $1 $> ($1 : unLoc $3)) } -sysdcon :: { Located DataCon } -- Wired in data constructors +sysdcon_nolist :: { Located DataCon } -- Wired in data constructors : '(' ')' {% ams (sLL $1 $> unitDataCon) [mop $1,mcp $2] } | '(' commas ')' {% ams (sLL $1 $> $ tupleCon BoxedTuple (snd $2 + 1)) (mop $1:mcp $3:(mcommas (fst $2))) } | '(#' '#)' {% ams (sLL $1 $> $ unboxedUnitDataCon) [mo $1,mc $2] } | '(#' commas '#)' {% ams (sLL $1 $> $ tupleCon UnboxedTuple (snd $2 + 1)) (mo $1:mc $3:(mcommas (fst $2))) } + +sysdcon :: { Located DataCon } + : sysdcon_nolist { $1 } | '[' ']' {% ams (sLL $1 $> nilDataCon) [mos $1,mcs $2] } conop :: { Located RdrName } diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr index 45027d5c1c..bb567a6009 100644 --- a/testsuite/tests/th/TH_RichKinds2.stderr +++ b/testsuite/tests/th/TH_RichKinds2.stderr @@ -3,7 +3,7 @@ TH_RichKinds2.hs:23:4: Warning: data SMaybe_0 (t_1 :: k_0 -> *) (t_3 :: GHC.Base.Maybe k_0) = forall . t_3 ~ 'GHC.Base.Nothing => SNothing_4 | forall a_5 . t_3 ~ 'GHC.Base.Just a_5 => SJust_6 (t_1 a_5) -type instance TH_RichKinds2.Map f_7 'GHC.Types.[] = 'GHC.Types.[] +type instance TH_RichKinds2.Map f_7 '[] = '[] type instance TH_RichKinds2.Map f_8 ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9) (TH_RichKinds2.Map f_8 t_10) |