[commit: ghc] wip/7.10-api-annots: Correct parsing of lifted empty list constructor (ad0551c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/7.10-api-annots
Link       : http://ghc.haskell.org/trac/ghc/changeset/ad0551c66bb7e8135e1b116a111f37176955e9f4/ghc

>---------------------------------------------------------------

commit ad0551c66bb7e8135e1b116a111f37176955e9f4
Author: Matthew Pickering <matthewtpickering at gmail.com>
Date:   Wed May 6 08:07:31 2015 -0500

    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


>---------------------------------------------------------------

ad0551c66bb7e8135e1b116a111f37176955e9f4
 compiler/parser/Parser.y                | 28 +++++++++++++++++++++-------
 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 9d794c9..9845791 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 45027d5..bb567a6 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)