Parser.y

--                                                              -*-haskell-*-
-- ---------------------------------------------------------------------------
-- (c) The University of Glasgow 1997-2003
---
-- The GHC grammar.
--
-- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
-- ---------------------------------------------------------------------------

{
-- | This module provides the generated Happy parser for Haskell. It exports
-- a number of parsers which may be used in any library that uses the GHC API.
-- A common usage pattern is to initialize the parser state with a given string
-- and then parse that string:
--
-- @
--     runParser :: DynFlags -> String -> P a -> ParseResult a
--     runParser flags str parser = unP parser parseState
--     where
--       filename = "\<interactive\>"
--       location = mkRealSrcLoc (mkFastString filename) 1 1
--       buffer = stringToStringBuffer str
--       parseState = mkPState flags buffer location
-- @
module Parser (parseModule, parseImport, parseStatement,
               parseDeclaration, parseExpression, parsePattern,
               parseTypeSignature,
               parseStmt, parseIdentifier,
               parseType, parseHeader) where

-- base
import Control.Monad    ( unless, liftM )
import GHC.Exts
import Data.Char
import Control.Monad    ( mplus )
import Control.Applicative ((<$))

-- compiler/hsSyn
import HsSyn

-- compiler/main
import HscTypes         ( IsBootInterface, WarningTxt(..) )
import DynFlags

-- compiler/utils
import OrdList
import BooleanFormula   ( BooleanFormula(..), LBooleanFormula(..), mkTrue )
import FastString
import Maybes           ( orElse )
import Outputable

-- compiler/basicTypes
import RdrName
import OccName          ( varName, dataName, tcClsName, tvName, startsWithUnderscore )
import DataCon          ( DataCon, dataConName )
import SrcLoc
import Module
import BasicTypes

-- compiler/types
import Type             ( funTyCon )
import Kind             ( Kind )
import Class            ( FunDep )

-- compiler/parser
import RdrHsSyn
import Lexer
import HaddockUtils
import ApiAnnotation

-- compiler/typecheck
import TcEvidence       ( emptyTcEvBinds )

-- compiler/prelude
import ForeignCall
import TysPrim          ( eqPrimTyCon )
import PrelNames        ( eqTyCon_RDR )
import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
                          unboxedUnitTyCon, unboxedUnitDataCon,
                          listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )

-- compiler/utils
import Util             ( looksLikePackageName )
import Prelude

import qualified GHC.LanguageExtensions as LangExt
}

{- Last updated: 18 Nov 2015

Conflicts: 36 shift/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:

    happy -agc --strict compiler/parser/Parser.y -idetailed-info

How is this section formatted? Look up the state the conflict is
reported at, and copy the list of applicable rules (at the top).  Mark
*** for the rule that is the conflicting reduction (that is, the
interpretation which is NOT taken).  NB: Happy doesn't print a rule in a
state if it is empty, but you should include it in the list (you can
look these up in the Grammar section of the info file).

Obviously the state numbers are not stable across modifications to the parser,
the idea is to reproduce enough information on each conflict so you can figure
out what happened if the states were renumbered.  Try not to gratuitously move
productions around in this file.  It's probably less important to keep
the rule annotations up-to-date.

-------------------------------------------------------------------------------

state 0 contains 1 shift/reduce conflicts.

    Conflicts: DOCNEXT (empty missing_module_keyword reduces)

Ambiguity when the source file starts with "-- | doc". We need another
token of lookahead to determine if a top declaration or the 'module' keyword
follows. Shift parses as if the 'module' keyword follows.

-------------------------------------------------------------------------------

state 46 contains 2 shift/reduce conflicts.

    *** strict_mark -> unpackedness .                       (rule 268)
        strict_mark -> unpackedness . strictness            (rule 269)

    Conflicts: '~' '!'

-------------------------------------------------------------------------------

state 50 contains 1 shift/reduce conflict.

        context -> btype .                                  (rule 295)
    *** type -> btype .                                     (rule 297)
        type -> btype . '->' ctype                          (rule 298)

    Conflicts: '->'

-------------------------------------------------------------------------------

state 51 contains 9 shift/reduce conflicts.

    *** btype -> tyapps .                                   (rule 303)
        tyapps -> tyapps . tyapp                            (rule 307)

    Conflicts: ':' '-' '!' '.' '`' VARSYM CONSYM QVARSYM QCONSYM

-------------------------------------------------------------------------------

state 132 contains 14 shift/reduce conflicts.

        exp -> infixexp . '::' sigtype                      (rule 416)
        exp -> infixexp . '-<' exp                          (rule 417)
        exp -> infixexp . '>-' exp                          (rule 418)
        exp -> infixexp . '-<<' exp                         (rule 419)
        exp -> infixexp . '>>-' exp                         (rule 420)
    *** exp -> infixexp .                                   (rule 421)
        infixexp -> infixexp . qop exp10                    (rule 423)

    Conflicts: ':' '::' '-' '!' '-<' '>-' '-<<' '>>-'
               '.' '`' VARSYM CONSYM QVARSYM QCONSYM

Examples of ambiguity:
    'if x then y else z -< e'
    'if x then y else z :: T'
    'if x then y else z + 1' (NB: '+' is in VARSYM)

Shift parses as (per longest-parse rule):
    'if x then y else (z -< T)'
    'if x then y else (z :: T)'
    'if x then y else (z + 1)'

-------------------------------------------------------------------------------

state 292 contains 1 shift/reduce conflicts.

        rule -> STRING . rule_activation rule_forall infixexp '=' exp    (rule 215)

    Conflict: '[' (empty rule_activation reduces)

We don't know whether the '[' starts the activation or not: it
might be the start of the declaration with the activation being
empty.  --SDM 1/4/2002

Example ambiguity:
    '{-# RULE [0] f = ... #-}'

We parse this as having a [0] rule activation for rewriting 'f', rather
a rule instructing how to rewrite the expression '[0] f'.

-------------------------------------------------------------------------------

state 301 contains 1 shift/reduce conflict.

    *** type -> btype .                                     (rule 297)
        type -> btype . '->' ctype                          (rule 298)

    Conflict: '->'

Same as state 50 but without contexts.

-------------------------------------------------------------------------------

state 337 contains 1 shift/reduce conflicts.

        tup_exprs -> commas . tup_tail                      (rule 505)
        sysdcon_nolist -> '(' commas . ')'                  (rule 616)
        commas -> commas . ','                              (rule 734)

    Conflict: ')' (empty tup_tail reduces)

A tuple section with NO free variables '(,,)' is indistinguishable
from the Haskell98 data constructor for a tuple.  Shift resolves in
favor of sysdcon, which is good because a tuple section will get rejected
if -XTupleSections is not specified.

-------------------------------------------------------------------------------

state 388 contains 1 shift/reduce conflicts.

        tup_exprs -> commas . tup_tail                      (rule 505)
        sysdcon_nolist -> '(#' commas . '#)'                (rule 618)
        commas -> commas . ','                              (rule 734)

    Conflict: '#)' (empty tup_tail reduces)

Same as State 324 for unboxed tuples.

-------------------------------------------------------------------------------

state 460 contains 1 shift/reduce conflict.

        oqtycon -> '(' qtyconsym . ')'                      (rule 621)
    *** qtyconop -> qtyconsym .                             (rule 628)

    Conflict: ')'

TODO: Why?

-------------------------------------------------------------------------------

state 635 contains 1 shift/reduce conflicts.

    *** aexp2 -> ipvar .                                    (rule 466)
        dbind -> ipvar . '=' exp                            (rule 590)

    Conflict: '='

Example ambiguity: 'let ?x ...'

The parser can't tell whether the ?x is the lhs of a normal binding or
an implicit binding.  Fortunately, resolving as shift gives it the only
sensible meaning, namely the lhs of an implicit binding.

-------------------------------------------------------------------------------

state 702 contains 1 shift/reduce conflicts.

        rule -> STRING rule_activation . rule_forall infixexp '=' exp    (rule 215)

    Conflict: 'forall' (empty rule_forall reduces)

Example ambiguity: '{-# RULES "name" forall = ... #-}'

'forall' is a valid variable name---we don't know whether
to treat a forall on the input as the beginning of a quantifier
or the beginning of the rule itself.  Resolving to shift means
it's always treated as a quantifier, hence the above is disallowed.
This saves explicitly defining a grammar for the rule lhs that
doesn't include 'forall'.

-------------------------------------------------------------------------------

state 930 contains 1 shift/reduce conflicts.

        transformqual -> 'then' 'group' . 'using' exp       (rule 528)
        transformqual -> 'then' 'group' . 'by' exp 'using' exp    (rule 529)
    *** special_id -> 'group' .                             (rule 711)

    Conflict: 'by'

-------------------------------------------------------------------------------

state 1270 contains 1 shift/reduce conflict.

    *** atype -> tyvar .                                    (rule 314)
        tv_bndr -> '(' tyvar . '::' kind ')'                (rule 346)

    Conflict: '::'

TODO: Why?

-------------------------------------------------------------------------------
-- API Annotations
--

A lot of the productions are now cluttered with calls to
aa,am,ams,amms etc.

These are helper functions to make sure that the locations of the
various keywords such as do / let / in are captured for use by tools
that want to do source to source conversions, such as refactorers or
structured editors.

The helper functions are defined at the bottom of this file.

See
  https://ghc.haskell.org/trac/ghc/wiki/ApiAnnotations and
  https://ghc.haskell.org/trac/ghc/wiki/GhcAstAnnotations
for some background.

If you modify the parser and want to ensure that the API annotations are processed
correctly, see the README in (REPO)/utils/check-api-annotations for details on
how to set up a test using the check-api-annotations utility, and interpret the
output it generates.

-- -----------------------------------------------------------------------------

-}

%token
 '_'            { L _ ITunderscore }            -- Haskell keywords
 'as'           { L _ ITas }
 'case'         { L _ ITcase }
 'class'        { L _ ITclass }
 'data'         { L _ ITdata }
 'default'      { L _ ITdefault }
 'deriving'     { L _ ITderiving }
 'do'           { L _ ITdo }
 'else'         { L _ ITelse }
 'hiding'       { L _ IThiding }
 'if'           { L _ ITif }
 'import'       { L _ ITimport }
 'in'           { L _ ITin }
 'infix'        { L _ ITinfix }
 'infixl'       { L _ ITinfixl }
 'infixr'       { L _ ITinfixr }
 'instance'     { L _ ITinstance }
 'let'          { L _ ITlet }
 'module'       { L _ ITmodule }
 'newtype'      { L _ ITnewtype }
 'of'           { L _ ITof }
 'qualified'    { L _ ITqualified }
 'then'         { L _ ITthen }
 'type'         { L _ ITtype }
 'where'        { L _ ITwhere }

 'forall'       { L _ (ITforall _) }                -- GHC extension keywords
 'foreign'      { L _ ITforeign }
 'export'       { L _ ITexport }
 'label'        { L _ ITlabel }
 'dynamic'      { L _ ITdynamic }
 'safe'         { L _ ITsafe }
 'interruptible' { L _ ITinterruptible }
 'unsafe'       { L _ ITunsafe }
 'mdo'          { L _ ITmdo }
 'family'       { L _ ITfamily }
 'role'         { L _ ITrole }
 'stdcall'      { L _ ITstdcallconv }
 'ccall'        { L _ ITccallconv }
 'capi'         { L _ ITcapiconv }
 'prim'         { L _ ITprimcallconv }
 'javascript'   { L _ ITjavascriptcallconv }
 'proc'         { L _ ITproc }          -- for arrow notation extension
 'rec'          { L _ ITrec }           -- for arrow notation extension
 'group'    { L _ ITgroup }     -- for list transform extension
 'by'       { L _ ITby }        -- for list transform extension
 'using'    { L _ ITusing }     -- for list transform extension
 'pattern'      { L _ ITpattern } -- for pattern synonyms
 'static'       { L _ ITstatic }  -- for static pointers extension

 '{-# INLINE'             { L _ (ITinline_prag _ _ _) }
 '{-# SPECIALISE'         { L _ (ITspec_prag _) }
 '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _ _) }
 '{-# SOURCE'             { L _ (ITsource_prag _) }
 '{-# RULES'              { L _ (ITrules_prag _) }
 '{-# CORE'               { L _ (ITcore_prag _) }      -- hdaume: annotated core
 '{-# SCC'                { L _ (ITscc_prag _)}
 '{-# GENERATED'          { L _ (ITgenerated_prag _) }
 '{-# DEPRECATED'         { L _ (ITdeprecated_prag _) }
 '{-# WARNING'            { L _ (ITwarning_prag _) }
 '{-# UNPACK'             { L _ (ITunpack_prag _) }
 '{-# NOUNPACK'           { L _ (ITnounpack_prag _) }
 '{-# ANN'                { L _ (ITann_prag _) }
 '{-# VECTORISE'          { L _ (ITvect_prag _) }
 '{-# VECTORISE_SCALAR'   { L _ (ITvect_scalar_prag _) }
 '{-# NOVECTORISE'        { L _ (ITnovect_prag _) }
 '{-# MINIMAL'            { L _ (ITminimal_prag _) }
 '{-# CTYPE'              { L _ (ITctype _) }
 '{-# OVERLAPPING'        { L _ (IToverlapping_prag _) }
 '{-# OVERLAPPABLE'       { L _ (IToverlappable_prag _) }
 '{-# OVERLAPS'           { L _ (IToverlaps_prag _) }
 '{-# INCOHERENT'         { L _ (ITincoherent_prag _) }
 '#-}'                    { L _ ITclose_prag }

 '..'           { L _ ITdotdot }                        -- reserved symbols
 ':'            { L _ ITcolon }
 '::'           { L _ (ITdcolon _) }
 '='            { L _ ITequal }
 '\\'           { L _ ITlam }
 'lcase'        { L _ ITlcase }
 '|'            { L _ ITvbar }
 '<-'           { L _ (ITlarrow _) }
 '->'           { L _ (ITrarrow _) }
 '@'            { L _ ITat }
 '~'            { L _ ITtilde }
 '~#'           { L _ ITtildehsh }
 '=>'           { L _ (ITdarrow _) }
 '-'            { L _ ITminus }
 '!'            { L _ ITbang }
 '-<'           { L _ (ITlarrowtail _) }            -- for arrow notation
 '>-'           { L _ (ITrarrowtail _) }            -- for arrow notation
 '-<<'          { L _ (ITLarrowtail _) }            -- for arrow notation
 '>>-'          { L _ (ITRarrowtail _) }            -- for arrow notation
 '.'            { L _ ITdot }
 TYPEAPP        { L _ ITtypeApp }

 '{'            { L _ ITocurly }                        -- special symbols
 '}'            { L _ ITccurly }
 vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
 vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
 '['            { L _ ITobrack }
 ']'            { L _ ITcbrack }
 '[:'           { L _ ITopabrack }
 ':]'           { L _ ITcpabrack }
 '('            { L _ IToparen }
 ')'            { L _ ITcparen }
 '(#'           { L _ IToubxparen }
 '#)'           { L _ ITcubxparen }
 '(|'           { L _ IToparenbar }
 '|)'           { L _ ITcparenbar }
 ';'            { L _ ITsemi }
 ','            { L _ ITcomma }
 '`'            { L _ ITbackquote }
 SIMPLEQUOTE    { L _ ITsimpleQuote      }     -- 'x

 VARID          { L _ (ITvarid    _) }          -- identifiers
 CONID          { L _ (ITconid    _) }
 VARSYM         { L _ (ITvarsym   _) }
 CONSYM         { L _ (ITconsym   _) }
 QVARID         { L _ (ITqvarid   _) }
 QCONID         { L _ (ITqconid   _) }
 QVARSYM        { L _ (ITqvarsym  _) }
 QCONSYM        { L _ (ITqconsym  _) }

 IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
 LABELVARID     { L _ (ITlabelvarid   _) }

 CHAR           { L _ (ITchar   _ _) }
 STRING         { L _ (ITstring _ _) }
 INTEGER        { L _ (ITinteger _ _) }
 RATIONAL       { L _ (ITrational _) }

 PRIMCHAR       { L _ (ITprimchar   _ _) }
 PRIMSTRING     { L _ (ITprimstring _ _) }
 PRIMINTEGER    { L _ (ITprimint    _ _) }
 PRIMWORD       { L _ (ITprimword   _ _) }
 PRIMFLOAT      { L _ (ITprimfloat  _) }
 PRIMDOUBLE     { L _ (ITprimdouble _) }

 DOCNEXT        { L _ (ITdocCommentNext _) }
 DOCPREV        { L _ (ITdocCommentPrev _) }
 DOCNAMED       { L _ (ITdocCommentNamed _) }
 DOCSECTION     { L _ (ITdocSection _ _) }

-- Template Haskell
'[|'            { L _ (ITopenExpQuote _) }
'[p|'           { L _ ITopenPatQuote  }
'[t|'           { L _ ITopenTypQuote  }
'[d|'           { L _ ITopenDecQuote  }
'|]'            { L _ ITcloseQuote    }
'[||'           { L _ (ITopenTExpQuote _) }
'||]'           { L _ ITcloseTExpQuote  }
TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
'$('            { L _ ITparenEscape   }     -- $( exp )
TH_ID_TY_SPLICE { L _ (ITidTyEscape _)  }   -- $$x
'$$('           { L _ ITparenTyEscape   }   -- $$( exp )
TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }

%monad { P } { >>= } { return }
%lexer { (lexer True) } { L _ ITeof }
%tokentype { (Located Token) }

-- Exported parsers
%name parseModule module
%name parseImport importdecl
%name parseStatement stmt
%name parseDeclaration topdecl
%name parseExpression exp
%name parsePattern pat
%name parseTypeSignature sigdecl
%name parseStmt   maybe_stmt
%name parseIdentifier  identifier
%name parseType ctype
%partial parseHeader header
%%

-----------------------------------------------------------------------------
-- Identifiers; one of the entry points
identifier :: { Located RdrName }
        : qvar                          { $1 }
        | qcon                          { $1 }
        | qvarop                        { $1 }
        | qconop                        { $1 }
    | '(' '->' ')'      {% ams (sLL $1 $> $ getRdrName funTyCon)
                               [mj AnnOpenP $1,mu AnnRarrow $2,mj AnnCloseP $3] }

-----------------------------------------------------------------------------
-- Module Header

-- The place for module deprecation is really too restrictive, but if it
-- was allowed at its natural place just before 'module', we get an ugly
-- s/r conflict with the second alternative. Another solution would be the
-- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
-- either, and DEPRECATED is only expected to be used by people who really
-- know what they are doing. :-)

module :: { Located (HsModule RdrName) }
       : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
             {% fileSrcSpan >>= \ loc ->
                ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
                              (snd $ snd $7) $4 $1)
                    )
                    ([mj AnnModule $2, mj AnnWhere $6] ++ fst $7) }
        | body2
                {% fileSrcSpan >>= \ loc ->
                   ams (L loc (HsModule Nothing Nothing
                               (fst $ snd $1) (snd $ snd $1) Nothing Nothing))
                       (fst $1) }

maybedocheader :: { Maybe LHsDocString }
        : moduleheader            { $1 }
        | {- empty -}             { Nothing }

missing_module_keyword :: { () }
        : {- empty -}                           {% pushCurrentContext }

maybemodwarning :: { Maybe (Located WarningTxt) }
    : '{-# DEPRECATED' strings '#-}'
                      {% ajs (Just (sLL $1 $> $ DeprecatedTxt (sL1 $1 (getDEPRECATED_PRAGs $1)) (snd $ unLoc $2)))
                             (mo $1:mc $3: (fst $ unLoc $2)) }
    | '{-# WARNING' strings '#-}'
                         {% ajs (Just (sLL $1 $> $ WarningTxt (sL1 $1 (getWARNING_PRAGs $1)) (snd $ unLoc $2)))
                                (mo $1:mc $3 : (fst $ unLoc $2)) }
    |  {- empty -}                  { Nothing }

body    :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
        :  '{'            top '}'      { (moc $1:mcc $3:(fst $2)
                                         , snd $2) }
        |      vocurly    top close    { (fst $2, snd $2) }

body2   :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
        :  '{' top '}'                          { (moc $1:mcc $3
                                                   :(fst $2), snd $2) }
        |  missing_module_keyword top close     { ([],snd $2) }

top     :: { ([AddAnn]
             ,([LImportDecl RdrName], [LHsDecl RdrName])) }
        : importdecls                   { (fst $1
                                          ,(reverse $ snd $1,[]))}
        | importdecls ';' cvtopdecls    {% if null (snd $1)
                                             then return ((mj AnnSemi $2:(fst $1))
                                                         ,(reverse $ snd $1,$3))
                                             else do
                                              { addAnnotation (gl $ head $ snd $1)
                                                              AnnSemi (gl $2)
                                              ; return (fst $1
                                                       ,(reverse $ snd $1,$3)) }}
        | cvtopdecls                    { ([],([],$1)) }

cvtopdecls :: { [LHsDecl RdrName] }
        : topdecls                              { cvTopDecls $1 }

-----------------------------------------------------------------------------
-- Module declaration & imports only

header  :: { Located (HsModule RdrName) }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
                {% fileSrcSpan >>= \ loc ->
                   ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
                          )) [mj AnnModule $2,mj AnnWhere $6] }
        | header_body2
                {% fileSrcSpan >>= \ loc ->
                   return (L loc (HsModule Nothing Nothing $1 [] Nothing
                          Nothing)) }

header_body :: { [LImportDecl RdrName] }
        :  '{'            importdecls           { snd $2 }
        |      vocurly    importdecls           { snd $2 }

header_body2 :: { [LImportDecl RdrName] }
        :  '{' importdecls                      { snd $2 }
        |  missing_module_keyword importdecls   { snd $2 }

-----------------------------------------------------------------------------
-- The Export List

maybeexports :: { (Maybe (Located [LIE RdrName])) }
        :  '(' exportlist ')'       {% ams (sLL $1 $> ()) [mop $1,mcp $3] >>
                                       return (Just (sLL $1 $> (fromOL $2))) }
        |  {- empty -}              { Nothing }

exportlist :: { OrdList (LIE RdrName) }
        : expdoclist ',' expdoclist   {% addAnnotation (oll $1) AnnComma (gl $2)
                                         >> return ($1 `appOL` $3) }
        | exportlist1                 { $1 }

exportlist1 :: { OrdList (LIE RdrName) }
        : expdoclist export expdoclist ',' exportlist1
                          {% (addAnnotation (oll ($1 `appOL` $2 `appOL` $3))
                                            AnnComma (gl $4) ) >>
                              return ($1 `appOL` $2 `appOL` $3 `appOL` $5) }
        | expdoclist export expdoclist             { $1 `appOL` $2 `appOL` $3 }
        | expdoclist                               { $1 }

expdoclist :: { OrdList (LIE RdrName) }
        : exp_doc expdoclist                           { $1 `appOL` $2 }
        | {- empty -}                                  { nilOL }

exp_doc :: { OrdList (LIE RdrName) }
        : docsection    { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup n doc)) }
        | docnamed      { unitOL (sL1 $1 (IEDocNamed ((fst . unLoc) $1))) }
        | docnext       { unitOL (sL1 $1 (IEDoc (unLoc $1))) }


   -- No longer allow things like [] and (,,,) to be exported
   -- They are built in syntax, always available
export  :: { OrdList (LIE RdrName) }
        : qcname_ext export_subspec  {% mkModuleImpExp $1 (snd $ unLoc $2)
                                          >>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) }
        |  'module' modid            {% amsu (sLL $1 $> (IEModuleContents $2))
                                             [mj AnnModule $1] }
        |  'pattern' qcon            {% amsu (sLL $1 $> (IEVar $2))
                                             [mj AnnPattern $1] }

export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
        : {- empty -}             { sL0 ([],ImpExpAbs) }
        | '(' qcnames ')'         {% mkImpExpSubSpec (reverse (snd $2))
                                      >>= \(as,ie) -> return $ sLL $1 $>
                                            (as ++ [mop $1,mcp $3] ++ fst $2, ie) }


qcnames :: { ([AddAnn], [Located (Maybe RdrName)]) }
  : {- empty -}                   { ([],[]) }
  | qcnames1                      { $1 }

qcnames1 :: { ([AddAnn], [Located (Maybe RdrName)]) }     -- A reversed list
        :  qcnames1 ',' qcname_ext_w_wildcard  {% case (head (snd $1)) of
                                                    l@(L _ Nothing) ->
                                                       return ([mj AnnComma $2, mj AnnDotdot l]
                                                               ,(snd (unLoc $3)  : snd $1))
                                                    l -> (ams (head (snd $1)) [mj AnnComma $2] >>
                                                          return (fst $1 ++ fst (unLoc $3),
                                                                  snd (unLoc $3) : snd $1)) }


        -- Annotations re-added in mkImpExpSubSpec
        |  qcname_ext_w_wildcard                   { (fst (unLoc $1),[snd (unLoc $1)]) }

-- Variable, data constructor or wildcard
-- or tagged type constructor
qcname_ext_w_wildcard :: { Located ([AddAnn],Located (Maybe RdrName)) }
        :  qcname_ext               { sL1 $1 ([],Just `fmap` $1) }
        |  '..'                     { sL1 $1 ([mj AnnDotdot $1], sL1 $1 Nothing) }

qcname_ext :: { Located RdrName }
        :  qcname                   { $1 }
        |  'type' oqtycon           {% amms (mkTypeImpExp (sLL $1 $> (unLoc $2)))
                                            [mj AnnType $1,mj AnnVal $2] }

qcname  :: { Located RdrName }  -- Variable or type constructor
        :  qvar                 { $1 }
        |  oqtycon_no_varcon    { $1 } -- see Note [Type constructors in export list]

-----------------------------------------------------------------------------
-- Import Declarations

-- import decls can be *empty*, or even just a string of semicolons
-- whereas topdecls must contain at least one topdecl.

importdecls :: { ([AddAnn],[LImportDecl RdrName]) }
        : importdecls ';' importdecl
                                {% if null (snd $1)
                                     then return (mj AnnSemi $2:fst $1,$3 : snd $1)
                                     else do
                                      { addAnnotation (gl $ head $ snd $1)
                                                      AnnSemi (gl $2)
                                      ; return (fst $1,$3 : snd $1) } }
        | importdecls ';'       {% if null (snd $1)
                                     then return ((mj AnnSemi $2:fst $1),snd $1)
                                     else do
                                       { addAnnotation (gl $ head $ snd $1)
                                                       AnnSemi (gl $2)
                                       ; return $1} }
        | importdecl             { ([],[$1]) }
        | {- empty -}            { ([],[]) }

importdecl :: { LImportDecl RdrName }
        : 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
                {% ams (L (comb4 $1 $6 (snd $7) $8) $
                  ImportDecl { ideclSourceSrc = snd $ fst $2
                             , ideclName = $6, ideclPkgQual = snd $5
                             , ideclSource = snd $2, ideclSafe = snd $3
                             , ideclQualified = snd $4, ideclImplicit = False
                             , ideclAs = unLoc (snd $7)
                             , ideclHiding = unLoc $8 })
                   ((mj AnnImport $1 : (fst $ fst $2) ++ fst $3 ++ fst $4
                                    ++ fst $5 ++ fst $7)) }

maybe_src :: { (([AddAnn],Maybe SourceText),IsBootInterface) }
        : '{-# SOURCE' '#-}'        { (([mo $1,mc $2],Just (getSOURCE_PRAGs $1))
                                      ,True) }
        | {- empty -}               { (([],Nothing),False) }

maybe_safe :: { ([AddAnn],Bool) }
        : 'safe'                                { ([mj AnnSafe $1],True) }
        | {- empty -}                           { ([],False) }

maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
        : STRING  {% let pkgFS = getSTRING $1 in
                     if looksLikePackageName (unpackFS pkgFS)
                        then return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS))
                        else parseErrorSDoc (getLoc $1) $ vcat [
                             text "parse error" <> colon <+> quotes (ppr pkgFS),
                             text "Version number or non-alphanumeric" <+>
                             text "character in package name"] }
        | {- empty -}                           { ([],Nothing) }

optqualified :: { ([AddAnn],Bool) }
        : 'qualified'                           { ([mj AnnQualified $1],True)  }
        | {- empty -}                           { ([],False) }

maybeas :: { ([AddAnn],Located (Maybe ModuleName)) }
        : 'as' modid                           { ([mj AnnAs $1,mj AnnVal $2]
                                                 ,sLL $1 $> (Just (unLoc $2))) }
        | {- empty -}                          { ([],noLoc Nothing) }

maybeimpspec :: { Located (Maybe (Bool, Located [LIE RdrName])) }
        : impspec                  {% let (b, ie) = unLoc $1 in
                                       checkImportSpec ie
                                        >>= \checkedIe ->
                                          return (L (gl $1) (Just (b, checkedIe)))  }
        | {- empty -}              { noLoc Nothing }

impspec :: { Located (Bool, Located [LIE RdrName]) }
        :  '(' exportlist ')'               {% ams (sLL $1 $> (False,
                                                      sLL $1 $> $ fromOL $2))
                                                   [mop $1,mcp $3] }
        |  'hiding' '(' exportlist ')'      {% ams (sLL $1 $> (True,
                                                      sLL $1 $> $ fromOL $3))
                                               [mj AnnHiding $1,mop $2,mcp $4] }

-----------------------------------------------------------------------------
-- Fixity Declarations

prec    :: { Located Int }
        : {- empty -}           { noLoc 9 }
        | INTEGER
                 {% checkPrecP (sL1 $1 (fromInteger (getINTEGER $1))) }

infix   :: { Located FixityDirection }
        : 'infix'                               { sL1 $1 InfixN  }
        | 'infixl'                              { sL1 $1 InfixL  }
        | 'infixr'                              { sL1 $1 InfixR }

ops     :: { Located (OrdList (Located RdrName)) }
        : ops ',' op       {% addAnnotation (oll $ unLoc $1) AnnComma (gl $2) >>
                              return (sLL $1 $> ((unLoc $1) `appOL` unitOL $3))}
        | op               { sL1 $1 (unitOL $1) }

-----------------------------------------------------------------------------
-- Top-Level Declarations

topdecls :: { OrdList (LHsDecl RdrName) }
        : topdecls ';' topdecl        {% addAnnotation (oll $1) AnnSemi (gl $2)
                                         >> return ($1 `appOL` unitOL $3) }
        | topdecls ';'                {% addAnnotation (oll $1) AnnSemi (gl $2)
                                         >> return $1 }
        | topdecl                     { unitOL $1 }

topdecl :: { LHsDecl RdrName }
        : cl_decl                               { sL1 $1 (TyClD (unLoc $1)) }
        | ty_decl                               { sL1 $1 (TyClD (unLoc $1)) }
        | inst_decl                             { sL1 $1 (InstD (unLoc $1)) }
        | stand_alone_deriving                  { sLL $1 $> (DerivD (unLoc $1)) }
        | role_annot                            { sL1 $1 (RoleAnnotD (unLoc $1)) }
        | 'default' '(' comma_types0 ')'    {% ams (sLL $1 $> (DefD (DefaultDecl $3)))
                                                         [mj AnnDefault $1
                                                         ,mop $2,mcp $4] }
        | 'foreign' fdecl          {% ams (sLL $1 $> (snd $ unLoc $2))
                                           (mj AnnForeign $1:(fst $ unLoc $2)) }
        | '{-# DEPRECATED' deprecations '#-}'   {% ams (sLL $1 $> $ WarningD (Warnings (getDEPRECATED_PRAGs $1) (fromOL $2)))
                                                       [mo $1,mc $3] }
        | '{-# WARNING' warnings '#-}'          {% ams (sLL $1 $> $ WarningD (Warnings (getWARNING_PRAGs $1) (fromOL $2)))
                                                       [mo $1,mc $3] }
        | '{-# RULES' rules '#-}'               {% ams (sLL $1 $> $ RuleD (HsRules (getRULES_PRAGs $1) (fromOL $2)))
                                                       [mo $1,mc $3] }
        | '{-# VECTORISE' qvar '=' exp '#-}' {% ams (sLL $1 $> $ VectD (HsVect (getVECT_PRAGs $1) $2 $4))
                                                    [mo $1,mj AnnEqual $3
                                                    ,mc $5] }
        | '{-# NOVECTORISE' qvar '#-}'       {% ams (sLL $1 $> $ VectD (HsNoVect (getNOVECT_PRAGs $1) $2))
                                                     [mo $1,mc $3] }
        | '{-# VECTORISE' 'type' gtycon '#-}'
                                {% ams (sLL $1 $> $
                                    VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 Nothing))
                                    [mo $1,mj AnnType $2,mc $4] }

        | '{-# VECTORISE_SCALAR' 'type' gtycon '#-}'
                                {% ams (sLL $1 $> $
                                    VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 Nothing))
                                    [mo $1,mj AnnType $2,mc $4] }

        | '{-# VECTORISE' 'type' gtycon '=' gtycon '#-}'
                                {% ams (sLL $1 $> $
                                    VectD (HsVectTypeIn (getVECT_PRAGs $1) False $3 (Just $5)))
                                    [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }
        | '{-# VECTORISE_SCALAR' 'type' gtycon '=' gtycon '#-}'
                                {% ams (sLL $1 $> $
                                    VectD (HsVectTypeIn (getVECT_SCALAR_PRAGs $1) True $3 (Just $5)))
                                    [mo $1,mj AnnType $2,mj AnnEqual $4,mc $6] }

        | '{-# VECTORISE' 'class' gtycon '#-}'
                                         {% ams (sLL $1 $>  $ VectD (HsVectClassIn (getVECT_PRAGs $1) $3))
                                                 [mo $1,mj AnnClass $2,mc $4] }
        | annotation { $1 }
        | decl_no_th                            { $1 }

        -- Template Haskell Extension
        -- The $(..) form is one possible form of infixexp
        -- but we treat an arbitrary expression just as if
        -- it had a $(..) wrapped around it
        | infixexp                              { sLL $1 $> $ mkSpliceDecl $1 }

-- Type classes
--
cl_decl :: { LTyClDecl RdrName }
        : 'class' tycl_hdr fds where_cls
                {% amms (mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 (snd $ unLoc $4))
                        (mj AnnClass $1:(fst $ unLoc $3)++(fst $ unLoc $4)) }

-- Type declarations (toplevel)
--
ty_decl :: { LTyClDecl RdrName }
           -- ordinary type synonyms
        : 'type' type '=' ctypedoc
                -- Note ctype, not sigtype, on the right of '='
                -- We allow an explicit for-all but we don't insert one
                -- in   type Foo a = (b,b)
                -- Instead we just say b is out of scope
                --
                -- Note the use of type for the head; this allows
                -- infix type constructors to be declared
                {% amms (mkTySynonym (comb2 $1 $4) $2 $4)
                        [mj AnnType $1,mj AnnEqual $3] }

           -- type family declarations
        | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info
                          where_type_family
                -- Note the use of type for the head; this allows
                -- infix type constructors to be declared
                {% amms (mkFamDecl (comb4 $1 $3 $4 $5) (snd $ unLoc $6) $3
                                   (snd $ unLoc $4) (snd $ unLoc $5))
                        (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)
                           ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) }

          -- ordinary data type or newtype declaration
        | data_or_newtype capi_ctype tycl_hdr constrs deriving
                {% amms (mkTyData (comb4 $1 $3 $4 $5) (snd $ unLoc $1) $2 $3
                           Nothing (reverse (snd $ unLoc $4))
                                   (unLoc $5))
                                   -- We need the location on tycl_hdr in case
                                   -- constrs and deriving are both empty
                        ((fst $ unLoc $1):(fst $ unLoc $4)) }

          -- ordinary GADT declaration
        | data_or_newtype capi_ctype tycl_hdr opt_kind_sig
                 gadt_constrlist
                 deriving
            {% amms (mkTyData (comb4 $1 $3 $5 $6) (snd $ unLoc $1) $2 $3
                            (snd $ unLoc $4) (snd $ unLoc $5) (unLoc $6) )
                                   -- We need the location on tycl_hdr in case
                                   -- constrs and deriving are both empty
                    ((fst $ unLoc $1):(fst $ unLoc $4)++(fst $ unLoc $5)) }

          -- data/newtype family
        | 'data' 'family' type opt_datafam_kind_sig
                {% amms (mkFamDecl (comb3 $1 $2 $4) DataFamily $3
                                   (snd $ unLoc $4) Nothing)
                        (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }

inst_decl :: { LInstDecl RdrName }
        : 'instance' overlap_pragma inst_type where_inst
       {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
             ; let cid = ClsInstDecl { cid_poly_ty = $3, cid_binds = binds
                                     , cid_sigs = mkClassOpSigs sigs
                                     , cid_tyfam_insts = ats
                                     , cid_overlap_mode = $2
                                     , cid_datafam_insts = adts }
             ; ams (L (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_inst = cid }))
                   (mj AnnInstance $1 : (fst $ unLoc $4)) } }

           -- type instance declarations
        | 'type' 'instance' ty_fam_inst_eqn
                {% ams $3 (fst $ unLoc $3)
                >> amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))
                    (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) }

          -- data/newtype instance declaration