ghc/compiler/parser/Parser.y.pp

   1 --                                                              -*-haskell-*-
   2 -- ---------------------------------------------------------------------------
   3 -- (c) The University of Glasgow 1997-2003
   4 ---
   5 -- The GHC grammar.
   6 --
   7 -- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
   8 -- ---------------------------------------------------------------------------
   9
  10 {
  11 module Parser ( parseModule, parseStmt, parseIdentifier, parseIface ) where
  12
  13 #define INCLUDE #include
  14 INCLUDE "HsVersions.h"
  15
  16 import HsSyn
  17 import RdrHsSyn
  18 import HscTypes         ( ModIface, IsBootInterface, DeprecTxt )
  19 import Lexer
  20 import RdrName
  21 import TysWiredIn       ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
  22                           listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
  23 import Type             ( funTyCon )
  24 import ForeignCall      ( Safety(..), CExportSpec(..),
  25                           CCallConv(..), CCallTarget(..), defaultCCallConv
  26                         )
  27 import OccName          ( UserFS, varName, dataName, tcClsName, tvName )
  28 import DataCon          ( DataCon, dataConName )
  29 import SrcLoc           ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
  30                           SrcSpan, combineLocs, mkGeneralSrcSpan, srcLocFile )
  31 import Module
  32 import CmdLineOpts      ( opt_SccProfilingOn )
  33 import Type             ( Kind, mkArrowKind, liftedTypeKind )
  34 import BasicTypes       ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
  35                           NewOrData(..), Activation(..) )
  36 import OrdList
  37 import Bag              ( emptyBag )
  38 import Panic
  39
  40 import GLAEXTS
  41 import CStrings         ( CLabelString )
  42 import FastString
  43 import Maybes           ( orElse )
  44 import Outputable
  45 }
  46
  47 {-
  48 -----------------------------------------------------------------------------
  49 Conflicts: 29 shift/reduce, [SDM 19/9/2002]
  50
  51 10 for abiguity in 'if x then y else z + 1'             [State 136]
  52         (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
  53         10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
  54
  55 1 for ambiguity in 'if x then y else z with ?x=3'       [State 136]
  56         (shift parses as 'if x then y else (z with ?x=3)'
  57
  58 1 for ambiguity in 'if x then y else z :: T'            [State 136]
  59         (shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
  60
  61 8 for ambiguity in 'e :: a `b` c'.  Does this mean      [States 160,246]
  62         (e::a) `b` c, or
  63         (e :: (a `b` c))
  64
  65 1 for ambiguity in 'let ?x ...'                         [State 268]
  66         the parser can't tell whether the ?x is the lhs of a normal binding or
  67         an implicit binding.  Fortunately resolving as shift gives it the only
  68         sensible meaning, namely the lhs of an implicit binding.
  69
  70 1 for ambiguity in '{-# RULES "name" [ ... #-}          [State 332]
  71         we don't know whether the '[' starts the activation or not: it
  72         might be the start of the declaration with the activation being
  73         empty.  --SDM 1/4/2002
  74
  75 1 for ambiguity in '{-# RULES "name" forall = ... #-}'  [State 394]
  76         since 'forall' is a valid variable name, we don't know whether
  77         to treat a forall on the input as the beginning of a quantifier
  78         or the beginning of the rule itself.  Resolving to shift means
  79         it's always treated as a quantifier, hence the above is disallowed.
  80         This saves explicitly defining a grammar for the rule lhs that
  81         doesn't include 'forall'.
  82
  83 6 for conflicts between `fdecl' and `fdeclDEPRECATED',  [States 384,385]
  84         which are resolved correctly, and moreover,
  85         should go away when `fdeclDEPRECATED' is removed.
  86
  87 -- ---------------------------------------------------------------------------
  88 -- Adding location info
  89
  90 This is done in a stylised way using the three macros below, L0, L1
  91 and LL.  Each of these macros can be thought of as having type
  92
  93    L0, L1, LL :: a -> Located a
  94
  95 They each add a SrcSpan to their argument.
  96
  97    L0   adds 'noSrcSpan', used for empty productions
  98
  99    L1   for a production with a single token on the lhs.  Grabs the SrcSpan
 100         from that token.
 101
 102    LL   for a production with >1 token on the lhs.  Makes up a SrcSpan from
 103         the first and last tokens.
 104
 105 These suffice for the majority of cases.  However, we must be
 106 especially careful with empty productions: LL won't work if the first
 107 or last token on the lhs can represent an empty span.  In these cases,
 108 we have to calculate the span using more of the tokens from the lhs, eg.
 109
 110         | 'newtype' tycl_hdr '=' newconstr deriving
 111                 { L (comb3 $1 $4 $5)
 112                     (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
 113
 114 We provide comb3 and comb4 functions which are useful in such cases.
 115
 116 Be careful: there's no checking that you actually got this right, the
 117 only symptom will be that the SrcSpans of your syntax will be
 118 incorrect.
 119
 120 /*
 121  * We must expand these macros *before* running Happy, which is why this file is
 122  * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
 123  */
 124 #define L0   L noSrcSpan
 125 #define L1   sL (getLoc $1)
 126 #define LL   sL (comb2 $1 $>)
 127
 128 -- -----------------------------------------------------------------------------
 129
 130 -}
 131
 132 %token
 133  '_'            { L _ ITunderscore }            -- Haskell keywords
 134  'as'           { L _ ITas }
 135  'case'         { L _ ITcase }
 136  'class'        { L _ ITclass }
 137  'data'         { L _ ITdata }
 138  'default'      { L _ ITdefault }
 139  'deriving'     { L _ ITderiving }
 140  'do'           { L _ ITdo }
 141  'else'         { L _ ITelse }
 142  'hiding'       { L _ IThiding }
 143  'if'           { L _ ITif }
 144  'import'       { L _ ITimport }
 145  'in'           { L _ ITin }
 146  'infix'        { L _ ITinfix }
 147  'infixl'       { L _ ITinfixl }
 148  'infixr'       { L _ ITinfixr }
 149  'instance'     { L _ ITinstance }
 150  'let'          { L _ ITlet }
 151  'module'       { L _ ITmodule }
 152  'newtype'      { L _ ITnewtype }
 153  'of'           { L _ ITof }
 154  'qualified'    { L _ ITqualified }
 155  'then'         { L _ ITthen }
 156  'type'         { L _ ITtype }
 157  'where'        { L _ ITwhere }
 158  '_scc_'        { L _ ITscc }         -- ToDo: remove
 159
 160  'forall'       { L _ ITforall }                        -- GHC extension keywords
 161  'foreign'      { L _ ITforeign }
 162  'export'       { L _ ITexport }
 163  'label'        { L _ ITlabel }
 164  'dynamic'      { L _ ITdynamic }
 165  'safe'         { L _ ITsafe }
 166  'threadsafe'   { L _ ITthreadsafe }
 167  'unsafe'       { L _ ITunsafe }
 168  'mdo'          { L _ ITmdo }
 169  'stdcall'      { L _ ITstdcallconv }
 170  'ccall'        { L _ ITccallconv }
 171  'dotnet'       { L _ ITdotnet }
 172  'proc'         { L _ ITproc }          -- for arrow notation extension
 173  'rec'          { L _ ITrec }           -- for arrow notation extension
 174
 175  '{-# SPECIALISE'  { L _ ITspecialise_prag }
 176  '{-# SOURCE'      { L _ ITsource_prag }
 177  '{-# INLINE'      { L _ ITinline_prag }
 178  '{-# NOINLINE'    { L _ ITnoinline_prag }
 179  '{-# RULES'       { L _ ITrules_prag }
 180  '{-# CORE'        { L _ ITcore_prag }              -- hdaume: annotated core
 181  '{-# SCC'         { L _ ITscc_prag }
 182  '{-# DEPRECATED'  { L _ ITdeprecated_prag }
 183  '{-# UNPACK'      { L _ ITunpack_prag }
 184  '#-}'             { L _ ITclose_prag }
 185
 186  '..'           { L _ ITdotdot }                        -- reserved symbols
 187  ':'            { L _ ITcolon }
 188  '::'           { L _ ITdcolon }
 189  '='            { L _ ITequal }
 190  '\\'           { L _ ITlam }
 191  '|'            { L _ ITvbar }
 192  '<-'           { L _ ITlarrow }
 193  '->'           { L _ ITrarrow }
 194  '@'            { L _ ITat }
 195  '~'            { L _ ITtilde }
 196  '=>'           { L _ ITdarrow }
 197  '-'            { L _ ITminus }
 198  '!'            { L _ ITbang }
 199  '*'            { L _ ITstar }
 200  '-<'           { L _ ITlarrowtail }            -- for arrow notation
 201  '>-'           { L _ ITrarrowtail }            -- for arrow notation
 202  '-<<'          { L _ ITLarrowtail }            -- for arrow notation
 203  '>>-'          { L _ ITRarrowtail }            -- for arrow notation
 204  '.'            { L _ ITdot }
 205
 206  '{'            { L _ ITocurly }                        -- special symbols
 207  '}'            { L _ ITccurly }
 208  '{|'           { L _ ITocurlybar }
 209  '|}'           { L _ ITccurlybar }
 210  vocurly        { L _ ITvocurly } -- virtual open curly (from layout)
 211  vccurly        { L _ ITvccurly } -- virtual close curly (from layout)
 212  '['            { L _ ITobrack }
 213  ']'            { L _ ITcbrack }
 214  '[:'           { L _ ITopabrack }
 215  ':]'           { L _ ITcpabrack }
 216  '('            { L _ IToparen }
 217  ')'            { L _ ITcparen }
 218  '(#'           { L _ IToubxparen }
 219  '#)'           { L _ ITcubxparen }
 220  '(|'           { L _ IToparenbar }
 221  '|)'           { L _ ITcparenbar }
 222  ';'            { L _ ITsemi }
 223  ','            { L _ ITcomma }
 224  '`'            { L _ ITbackquote }
 225
 226  VARID          { L _ (ITvarid    _) }          -- identifiers
 227  CONID          { L _ (ITconid    _) }
 228  VARSYM         { L _ (ITvarsym   _) }
 229  CONSYM         { L _ (ITconsym   _) }
 230  QVARID         { L _ (ITqvarid   _) }
 231  QCONID         { L _ (ITqconid   _) }
 232  QVARSYM        { L _ (ITqvarsym  _) }
 233  QCONSYM        { L _ (ITqconsym  _) }
 234
 235  IPDUPVARID     { L _ (ITdupipvarid   _) }              -- GHC extension
 236  IPSPLITVARID   { L _ (ITsplitipvarid _) }              -- GHC extension
 237
 238  CHAR           { L _ (ITchar     _) }
 239  STRING         { L _ (ITstring   _) }
 240  INTEGER        { L _ (ITinteger  _) }
 241  RATIONAL       { L _ (ITrational _) }
 242
 243  PRIMCHAR       { L _ (ITprimchar   _) }
 244  PRIMSTRING     { L _ (ITprimstring _) }
 245  PRIMINTEGER    { L _ (ITprimint    _) }
 246  PRIMFLOAT      { L _ (ITprimfloat  _) }
 247  PRIMDOUBLE     { L _ (ITprimdouble _) }
 248
 249 -- Template Haskell
 250 '[|'            { L _ ITopenExpQuote  }
 251 '[p|'           { L _ ITopenPatQuote  }
 252 '[t|'           { L _ ITopenTypQuote  }
 253 '[d|'           { L _ ITopenDecQuote  }
 254 '|]'            { L _ ITcloseQuote    }
 255 TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
 256 '$('            { L _ ITparenEscape   }     -- $( exp )
 257 TH_VAR_QUOTE    { L _ ITvarQuote      }     -- 'x
 258 TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
 259
 260 %monad { P } { >>= } { return }
 261 %lexer { lexer } { L _ ITeof }
 262 %name parseModule module
 263 %name parseStmt   maybe_stmt
 264 %name parseIdentifier  identifier
 265 %name parseIface iface
 266 %tokentype { Located Token }
 267 %%
 268
 269 -----------------------------------------------------------------------------
 270 -- Module Header
 271
 272 -- The place for module deprecation is really too restrictive, but if it
 273 -- was allowed at its natural place just before 'module', we get an ugly
 274 -- s/r conflict with the second alternative. Another solution would be the
 275 -- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
 276 -- either, and DEPRECATED is only expected to be used by people who really
 277 -- know what they are doing. :-)
 278
 279 module  :: { Located (HsModule RdrName) }
 280         : 'module' modid maybemoddeprec maybeexports 'where' body
 281                 {% fileSrcSpan >>= \ loc ->
 282                    return (L loc (HsModule (Just (L (getLoc $2)
 283                                         (mkHomeModule (unLoc $2))))
 284                                 $4 (fst $6) (snd $6) $3)) }
 285         | missing_module_keyword top close
 286                 {% fileSrcSpan >>= \ loc ->
 287                    return (L loc (HsModule Nothing Nothing
 288                                 (fst $2) (snd $2) Nothing)) }
 289
 290 missing_module_keyword :: { () }
 291         : {- empty -}                           {% pushCurrentContext }
 292
 293 maybemoddeprec :: { Maybe DeprecTxt }
 294         : '{-# DEPRECATED' STRING '#-}'         { Just (getSTRING $2) }
 295         |  {- empty -}                          { Nothing }
 296
 297 body    :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
 298         :  '{'            top '}'               { $2 }
 299         |      vocurly    top close             { $2 }
 300
 301 top     :: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
 302         : importdecls                           { (reverse $1,[]) }
 303         | importdecls ';' cvtopdecls            { (reverse $1,$3) }
 304         | cvtopdecls                            { ([],$1) }
 305
 306 cvtopdecls :: { [LHsDecl RdrName] }
 307         : topdecls                              { cvTopDecls $1 }
 308
 309 -----------------------------------------------------------------------------
 310 -- Interfaces (.hi-boot files)
 311
 312 iface   :: { ModIface }
 313         : 'module' modid 'where' ifacebody  { mkBootIface (unLoc $2) $4 }
 314
 315 ifacebody :: { [HsDecl RdrName] }
 316         :  '{'            ifacedecls '}'                { $2 }
 317         |      vocurly    ifacedecls close              { $2 }
 318
 319 ifacedecls :: { [HsDecl RdrName] }
 320         : ifacedecl ';' ifacedecls      { $1 : $3 }
 321         | ';' ifacedecls                { $2 }
 322         | ifacedecl                     { [$1] }
 323         | {- empty -}                   { [] }
 324
 325 ifacedecl :: { HsDecl RdrName }
 326         : var '::' sigtype
 327                 { SigD (Sig $1 $3) }
 328         | 'type' syn_hdr '=' ctype
 329                 { let (tc,tvs) = $2 in TyClD (TySynonym tc tvs $4) }
 330         | 'data' tycl_hdr
 331                 { TyClD (mkTyData DataType (unLoc $2) [] Nothing) }
 332         | 'newtype' tycl_hdr
 333                 { TyClD (mkTyData NewType (unLoc $2) [] Nothing) }
 334         | 'class' tycl_hdr fds
 335                 { TyClD (mkClassDecl (unLoc $2) (unLoc $3) [] emptyBag) }
 336
 337 -----------------------------------------------------------------------------
 338 -- The Export List
 339
 340 maybeexports :: { Maybe [LIE RdrName] }
 341         :  '(' exportlist ')'                   { Just $2 }
 342         |  {- empty -}                          { Nothing }
 343
 344 exportlist :: { [LIE RdrName] }
 345         :  exportlist ',' export                { $3 : $1 }
 346         |  exportlist ','                       { $1 }
 347         |  export                               { [$1]  }
 348         |  {- empty -}                          { [] }
 349
 350    -- No longer allow things like [] and (,,,) to be exported
 351    -- They are built in syntax, always available
 352 export  :: { LIE RdrName }
 353         :  qvar                         { L1 (IEVar (unLoc $1)) }
 354         |  oqtycon                      { L1 (IEThingAbs (unLoc $1)) }
 355         |  oqtycon '(' '..' ')'         { LL (IEThingAll (unLoc $1)) }
 356         |  oqtycon '(' ')'              { LL (IEThingWith (unLoc $1) []) }
 357         |  oqtycon '(' qcnames ')'      { LL (IEThingWith (unLoc $1) (reverse $3)) }
 358         |  'module' modid               { LL (IEModuleContents (unLoc $2)) }
 359
 360 qcnames :: { [RdrName] }
 361         :  qcnames ',' qcname                   { unLoc $3 : $1 }
 362         |  qcname                               { [unLoc $1]  }
 363
 364 qcname  :: { Located RdrName }  -- Variable or data constructor
 365         :  qvar                                 { $1 }
 366         |  gcon                                 { $1 }
 367
 368 -----------------------------------------------------------------------------
 369 -- Import Declarations
 370
 371 -- import decls can be *empty*, or even just a string of semicolons
 372 -- whereas topdecls must contain at least one topdecl.
 373
 374 importdecls :: { [LImportDecl RdrName] }
 375         : importdecls ';' importdecl            { $3 : $1 }
 376         | importdecls ';'                       { $1 }
 377         | importdecl                            { [ $1 ] }
 378         | {- empty -}                           { [] }
 379
 380 importdecl :: { LImportDecl RdrName }
 381         : 'import' maybe_src optqualified modid maybeas maybeimpspec
 382                 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
 383
 384 maybe_src :: { IsBootInterface }
 385         : '{-# SOURCE' '#-}'                    { True }
 386         | {- empty -}                           { False }
 387
 388 optqualified :: { Bool }
 389         : 'qualified'                           { True  }
 390         | {- empty -}                           { False }
 391
 392 maybeas :: { Located (Maybe ModuleName) }
 393         : 'as' modid                            { LL (Just (unLoc $2)) }
 394         | {- empty -}                           { noLoc Nothing }
 395
 396 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
 397         : impspec                               { L1 (Just (unLoc $1)) }
 398         | {- empty -}                           { noLoc Nothing }
 399
 400 impspec :: { Located (Bool, [LIE RdrName]) }
 401         :  '(' exportlist ')'                   { LL (False, reverse $2) }
 402         |  'hiding' '(' exportlist ')'          { LL (True,  reverse $3) }
 403
 404 -----------------------------------------------------------------------------
 405 -- Fixity Declarations
 406
 407 prec    :: { Int }
 408         : {- empty -}           { 9 }
 409         | INTEGER               {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
 410
 411 infix   :: { Located FixityDirection }
 412         : 'infix'                               { L1 InfixN  }
 413         | 'infixl'                              { L1 InfixL  }
 414         | 'infixr'                              { L1 InfixR }
 415
 416 ops     :: { Located [Located RdrName] }
 417         : ops ',' op                            { LL ($3 : unLoc $1) }
 418         | op                                    { L1 [$1] }
 419
 420 -----------------------------------------------------------------------------
 421 -- Top-Level Declarations
 422
 423 topdecls :: { OrdList (LHsDecl RdrName) }       -- Reversed
 424         : topdecls ';' topdecl          { $1 `appOL` $3 }
 425         | topdecls ';'                  { $1 }
 426         | topdecl                       { $1 }
 427
 428 topdecl :: { OrdList (LHsDecl RdrName) }
 429         : tycl_decl                     { unitOL (L1 (TyClD (unLoc $1))) }
 430         | 'instance' inst_type where
 431                 { let (binds,sigs) = cvBindsAndSigs (unLoc $3)
 432                   in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
 433         | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
 434         | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
 435         | '{-# DEPRECATED' deprecations '#-}'   { $2 }
 436         | '{-# RULES' rules '#-}'               { $2 }
 437         | '$(' exp ')'                          { unitOL (LL $ SpliceD (SpliceDecl $2)) }
 438         | decl                                  { unLoc $1 }
 439
 440 tycl_decl :: { LTyClDecl RdrName }
 441         : 'type' syn_hdr '=' ctype
 442                 -- Note ctype, not sigtype.
 443                 -- We allow an explicit for-all but we don't insert one
 444                 -- in   type Foo a = (b,b)
 445                 -- Instead we just say b is out of scope
 446                 { LL $ let (tc,tvs) = $2 in TySynonym tc tvs $4 }
 447
 448         | 'data' tycl_hdr constrs deriving
 449                 { L (comb4 $1 $2 $3 $4)
 450                     (mkTyData DataType (unLoc $2) (reverse (unLoc $3)) (unLoc $4)) }
 451
 452         | 'newtype' tycl_hdr '=' newconstr deriving
 453                 { L (comb3 $1 $4 $5)
 454                     (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
 455
 456         | 'class' tycl_hdr fds where
 457                 { let
 458                         (binds,sigs) = cvBindsAndSigs (unLoc $4)
 459                   in
 460                   L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs
 461                                           binds) }
 462
 463 syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) }
 464                 -- We don't retain the syntax of an infix
 465                 -- type synonym declaration. Oh well.
 466         : tycon tv_bndrs                { ($1, $2) }
 467         | tv_bndr tyconop tv_bndr       { ($2, [$1,$3]) }
 468
 469 -- tycl_hdr parses the header of a type or class decl,
 470 -- which takes the form
 471 --      T a b
 472 --      Eq a => T a
 473 --      (Eq a, Ord b) => T a b
 474 -- Rather a lot of inlining here, else we get reduce/reduce errors
 475 tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
 476         : context '=>' type             {% checkTyClHdr $1 $3 >>= return.LL }
 477         | type                          {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
 478
 479 -----------------------------------------------------------------------------
 480 -- Nested declarations
 481
 482 decls   :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
 483         : decls ';' decl                { LL (unLoc $1 `appOL` unLoc $3) }
 484         | decls ';'                     { LL (unLoc $1) }
 485         | decl                          { L1 (unLoc $1) }
 486         | {- empty -}                   { noLoc nilOL }
 487
 488
 489 decllist :: { Located (OrdList (LHsDecl RdrName)) }     -- Reversed
 490         : '{'            decls '}'      { LL (unLoc $2) }
 491         |     vocurly    decls close    { $2 }
 492
 493 where   :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
 494                                 -- No implicit parameters
 495         : 'where' decllist              { LL (unLoc $2) }
 496         | {- empty -}                   { noLoc nilOL }
 497
 498 binds   ::  { Located [HsBindGroup RdrName] }   -- May have implicit parameters
 499         : decllist                      { L1 [cvBindGroup (unLoc $1)] }
 500         | '{'            dbinds '}'     { LL [HsIPBinds (unLoc $2)] }
 501         |     vocurly    dbinds close   { L (getLoc $2) [HsIPBinds (unLoc $2)] }
 502
 503 wherebinds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
 504         : 'where' binds                 { LL (unLoc $2) }
 505         | {- empty -}                   { noLoc [] }
 506
 507
 508 -----------------------------------------------------------------------------
 509 -- Transformation Rules
 510
 511 rules   :: { OrdList (LHsDecl RdrName) }        -- Reversed
 512         :  rules ';' rule                       { $1 `snocOL` $3 }
 513         |  rules ';'                            { $1 }
 514         |  rule                                 { unitOL $1 }
 515         |  {- empty -}                          { nilOL }
 516
 517 rule    :: { LHsDecl RdrName }
 518         : STRING activation rule_forall infixexp '=' exp
 519              { LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6) }
 520
 521 activation :: { Activation }           -- Omitted means AlwaysActive
 522         : {- empty -}                           { AlwaysActive }
 523         | explicit_activation                   { $1 }
 524
 525 inverse_activation :: { Activation }   -- Omitted means NeverActive
 526         : {- empty -}                           { NeverActive }
 527         | explicit_activation                   { $1 }
 528
 529 explicit_activation :: { Activation }  -- In brackets
 530         : '[' INTEGER ']'               { ActiveAfter  (fromInteger (getINTEGER $2)) }
 531         | '[' '~' INTEGER ']'           { ActiveBefore (fromInteger (getINTEGER $3)) }
 532
 533 rule_forall :: { [RuleBndr RdrName] }
 534         : 'forall' rule_var_list '.'            { $2 }
 535         | {- empty -}                           { [] }
 536
 537 rule_var_list :: { [RuleBndr RdrName] }
 538         : rule_var                              { [$1] }
 539         | rule_var rule_var_list                { $1 : $2 }
 540
 541 rule_var :: { RuleBndr RdrName }
 542         : varid                                 { RuleBndr $1 }
 543         | '(' varid '::' ctype ')'              { RuleBndrSig $2 $4 }
 544
 545 -----------------------------------------------------------------------------
 546 -- Deprecations (c.f. rules)
 547
 548 deprecations :: { OrdList (LHsDecl RdrName) }   -- Reversed
 549         : deprecations ';' deprecation          { $1 `appOL` $3 }
 550         | deprecations ';'                      { $1 }
 551         | deprecation                           { $1 }
 552         | {- empty -}                           { nilOL }
 553
 554 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 555 deprecation :: { OrdList (LHsDecl RdrName) }
 556         : depreclist STRING
 557                 { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
 558                        | n <- unLoc $1 ] }
 559
 560
 561 -----------------------------------------------------------------------------
 562 -- Foreign import and export declarations
 563
 564 -- for the time being, the following accepts foreign declarations conforming
 565 -- to the FFI Addendum, Version 1.0 as well as pre-standard declarations
 566 --
 567 -- * a flag indicates whether pre-standard declarations have been used and
 568 --   triggers a deprecation warning further down the road
 569 --
 570 -- NB: The first two rules could be combined into one by replacing `safety1'
 571 --     with `safety'.  However, the combined rule conflicts with the
 572 --     DEPRECATED rules.
 573 --
 574 fdecl :: { LHsDecl RdrName }
 575 fdecl : 'import' callconv safety1 fspec
 576                 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
 577       | 'import' callconv         fspec
 578                 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
 579                         return (LL d) } }
 580       | 'export' callconv fspec
 581                 {% mkExport $2 (unLoc $3) >>= return.LL }
 582         -- the following syntax is DEPRECATED
 583       | fdecl1DEPRECATED                        { L1 (ForD (unLoc $1)) }
 584       | fdecl2DEPRECATED                        { L1 (unLoc $1) }
 585
 586 fdecl1DEPRECATED :: { LForeignDecl RdrName }
 587 fdecl1DEPRECATED
 588   ----------- DEPRECATED label decls ------------
 589   : 'label' ext_name varid '::' sigtype
 590     { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
 591                                    (CLabel ($2 `orElse` mkExtName (unLoc $3)))) True }
 592
 593   ----------- DEPRECATED ccall/stdcall decls ------------
 594   --
 595   -- NB: This business with the case expression below may seem overly
 596   --     complicated, but it is necessary to avoid some conflicts.
 597
 598     -- DEPRECATED variant #1: lack of a calling convention specification
 599     --                        (import)
 600   | 'import' {-no callconv-} ext_name safety varid_no_unsafe '::' sigtype
 601     { let
 602         target = StaticTarget ($2 `orElse` mkExtName (unLoc $4))
 603       in
 604       LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
 605                                    (CFunction target)) True }
 606
 607     -- DEPRECATED variant #2: external name consists of two separate strings
 608     --                        (module name and function name) (import)
 609   | 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype
 610     {% case $2 of
 611          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 612          CCall cconv -> return $
 613            let
 614              imp = CFunction (StaticTarget (getSTRING $4))
 615            in
 616            LL $ ForeignImport $6 $8 (CImport cconv $5 nilFS nilFS imp) True }
 617
 618     -- DEPRECATED variant #3: `unsafe' after entity
 619   | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype
 620     {% case $2 of
 621          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 622          CCall cconv -> return $
 623            let
 624              imp = CFunction (StaticTarget (getSTRING $3))
 625            in
 626            LL $ ForeignImport $5 $7 (CImport cconv PlayRisky nilFS nilFS imp) True }
 627
 628     -- DEPRECATED variant #4: use of the special identifier `dynamic' without
 629     --                        an explicit calling convention (import)
 630   | 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype
 631     { LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
 632                                    (CFunction DynamicTarget)) True }
 633
 634     -- DEPRECATED variant #5: use of the special identifier `dynamic' (import)
 635   | 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype
 636     {% case $2 of
 637          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 638          CCall cconv -> return $
 639            LL $ ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS
 640                                         (CFunction DynamicTarget)) True }
 641
 642     -- DEPRECATED variant #6: lack of a calling convention specification
 643     --                        (export)
 644   | 'export' {-no callconv-} ext_name varid '::' sigtype
 645     { LL $ ForeignExport $3 $5 (CExport (CExportStatic ($2 `orElse` mkExtName (unLoc $3))
 646                                    defaultCCallConv)) True }
 647
 648     -- DEPRECATED variant #7: external name consists of two separate strings
 649     --                        (module name and function name) (export)
 650   | 'export' callconv STRING STRING varid '::' sigtype
 651     {% case $2 of
 652          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 653          CCall cconv -> return $
 654            LL $ ForeignExport $5 $7
 655                          (CExport (CExportStatic (getSTRING $4) cconv)) True }
 656
 657     -- DEPRECATED variant #8: use of the special identifier `dynamic' without
 658     --                        an explicit calling convention (export)
 659   | 'export' {-no callconv-} 'dynamic' varid '::' sigtype
 660     { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
 661                                    CWrapper) True }
 662
 663     -- DEPRECATED variant #9: use of the special identifier `dynamic' (export)
 664   | 'export' callconv 'dynamic' varid '::' sigtype
 665     {% case $2 of
 666          DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
 667          CCall cconv -> return $
 668            LL $ ForeignImport $4 $6
 669                  (CImport cconv (PlaySafe False) nilFS nilFS CWrapper) True }
 670
 671   ----------- DEPRECATED .NET decls ------------
 672   -- NB: removed the .NET call declaration, as it is entirely subsumed
 673   --     by the new standard FFI declarations
 674
 675 fdecl2DEPRECATED :: { LHsDecl RdrName }
 676 fdecl2DEPRECATED
 677   : 'import' 'dotnet' 'type' ext_name tycon { LL $ TyClD (ForeignType $5 $4 DNType) }
 678     -- left this one unchanged for the moment as type imports are not
 679     -- covered currently by the FFI standard -=chak
 680
 681
 682 callconv :: { CallConv }
 683           : 'stdcall'                   { CCall  StdCallConv }
 684           | 'ccall'                     { CCall  CCallConv   }
 685           | 'dotnet'                    { DNCall             }
 686
 687 safety :: { Safety }
 688         : 'unsafe'                      { PlayRisky }
 689         | 'safe'                        { PlaySafe False }
 690         | 'threadsafe'                  { PlaySafe True  }
 691         | {- empty -}                   { PlaySafe False }
 692
 693 safety1 :: { Safety }
 694         : 'unsafe'                      { PlayRisky }
 695         | 'safe'                        { PlaySafe  False }
 696         | 'threadsafe'                  { PlaySafe  True }
 697           -- only needed to avoid conflicts with the DEPRECATED rules
 698
 699 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
 700        : STRING var '::' sigtype      { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
 701        |        var '::' sigtype      { LL (noLoc nilFS, $1, $3) }
 702          -- if the entity string is missing, it defaults to the empty string;
 703          -- the meaning of an empty entity string depends on the calling
 704          -- convention
 705
 706 -- DEPRECATED syntax
 707 ext_name :: { Maybe CLabelString }
 708         : STRING                { Just (getSTRING $1) }
 709         | STRING STRING         { Just (getSTRING $2) } -- Ignore "module name" for now
 710         | {- empty -}           { Nothing }
 711
 712
 713 -----------------------------------------------------------------------------
 714 -- Type signatures
 715
 716 opt_sig :: { Maybe (LHsType RdrName) }
 717         : {- empty -}                   { Nothing }
 718         | '::' sigtype                  { Just $2 }
 719
 720 opt_asig :: { Maybe (LHsType RdrName) }
 721         : {- empty -}                   { Nothing }
 722         | '::' atype                    { Just $2 }
 723
 724 sigtypes :: { [LHsType RdrName] }
 725         : sigtype                       { [ $1 ] }
 726         | sigtypes ',' sigtype          { $3 : $1 }
 727
 728 sigtype :: { LHsType RdrName }
 729         : ctype                         { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
 730         -- Wrap an Implicit forall if there isn't one there already
 731
 732 sig_vars :: { Located [Located RdrName] }
 733          : sig_vars ',' var             { LL ($3 : unLoc $1) }
 734          | var                          { L1 [$1] }
 735
 736 -----------------------------------------------------------------------------
 737 -- Types
 738
 739 -- A ctype is a for-all type
 740 ctype   :: { LHsType RdrName }
 741         : 'forall' tv_bndrs '.' ctype   { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
 742         | context '=>' type             { LL $ mkImplicitHsForAllTy   $1 $3 }
 743         -- A type of form (context => type) is an *implicit* HsForAllTy
 744         | type                          { $1 }
 745
 746 -- We parse a context as a btype so that we don't get reduce/reduce
 747 -- errors in ctype.  The basic problem is that
 748 --      (Eq a, Ord a)
 749 -- looks so much like a tuple type.  We can't tell until we find the =>
 750 context :: { LHsContext RdrName }
 751         : btype                         {% checkContext $1 }
 752
 753 type :: { LHsType RdrName }
 754         : ipvar '::' gentype            { LL (HsPredTy (LL $ HsIParam (unLoc $1) $3)) }
 755         | gentype                       { $1 }
 756
 757 gentype :: { LHsType RdrName }
 758         : btype                         { $1 }
 759         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
 760         | btype  '`' tyvar '`' gentype  { LL $ HsOpTy $1 $3 $5 }
 761         | btype '->' gentype            { LL $ HsFunTy $1 $3 }
 762
 763 btype :: { LHsType RdrName }
 764         : btype atype                   { LL $ HsAppTy $1 $2 }
 765         | atype                         { $1 }
 766
 767 atype :: { LHsType RdrName }
 768         : gtycon                        { L1 (HsTyVar (unLoc $1)) }
 769         | tyvar                         { L1 (HsTyVar (unLoc $1)) }
 770         | '(' type ',' comma_types1 ')' { LL $ HsTupleTy Boxed  ($2:$4) }
 771         | '(#' comma_types1 '#)'        { LL $ HsTupleTy Unboxed $2     }
 772         | '[' type ']'                  { LL $ HsListTy  $2 }
 773         | '[:' type ':]'                { LL $ HsPArrTy  $2 }
 774         | '(' ctype ')'                 { LL $ HsParTy   $2 }
 775         | '(' ctype '::' kind ')'       { LL $ HsKindSig $2 $4 }
 776 -- Generics
 777         | INTEGER                       { L1 (HsNumTy (getINTEGER $1)) }
 778
 779 -- An inst_type is what occurs in the head of an instance decl
 780 --      e.g.  (Foo a, Gaz b) => Wibble a b
 781 -- It's kept as a single type, with a MonoDictTy at the right
 782 -- hand corner, for convenience.
 783 inst_type :: { LHsType RdrName }
 784         : ctype                         {% checkInstType $1 }
 785
 786 comma_types0  :: { [LHsType RdrName] }
 787         : comma_types1                  { $1 }
 788         | {- empty -}                   { [] }
 789
 790 comma_types1    :: { [LHsType RdrName] }
 791         : type                          { [$1] }
 792         | type  ',' comma_types1        { $1 : $3 }
 793
 794 tv_bndrs :: { [LHsTyVarBndr RdrName] }
 795          : tv_bndr tv_bndrs             { $1 : $2 }
 796          | {- empty -}                  { [] }
 797
 798 tv_bndr :: { LHsTyVarBndr RdrName }
 799         : tyvar                         { L1 (UserTyVar (unLoc $1)) }
 800         | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) $4) }
 801
 802 fds :: { Located [Located ([RdrName], [RdrName])] }
 803         : {- empty -}                   { noLoc [] }
 804         | '|' fds1                      { LL (reverse (unLoc $2)) }
 805
 806 fds1 :: { Located [Located ([RdrName], [RdrName])] }
 807         : fds1 ',' fd                   { LL ($3 : unLoc $1) }
 808         | fd                            { L1 [$1] }
 809
 810 fd :: { Located ([RdrName], [RdrName]) }
 811         : varids0 '->' varids0          { L (comb3 $1 $2 $3)
 812                                            (reverse (unLoc $1), reverse (unLoc $3)) }
 813
 814 varids0 :: { Located [RdrName] }
 815         : {- empty -}                   { noLoc [] }
 816         | varids0 tyvar                 { LL (unLoc $2 : unLoc $1) }
 817
 818 -----------------------------------------------------------------------------
 819 -- Kinds
 820
 821 kind    :: { Kind }
 822         : akind                 { $1 }
 823         | akind '->' kind       { mkArrowKind $1 $3 }
 824
 825 akind   :: { Kind }
 826         : '*'                   { liftedTypeKind }
 827         | '(' kind ')'          { $2 }
 828
 829
 830 -----------------------------------------------------------------------------
 831 -- Datatype declarations
 832
 833 newconstr :: { LConDecl RdrName }
 834         : conid atype   { LL $ ConDecl $1 [] (noLoc [])
 835                                 (PrefixCon [(unbangedType $2)]) }
 836         | conid '{' var '::' ctype '}'
 837                         { LL $ ConDecl $1 [] (noLoc [])
 838                                   (RecCon [($3, (unbangedType $5))]) }
 839
 840 constrs :: { Located [LConDecl RdrName] }
 841         : {- empty; a GHC extension -}  { noLoc [] }
 842         | '=' constrs1                  { LL (unLoc $2) }
 843
 844 constrs1 :: { Located [LConDecl RdrName] }
 845         : constrs1 '|' constr           { LL ($3 : unLoc $1) }
 846         | constr                        { L1 [$1] }
 847
 848 constr :: { LConDecl RdrName }
 849         : forall context '=>' constr_stuff
 850                 { let (con,details) = unLoc $4 in
 851                   LL (ConDecl con (unLoc $1) $2 details) }
 852         | forall constr_stuff
 853                 { let (con,details) = unLoc $2 in
 854                   LL (ConDecl con (unLoc $1) (noLoc []) details) }
 855
 856 forall :: { Located [LHsTyVarBndr RdrName] }
 857         : 'forall' tv_bndrs '.'         { LL $2 }
 858         | {- empty -}                   { noLoc [] }
 859
 860 constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
 861         : btype                         {% mkPrefixCon $1 [] >>= return.LL }
 862         | btype bang_atype satypes      {% do { r <- mkPrefixCon $1 ($2 : unLoc $3);
 863                                                 return (L (comb3 $1 $2 $3) r) } }
 864         | oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.LL }
 865         | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
 866         | sbtype conop sbtype           { LL ($2, InfixCon $1 $3) }
 867
 868 bang_atype :: { LBangType RdrName }
 869         : strict_mark atype             { LL (BangType (unLoc $1) $2) }
 870
 871 satypes :: { Located [LBangType RdrName] }
 872         : atype satypes                 { LL (unbangedType $1 : unLoc $2) }
 873         | bang_atype satypes            { LL ($1 : unLoc $2) }
 874         | {- empty -}                   { noLoc [] }
 875
 876 sbtype :: { LBangType RdrName }
 877         : btype                         { unbangedType $1 }
 878         | strict_mark atype             { LL (BangType (unLoc $1) $2) }
 879
 880 fielddecls :: { [([Located RdrName], LBangType RdrName)] }
 881         : fielddecl ',' fielddecls      { unLoc $1 : $3 }
 882         | fielddecl                     { [unLoc $1] }
 883
 884 fielddecl :: { Located ([Located RdrName], LBangType RdrName) }
 885         : sig_vars '::' stype           { LL (reverse (unLoc $1), $3) }
 886
 887 stype :: { LBangType RdrName }
 888         : ctype                         { unbangedType $1 }
 889         | strict_mark atype             { LL (BangType (unLoc $1) $2) }
 890
 891 strict_mark :: { Located HsBang }
 892         : '!'                           { L1 HsStrict }
 893         | '{-# UNPACK' '#-}' '!'        { LL HsUnbox }
 894
 895 deriving :: { Located (Maybe (LHsContext RdrName)) }
 896         : {- empty -}                   { noLoc Nothing }
 897         | 'deriving' context            { LL (Just $2) }
 898              -- Glasgow extension: allow partial
 899              -- applications in derivings
 900
 901 -----------------------------------------------------------------------------
 902 -- Value definitions
 903
 904 {- There's an awkward overlap with a type signature.  Consider
 905         f :: Int -> Int = ...rhs...
 906    Then we can't tell whether it's a type signature or a value
 907    definition with a result signature until we see the '='.
 908    So we have to inline enough to postpone reductions until we know.
 909 -}
 910
 911 {-
 912   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
 913   instead of qvar, we get another shift/reduce-conflict. Consider the
 914   following programs:
 915
 916      { (^^) :: Int->Int ; }          Type signature; only var allowed
 917
 918      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
 919                                      qvar allowed (because of instance decls)
 920
 921   We can't tell whether to reduce var to qvar until after we've read the signatures.
 922 -}
 923
 924 decl    :: { Located (OrdList (LHsDecl RdrName)) }
 925         : sigdecl                       { $1 }
 926         | infixexp opt_sig rhs          {% do { r <- checkValDef $1 $2 (unLoc $3);
 927                                                 return (LL $ unitOL (LL $ ValD r)) } }
 928
 929 rhs     :: { Located (GRHSs RdrName) }
 930         : '=' exp wherebinds    { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) placeHolderType }
 931         | gdrhs wherebinds      { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) placeHolderType }
 932
 933 gdrhs :: { Located [LGRHS RdrName] }
 934         : gdrhs gdrh            { LL ($2 : unLoc $1) }
 935         | gdrh                  { L1 [$1] }
 936
 937 gdrh :: { LGRHS RdrName }
 938         : '|' quals '=' exp     { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) :
 939                                                         unLoc $2)) }
 940
 941 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
 942         : infixexp '::' sigtype
 943                                 {% do s <- checkValSig $1 $3;
 944                                       return (LL $ unitOL (LL $ SigD s)) }
 945                 -- See the above notes for why we need infixexp here
 946         | var ',' sig_vars '::' sigtype
 947                                 { LL $ toOL [ LL $ SigD (Sig n $5) | n <- $1 : unLoc $3 ] }
 948         | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
 949                                              | n <- unLoc $3 ] }
 950         | '{-# INLINE'   activation qvar '#-}'
 951                                 { LL $ unitOL (LL $ SigD (InlineSig True  $3 $2)) }
 952         | '{-# NOINLINE' inverse_activation qvar '#-}'
 953                                 { LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) }
 954         | '{-# SPECIALISE' qvar '::' sigtypes '#-}'
 955                                 { LL $ toOL [ LL $ SigD (SpecSig $2 t)
 956                                             | t <- $4] }
 957         | '{-# SPECIALISE' 'instance' inst_type '#-}'
 958                                 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
 959
 960 -----------------------------------------------------------------------------
 961 -- Expressions
 962
 963 exp   :: { LHsExpr RdrName }
 964         : infixexp '::' sigtype         { LL $ ExprWithTySig $1 $3 }
 965         | fexp '-<' exp         { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
 966         | fexp '>-' exp         { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
 967         | fexp '-<<' exp        { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
 968         | fexp '>>-' exp        { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
 969         | infixexp                      { $1 }
 970
 971 infixexp :: { LHsExpr RdrName }
 972         : exp10                         { $1 }
 973         | infixexp qop exp10            { LL (OpApp $1 $2 (panic "fixity") $3) }
 974
 975 exp10 :: { LHsExpr RdrName }
 976         : '\\' aexp aexps opt_asig '->' exp
 977                         {% checkPatterns ($2 : reverse $3) >>= \ ps ->
 978                            return (LL $ HsLam (LL $ Match ps $4
 979                                             (GRHSs (unguardedRHS $6) []
 980                                                         placeHolderType))) }
 981         | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
 982         | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
 983         | 'case' exp 'of' altslist              { LL $ HsCase $2 (unLoc $4) }
 984         | '-' fexp                              { LL $ mkHsNegApp $2 }
 985
 986         | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
 987                                            checkDo loc (unLoc $2)  >>= \ stmts ->
 988                                            return (L loc (mkHsDo DoExpr stmts)) }
 989         | 'mdo' stmtlist                {% let loc = comb2 $1 $2 in
 990                                            checkMDo loc (unLoc $2)  >>= \ stmts ->
 991                                            return (L loc (mkHsDo MDoExpr stmts)) }
 992
 993         | scc_annot exp                         { LL $ if opt_SccProfilingOn
 994                                                         then HsSCC (unLoc $1) $2
 995                                                         else HsPar $2 }
 996
 997         | 'proc' aexp '->' exp
 998                         {% checkPattern $2 >>= \ p ->
 999                            return (LL $ HsProc p (LL $ HsCmdTop $4 []
1000                                                    placeHolderType undefined)) }
1001                                                 -- TODO: is LL right here?
1002
1003         | '{-# CORE' STRING '#-}' exp           { LL $ HsCoreAnn (getSTRING $2) $4 }
1004                                                     -- hdaume: core annotation
1005         | fexp                                  { $1 }
1006
1007 scc_annot :: { Located FastString }
1008         : '_scc_' STRING                        { LL $ getSTRING $2 }
1009         | '{-# SCC' STRING '#-}'                { LL $ getSTRING $2 }
1010
1011 fexp    :: { LHsExpr RdrName }
1012         : fexp aexp                             { LL $ HsApp $1 $2 }
1013         | aexp                                  { $1 }
1014
1015 aexps   :: { [LHsExpr RdrName] }
1016         : aexps aexp                            { $2 : $1 }
1017         | {- empty -}                           { [] }
1018
1019 aexp    :: { LHsExpr RdrName }
1020         : qvar '@' aexp                 { LL $ EAsPat $1 $3 }
1021         | '~' aexp                      { LL $ ELazyPat $2 }
1022         | aexp1                         { $1 }
1023
1024 aexp1   :: { LHsExpr RdrName }
1025         : aexp1 '{' fbinds '}'  {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
1026                                                         (reverse $3);
1027                                         return (LL r) }}
1028         | aexp2                 { $1 }
1029
1030 -- Here was the syntax for type applications that I was planning
1031 -- but there are difficulties (e.g. what order for type args)
1032 -- so it's not enabled yet.
1033 -- But this case *is* used for the left hand side of a generic definition,
1034 -- which is parsed as an expression before being munged into a pattern
1035         | qcname '{|' gentype '|}'      { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
1036                                                      (sL (getLoc $3) (HsType $3)) }
1037
1038 aexp2   :: { LHsExpr RdrName }
1039         : ipvar                         { L1 (HsIPVar $! unLoc $1) }
1040         | qcname                        { L1 (HsVar   $! unLoc $1) }
1041         | literal                       { L1 (HsLit   $! unLoc $1) }
1042         | INTEGER                       { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
1043         | RATIONAL                      { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
1044         | '(' exp ')'                   { LL (HsPar $2) }
1045         | '(' exp ',' texps ')'         { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
1046         | '(#' texps '#)'               { LL $ ExplicitTuple (reverse $2)      Unboxed }
1047         | '[' list ']'                  { LL (unLoc $2) }
1048         | '[:' parr ':]'                { LL (unLoc $2) }
1049         | '(' infixexp qop ')'          { LL $ SectionL $2 $3 }
1050         | '(' qopm infixexp ')'         { LL $ SectionR $2 $3 }
1051         | '_'                           { L1 EWildPat }
1052
1053         -- MetaHaskell Extension
1054         | TH_ID_SPLICE          { L1 $ mkHsSplice
1055                                         (L1 $ HsVar (mkUnqual varName
1056                                                         (getTH_ID_SPLICE $1))) } -- $x
1057         | '$(' exp ')'          { LL $ mkHsSplice $2 }                            -- $( exp )
1058         | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1059         | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
1060         | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
1061         | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
1062         | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }
1063         | '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }
1064         | '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
1065                                            return (LL $ HsBracket (PatBr p)) }
1066         | '[d|' cvtopbody '|]'  { LL $ HsBracket (DecBr (mkGroup $2)) }
1067
1068         -- arrow notation extension
1069         | '(|' aexp2 cmdargs '|)'       { LL $ HsArrForm $2 Nothing (reverse $3) }
1070
1071 cmdargs :: { [LHsCmdTop RdrName] }
1072         : cmdargs acmd                  { $2 : $1 }
1073         | {- empty -}                   { [] }
1074
1075 acmd    :: { LHsCmdTop RdrName }
1076         : aexp2                 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1077
1078 cvtopbody :: { [LHsDecl RdrName] }
1079         :  '{'            cvtopdecls '}'                { $2 }
1080         |      vocurly    cvtopdecls close              { $2 }
1081
1082 texps :: { [LHsExpr RdrName] }
1083         : texps ',' exp                 { $3 : $1 }
1084         | exp                           { [$1] }
1085
1086
1087 -----------------------------------------------------------------------------
1088 -- List expressions
1089
1090 -- The rules below are little bit contorted to keep lexps left-recursive while
1091 -- avoiding another shift/reduce-conflict.
1092
1093 list :: { LHsExpr RdrName }
1094         : exp                   { L1 $ ExplicitList placeHolderType [$1] }
1095         | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1096         | exp '..'              { LL $ ArithSeqIn (From $1) }
1097         | exp ',' exp '..'      { LL $ ArithSeqIn (FromThen $1 $3) }
1098         | exp '..' exp          { LL $ ArithSeqIn (FromTo $1 $3) }
1099         | exp ',' exp '..' exp  { LL $ ArithSeqIn (FromThenTo $1 $3 $5) }
1100         | exp pquals            { LL $ mkHsDo ListComp
1101                                         (reverse (L (getLoc $1) (ResultStmt $1) :
1102                                            unLoc $2)) }
1103
1104 lexps :: { Located [LHsExpr RdrName] }
1105         : lexps ',' exp                 { LL ($3 : unLoc $1) }
1106         | exp ',' exp                   { LL [$3,$1] }
1107
1108 -----------------------------------------------------------------------------
1109 -- List Comprehensions
1110
1111 pquals :: { Located [LStmt RdrName] }   -- Either a singleton ParStmt,
1112                                         -- or a reversed list of Stmts
1113         : pquals1                       { case unLoc $1 of
1114                                             [qs] -> L1 qs
1115                                             qss  -> L1 [L1 (ParStmt stmtss)]
1116                                                  where
1117                                                     stmtss = [ (reverse qs, undefined)
1118                                                              | qs <- qss ]
1119                                         }
1120
1121 pquals1 :: { Located [[LStmt RdrName]] }
1122         : pquals1 '|' quals             { LL (unLoc $3 : unLoc $1) }
1123         | '|' quals                     { L (getLoc $2) [unLoc $2] }
1124
1125 quals :: { Located [LStmt RdrName] }
1126         : quals ',' qual                { LL ($3 : unLoc $1) }
1127         | qual                          { L1 [$1] }
1128
1129 -----------------------------------------------------------------------------
1130 -- Parallel array expressions
1131
1132 -- The rules below are little bit contorted; see the list case for details.
1133 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1134 -- Moreover, we allow explicit arrays with no element (represented by the nil
1135 -- constructor in the list case).
1136
1137 parr :: { LHsExpr RdrName }
1138         :                               { noLoc (ExplicitPArr placeHolderType []) }
1139         | exp                           { L1 $ ExplicitPArr placeHolderType [$1] }
1140         | lexps                         { L1 $ ExplicitPArr placeHolderType
1141                                                        (reverse (unLoc $1)) }
1142         | exp '..' exp                  { LL $ PArrSeqIn (FromTo $1 $3) }
1143         | exp ',' exp '..' exp          { LL $ PArrSeqIn (FromThenTo $1 $3 $5) }
1144         | exp pquals                    { LL $ mkHsDo PArrComp
1145                                             (reverse (L (getLoc $1) (ResultStmt $1) :
1146                                                  unLoc $2))
1147                                         }
1148
1149 -- We are reusing `lexps' and `pquals' from the list case.
1150
1151 -----------------------------------------------------------------------------
1152 -- Case alternatives
1153
1154 altslist :: { Located [LMatch RdrName] }
1155         : '{'            alts '}'       { LL (reverse (unLoc $2)) }
1156         |     vocurly    alts  close    { L (getLoc $2) (reverse (unLoc $2)) }
1157
1158 alts    :: { Located [LMatch RdrName] }
1159         : alts1                         { L1 (unLoc $1) }
1160         | ';' alts                      { LL (unLoc $2) }
1161
1162 alts1   :: { Located [LMatch RdrName] }
1163         : alts1 ';' alt                 { LL ($3 : unLoc $1) }
1164         | alts1 ';'                     { LL (unLoc $1) }
1165         | alt                           { L1 [$1] }
1166
1167 alt     :: { LMatch RdrName }
1168         : infixexp opt_sig alt_rhs      {%  checkPattern $1 >>= \p ->
1169                                             return (LL (Match [p] $2 (unLoc $3))) }
1170
1171 alt_rhs :: { Located (GRHSs RdrName) }
1172         : ralt wherebinds               { LL (GRHSs (unLoc $1) (unLoc $2)
1173                                                  placeHolderType) }
1174
1175 ralt :: { Located [LGRHS RdrName] }
1176         : '->' exp                      { LL (unguardedRHS $2) }
1177         | gdpats                        { L1 (reverse (unLoc $1)) }
1178
1179 gdpats :: { Located [LGRHS RdrName] }
1180         : gdpats gdpat                  { LL ($2 : unLoc $1) }
1181         | gdpat                         { L1 [$1] }
1182
1183 gdpat   :: { LGRHS RdrName }
1184         : '|' quals '->' exp            { let r = L (getLoc $4) (ResultStmt $4)
1185                                           in LL $ GRHS (reverse (r : unLoc $2)) }
1186
1187 -----------------------------------------------------------------------------
1188 -- Statement sequences
1189
1190 stmtlist :: { Located [LStmt RdrName] }
1191         : '{'           stmts '}'       { LL (unLoc $2) }
1192         |     vocurly   stmts close     { $2 }
1193
1194 --      do { ;; s ; s ; ; s ;; }
1195 -- The last Stmt should be a ResultStmt, but that's hard to enforce
1196 -- here, because we need too much lookahead if we see do { e ; }
1197 -- So we use ExprStmts throughout, and switch the last one over
1198 -- in ParseUtils.checkDo instead
1199 stmts :: { Located [LStmt RdrName] }
1200         : stmt stmts_help               { LL ($1 : unLoc $2) }
1201         | ';' stmts                     { LL (unLoc $2) }
1202         | {- empty -}                   { noLoc [] }
1203
1204 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1205         : ';' stmts                     { LL (unLoc $2) }
1206         | {- empty -}                   { noLoc [] }
1207
1208 -- For typing stmts at the GHCi prompt, where
1209 -- the input may consist of just comments.
1210 maybe_stmt :: { Maybe (LStmt RdrName) }
1211         : stmt                          { Just $1 }
1212         | {- nothing -}                 { Nothing }
1213
1214 stmt  :: { LStmt RdrName }
1215         : qual                          { $1 }
1216         | infixexp '->' exp             {% checkPattern $3 >>= \p ->
1217                                            return (LL $ BindStmt p $1) }
1218         | 'rec' stmtlist                { LL $ RecStmt (unLoc $2) undefined undefined undefined }
1219
1220 qual  :: { LStmt RdrName }
1221         : infixexp '<-' exp             {% checkPattern $1 >>= \p ->
1222                                            return (LL $ BindStmt p $3) }
1223         | exp                           { L1 $ ExprStmt $1 placeHolderType }
1224         | 'let' binds                   { LL $ LetStmt (unLoc $2) }
1225
1226 -----------------------------------------------------------------------------
1227 -- Record Field Update/Construction
1228
1229 fbinds  :: { HsRecordBinds RdrName }
1230         : fbinds1                       { $1 }
1231         | {- empty -}                   { [] }
1232
1233 fbinds1 :: { HsRecordBinds RdrName }
1234         : fbinds1 ',' fbind             { $3 : $1 }
1235         | fbind                         { [$1] }
1236
1237 fbind   :: { (Located RdrName, LHsExpr RdrName) }
1238         : qvar '=' exp                  { ($1,$3) }
1239
1240 -----------------------------------------------------------------------------
1241 -- Implicit Parameter Bindings
1242
1243 dbinds  :: { Located [LIPBind RdrName] }
1244         : dbinds ';' dbind              { LL ($3 : unLoc $1) }
1245         | dbinds ';'                    { LL (unLoc $1) }
1246         | dbind                         { L1 [$1] }
1247 --      | {- empty -}                   { [] }
1248
1249 dbind   :: { LIPBind RdrName }
1250 dbind   : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
1251
1252 -----------------------------------------------------------------------------
1253 -- Variables, Constructors and Operators.
1254
1255 identifier :: { Located RdrName }
1256         : qvar                          { $1 }
1257         | gcon                          { $1 }
1258         | qvarop                        { $1 }
1259         | qconop                        { $1 }
1260
1261 depreclist :: { Located [RdrName] }
1262 depreclist : deprec_var                 { L1 [unLoc $1] }
1263            | deprec_var ',' depreclist  { LL (unLoc $1 : unLoc $3) }
1264
1265 deprec_var :: { Located RdrName }
1266 deprec_var : var                        { $1 }
1267            | tycon                      { $1 }
1268
1269 gcon    :: { Located RdrName }  -- Data constructor namespace
1270         : sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1271         | qcon                  { $1 }
1272 -- the case of '[:' ':]' is part of the production `parr'
1273
1274 sysdcon :: { Located DataCon }  -- Wired in data constructors
1275         : '(' ')'               { LL unitDataCon }
1276         | '(' commas ')'        { LL $ tupleCon Boxed $2 }
1277         | '[' ']'               { LL nilDataCon }
1278
1279 var     :: { Located RdrName }
1280         : varid                 { $1 }
1281         | '(' varsym ')'        { LL (unLoc $2) }
1282
1283 qvar    :: { Located RdrName }
1284         : qvarid                { $1 }
1285         | '(' varsym ')'        { LL (unLoc $2) }
1286         | '(' qvarsym1 ')'      { LL (unLoc $2) }
1287 -- We've inlined qvarsym here so that the decision about
1288 -- whether it's a qvar or a var can be postponed until
1289 -- *after* we see the close paren.
1290
1291 ipvar   :: { Located (IPName RdrName) }
1292         : IPDUPVARID            { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
1293         | IPSPLITVARID          { L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
1294
1295 qcon    :: { Located RdrName }
1296         : qconid                { $1 }
1297         | '(' qconsym ')'       { LL (unLoc $2) }
1298
1299 varop   :: { Located RdrName }
1300         : varsym                { $1 }
1301         | '`' varid '`'         { LL (unLoc $2) }
1302
1303 qvarop :: { Located RdrName }
1304         : qvarsym               { $1 }
1305         | '`' qvarid '`'        { LL (unLoc $2) }
1306
1307 qvaropm :: { Located RdrName }
1308         : qvarsym_no_minus      { $1 }
1309         | '`' qvarid '`'        { LL (unLoc $2) }
1310
1311 conop :: { Located RdrName }
1312         : consym                { $1 }
1313         | '`' conid '`'         { LL (unLoc $2) }
1314
1315 qconop :: { Located RdrName }
1316         : qconsym               { $1 }
1317         | '`' qconid '`'        { LL (unLoc $2) }
1318
1319 -----------------------------------------------------------------------------
1320 -- Type constructors
1321
1322 gtycon  :: { Located RdrName }  -- A "general" qualified tycon
1323         : oqtycon                       { $1 }
1324         | '(' ')'                       { LL $ getRdrName unitTyCon }
1325         | '(' commas ')'                { LL $ getRdrName (tupleTyCon Boxed $2) }
1326         | '(' '->' ')'                  { LL $ getRdrName funTyCon }
1327         | '[' ']'                       { LL $ listTyCon_RDR }
1328         | '[:' ':]'                     { LL $ parrTyCon_RDR }
1329
1330 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon
1331         : qtycon                        { $1 }
1332         | '(' qtyconsym ')'             { LL (unLoc $2) }
1333
1334 qtyconop :: { Located RdrName } -- Qualified or unqualified
1335         : qtyconsym                     { $1 }
1336         | '`' qtycon '`'                { LL (unLoc $2) }
1337
1338 tyconop :: { Located RdrName }  -- Unqualified
1339         : tyconsym                      { $1 }
1340         | '`' tycon '`'                 { LL (unLoc $2) }
1341
1342 qtycon :: { Located RdrName }   -- Qualified or unqualified
1343         : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
1344         | tycon                         { $1 }
1345
1346 tycon   :: { Located RdrName }  -- Unqualified
1347         : CONID                         { L1 $! mkUnqual tcClsName (getCONID $1) }
1348
1349 qtyconsym :: { Located RdrName }
1350         : QCONSYM                       { L1 $! mkQual tcClsName (getQCONSYM $1) }
1351         | tyconsym                      { $1 }
1352
1353 tyconsym :: { Located RdrName }
1354         : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1355
1356 -----------------------------------------------------------------------------
1357 -- Any operator
1358
1359 op      :: { Located RdrName }   -- used in infix decls
1360         : varop                 { $1 }
1361         | conop                 { $1 }
1362
1363 qop     :: { LHsExpr RdrName }   -- used in sections
1364         : qvarop                { L1 $ HsVar (unLoc $1) }
1365         | qconop                { L1 $ HsVar (unLoc $1) }
1366
1367 qopm    :: { LHsExpr RdrName }   -- used in sections
1368         : qvaropm               { L1 $ HsVar (unLoc $1) }
1369         | qconop                { L1 $ HsVar (unLoc $1) }
1370
1371 -----------------------------------------------------------------------------
1372 -- VarIds
1373
1374 qvarid :: { Located RdrName }
1375         : varid                 { $1 }
1376         | QVARID                { L1 $ mkQual varName (getQVARID $1) }
1377
1378 varid :: { Located RdrName }
1379         : varid_no_unsafe       { $1 }
1380         | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
1381         | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
1382         | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
1383
1384 varid_no_unsafe :: { Located RdrName }
1385         : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
1386         | special_id            { L1 $! mkUnqual varName (unLoc $1) }
1387         | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
1388
1389 tyvar   :: { Located RdrName }
1390         : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
1391         | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
1392         | 'unsafe'              { L1 $! mkUnqual tvName FSLIT("unsafe") }
1393         | 'safe'                { L1 $! mkUnqual tvName FSLIT("safe") }
1394         | 'threadsafe'          { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1395
1396 -- These special_ids are treated as keywords in various places,
1397 -- but as ordinary ids elsewhere.   'special_id' collects all these
1398 -- except 'unsafe' and 'forall' whose treatment differs depending on context
1399 special_id :: { Located UserFS }
1400 special_id
1401         : 'as'                  { L1 FSLIT("as") }
1402         | 'qualified'           { L1 FSLIT("qualified") }
1403         | 'hiding'              { L1 FSLIT("hiding") }
1404         | 'export'              { L1 FSLIT("export") }
1405         | 'label'               { L1 FSLIT("label")  }
1406         | 'dynamic'             { L1 FSLIT("dynamic") }
1407         | 'stdcall'             { L1 FSLIT("stdcall") }
1408         | 'ccall'               { L1 FSLIT("ccall") }
1409
1410 -----------------------------------------------------------------------------
1411 -- Variables
1412
1413 qvarsym :: { Located RdrName }
1414         : varsym                { $1 }
1415         | qvarsym1              { $1 }
1416
1417 qvarsym_no_minus :: { Located RdrName }
1418         : varsym_no_minus       { $1 }
1419         | qvarsym1              { $1 }
1420
1421 qvarsym1 :: { Located RdrName }
1422 qvarsym1 : QVARSYM              { L1 $ mkQual varName (getQVARSYM $1) }
1423
1424 varsym :: { Located RdrName }
1425         : varsym_no_minus       { $1 }
1426         | '-'                   { L1 $ mkUnqual varName FSLIT("-") }
1427
1428 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1429         : VARSYM                { L1 $ mkUnqual varName (getVARSYM $1) }
1430         | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
1431
1432
1433 -- See comments with special_id
1434 special_sym :: { Located UserFS }
1435 special_sym : '!'       { L1 FSLIT("!") }
1436             | '.'       { L1 FSLIT(".") }
1437             | '*'       { L1 FSLIT("*") }
1438
1439 -----------------------------------------------------------------------------
1440 -- Data constructors
1441
1442 qconid :: { Located RdrName }   -- Qualified or unqualifiedb
1443         : conid                 { $1 }
1444         | QCONID                { L1 $ mkQual dataName (getQCONID $1) }
1445
1446 conid   :: { Located RdrName }
1447         : CONID                 { L1 $ mkUnqual dataName (getCONID $1) }
1448
1449 qconsym :: { Located RdrName }  -- Qualified or unqualified
1450         : consym                { $1 }
1451         | QCONSYM               { L1 $ mkQual dataName (getQCONSYM $1) }
1452
1453 consym :: { Located RdrName }
1454         : CONSYM                { L1 $ mkUnqual dataName (getCONSYM $1) }
1455
1456         -- ':' means only list cons
1457         | ':'                   { L1 $ consDataCon_RDR }
1458
1459
1460 -----------------------------------------------------------------------------
1461 -- Literals
1462
1463 literal :: { Located HsLit }
1464         : CHAR                  { L1 $ HsChar       $ getCHAR $1 }
1465         | STRING                { L1 $ HsString     $ getSTRING $1 }
1466         | PRIMINTEGER           { L1 $ HsIntPrim    $ getPRIMINTEGER $1 }
1467         | PRIMCHAR              { L1 $ HsCharPrim   $ getPRIMCHAR $1 }
1468         | PRIMSTRING            { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1469         | PRIMFLOAT             { L1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
1470         | PRIMDOUBLE            { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1471
1472 -----------------------------------------------------------------------------
1473 -- Layout
1474
1475 close :: { () }
1476         : vccurly               { () } -- context popped in lexer.
1477         | error                 {% popContext }
1478
1479 -----------------------------------------------------------------------------
1480 -- Miscellaneous (mostly renamings)
1481
1482 modid   :: { Located ModuleName }
1483         : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
1484         | QCONID                { L1 $ let (mod,c) = getQCONID $1 in
1485                                   mkModuleNameFS
1486                                    (mkFastString
1487                                      (unpackFS mod ++ '.':unpackFS c))
1488                                 }
1489
1490 commas :: { Int }
1491         : commas ','                    { $1 + 1 }
1492         | ','                           { 2 }
1493
1494 -----------------------------------------------------------------------------
1495
1496 {
1497 happyError :: P a
1498 happyError = srcParseFail
1499
1500 getVARID        (L _ (ITvarid    x)) = x
1501 getCONID        (L _ (ITconid    x)) = x
1502 getVARSYM       (L _ (ITvarsym   x)) = x
1503 getCONSYM       (L _ (ITconsym   x)) = x
1504 getQVARID       (L _ (ITqvarid   x)) = x
1505 getQCONID       (L _ (ITqconid   x)) = x
1506 getQVARSYM      (L _ (ITqvarsym  x)) = x
1507 getQCONSYM      (L _ (ITqconsym  x)) = x
1508 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
1509 getIPSPLITVARID (L _ (ITsplitipvarid x)) = x
1510 getCHAR         (L _ (ITchar     x)) = x
1511 getSTRING       (L _ (ITstring   x)) = x
1512 getINTEGER      (L _ (ITinteger  x)) = x
1513 getRATIONAL     (L _ (ITrational x)) = x
1514 getPRIMCHAR     (L _ (ITprimchar   x)) = x
1515 getPRIMSTRING   (L _ (ITprimstring x)) = x
1516 getPRIMINTEGER  (L _ (ITprimint    x)) = x
1517 getPRIMFLOAT    (L _ (ITprimfloat  x)) = x
1518 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
1519 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1520
1521 -- Utilities for combining source spans
1522 comb2 :: Located a -> Located b -> SrcSpan
1523 comb2 = combineLocs
1524
1525 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1526 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1527
1528 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1529 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1530                 combineSrcSpans (getLoc c) (getLoc d)
1531
1532 -- strict constructor version:
1533 {-# INLINE sL #-}
1534 sL :: SrcSpan -> a -> Located a
1535 sL span a = span `seq` L span a
1536
1537 -- Make a source location that is just the filename.  This seems slightly
1538 -- neater than trying to construct the span of the text within the file.
1539 fileSrcSpan :: P SrcSpan
1540 fileSrcSpan = do l <- getSrcLoc; return (mkGeneralSrcSpan (srcLocFile l))
1541 }