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