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         :  exportlist ',' export                { $3 : $1 }
 347         |  exportlist ','                       { $1 }
 348         |  export                               { [$1]  }
 349         |  {- empty -}                          { [] }
 350
 351    -- No longer allow things like [] and (,,,) to be exported
 352    -- They are built in syntax, always available
 353 export  :: { LIE RdrName }
 354         :  qvar                         { L1 (IEVar (unLoc $1)) }
 355         |  oqtycon                      { L1 (IEThingAbs (unLoc $1)) }
 356         |  oqtycon '(' '..' ')'         { LL (IEThingAll (unLoc $1)) }
 357         |  oqtycon '(' ')'              { LL (IEThingWith (unLoc $1) []) }
 358         |  oqtycon '(' qcnames ')'      { LL (IEThingWith (unLoc $1) (reverse $3)) }
 359         |  'module' modid               { LL (IEModuleContents (unLoc $2)) }
 360
 361 qcnames :: { [RdrName] }
 362         :  qcnames ',' qcname                   { unLoc $3 : $1 }
 363         |  qcname                               { [unLoc $1]  }
 364
 365 qcname  :: { Located RdrName }  -- Variable or data constructor
 366         :  qvar                                 { $1 }
 367         |  qcon                                 { $1 }
 368
 369 -----------------------------------------------------------------------------
 370 -- Import Declarations
 371
 372 -- import decls can be *empty*, or even just a string of semicolons
 373 -- whereas topdecls must contain at least one topdecl.
 374
 375 importdecls :: { [LImportDecl RdrName] }
 376         : importdecls ';' importdecl            { $3 : $1 }
 377         | importdecls ';'                       { $1 }
 378         | importdecl                            { [ $1 ] }
 379         | {- empty -}                           { [] }
 380
 381 importdecl :: { LImportDecl RdrName }
 382         : 'import' maybe_src optqualified modid maybeas maybeimpspec
 383                 { L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
 384
 385 maybe_src :: { IsBootInterface }
 386         : '{-# SOURCE' '#-}'                    { True }
 387         | {- empty -}                           { False }
 388
 389 optqualified :: { Bool }
 390         : 'qualified'                           { True  }
 391         | {- empty -}                           { False }
 392
 393 maybeas :: { Located (Maybe ModuleName) }
 394         : 'as' modid                            { LL (Just (unLoc $2)) }
 395         | {- empty -}                           { noLoc Nothing }
 396
 397 maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
 398         : impspec                               { L1 (Just (unLoc $1)) }
 399         | {- empty -}                           { noLoc Nothing }
 400
 401 impspec :: { Located (Bool, [LIE RdrName]) }
 402         :  '(' exportlist ')'                   { LL (False, reverse $2) }
 403         |  'hiding' '(' exportlist ')'          { LL (True,  reverse $3) }
 404
 405 -----------------------------------------------------------------------------
 406 -- Fixity Declarations
 407
 408 prec    :: { Int }
 409         : {- empty -}           { 9 }
 410         | INTEGER               {% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
 411
 412 infix   :: { Located FixityDirection }
 413         : 'infix'                               { L1 InfixN  }
 414         | 'infixl'                              { L1 InfixL  }
 415         | 'infixr'                              { L1 InfixR }
 416
 417 ops     :: { Located [Located RdrName] }
 418         : ops ',' op                            { LL ($3 : unLoc $1) }
 419         | op                                    { L1 [$1] }
 420
 421 -----------------------------------------------------------------------------
 422 -- Top-Level Declarations
 423
 424 topdecls :: { OrdList (LHsDecl RdrName) }
 425         : topdecls ';' topdecl          { $1 `appOL` $3 }
 426         | topdecls ';'                  { $1 }
 427         | topdecl                       { $1 }
 428
 429 topdecl :: { OrdList (LHsDecl RdrName) }
 430         : tycl_decl                     { unitOL (L1 (TyClD (unLoc $1))) }
 431         | 'instance' inst_type where
 432                 { let (binds,sigs) = cvBindsAndSigs (unLoc $3)
 433                   in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
 434         | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
 435         | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
 436         | '{-# DEPRECATED' deprecations '#-}'   { $2 }
 437         | '{-# RULES' rules '#-}'               { $2 }
 438         | decl                                  { unLoc $1 }
 439
 440         -- Template Haskell Extension
 441         | '$(' exp ')'                          { unitOL (LL $ SpliceD (SpliceDecl $2)) }
 442         | TH_ID_SPLICE                          { unitOL (LL $ SpliceD (SpliceDecl $
 443                                                         L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
 444                                                   )) }
 445
 446 tycl_decl :: { LTyClDecl RdrName }
 447         : 'type' type '=' ctype
 448                 -- Note type on the left of the '='; this allows
 449                 -- infix type constructors to be declared
 450                 --
 451                 -- Note ctype, not sigtype, on the right
 452                 -- We allow an explicit for-all but we don't insert one
 453                 -- in   type Foo a = (b,b)
 454                 -- Instead we just say b is out of scope
 455                 {% do { (tc,tvs) <- checkSynHdr $2
 456                       ; return (LL (TySynonym tc tvs $4)) } }
 457
 458         | data_or_newtype tycl_hdr constrs deriving
 459                 { L (comb4 $1 $2 $3 $4) -- We need the location on tycl_hdr
 460                                         -- in case constrs and deriving are both empty
 461                     (mkTyData (unLoc $1) (unLoc $2) Nothing (reverse (unLoc $3)) (unLoc $4)) }
 462
 463         | data_or_newtype tycl_hdr opt_kind_sig
 464                  'where' gadt_constrlist
 465                  deriving
 466                 { L (comb4 $1 $2 $4 $5)
 467                     (mkTyData (unLoc $1) (unLoc $2) $3 (reverse (unLoc $5)) (unLoc $6)) }
 468
 469         | 'class' tycl_hdr fds where
 470                 { let
 471                         (binds,sigs) = cvBindsAndSigs (unLoc $4)
 472                   in
 473                   L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs
 474                                           binds) }
 475
 476 data_or_newtype :: { Located NewOrData }
 477         : 'data'        { L1 DataType }
 478         | 'newtype'     { L1 NewType }
 479
 480 opt_kind_sig :: { Maybe Kind }
 481         :                               { Nothing }
 482         | '::' kind                     { Just $2 }
 483
 484 -- tycl_hdr parses the header of a type or class decl,
 485 -- which takes the form
 486 --      T a b
 487 --      Eq a => T a
 488 --      (Eq a, Ord b) => T a b
 489 -- Rather a lot of inlining here, else we get reduce/reduce errors
 490 tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
 491         : context '=>' type             {% checkTyClHdr $1         $3 >>= return.LL }
 492         | type                          {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
 493
 494 -----------------------------------------------------------------------------
 495 -- Nested declarations
 496
 497 decls   :: { Located (OrdList (LHsDecl RdrName)) }
 498         : decls ';' decl                { LL (unLoc $1 `appOL` unLoc $3) }
 499         | decls ';'                     { LL (unLoc $1) }
 500         | decl                          { $1 }
 501         | {- empty -}                   { noLoc nilOL }
 502
 503
 504 decllist :: { Located (OrdList (LHsDecl RdrName)) }
 505         : '{'            decls '}'      { LL (unLoc $2) }
 506         |     vocurly    decls close    { $2 }
 507
 508 where   :: { Located (OrdList (LHsDecl RdrName)) }
 509                                 -- No implicit parameters
 510         : 'where' decllist              { LL (unLoc $2) }
 511         | {- empty -}                   { noLoc nilOL }
 512
 513 binds   ::  { Located (HsLocalBinds RdrName) }          -- May have implicit parameters
 514         : decllist                      { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
 515         | '{'            dbinds '}'     { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
 516         |     vocurly    dbinds close   { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
 517
 518 wherebinds :: { Located (HsLocalBinds RdrName) }        -- May have implicit parameters
 519         : 'where' binds                 { LL (unLoc $2) }
 520         | {- empty -}                   { noLoc emptyLocalBinds }
 521
 522
 523 -----------------------------------------------------------------------------
 524 -- Transformation Rules
 525
 526 rules   :: { OrdList (LHsDecl RdrName) }
 527         :  rules ';' rule                       { $1 `snocOL` $3 }
 528         |  rules ';'                            { $1 }
 529         |  rule                                 { unitOL $1 }
 530         |  {- empty -}                          { nilOL }
 531
 532 rule    :: { LHsDecl RdrName }
 533         : STRING activation rule_forall infixexp '=' exp
 534              { LL $ RuleD (HsRule (getSTRING $1)
 535                                   ($2 `orElse` AlwaysActive)
 536                                   $3 $4 placeHolderNames $6 placeHolderNames) }
 537
 538 activation :: { Maybe Activation }
 539         : {- empty -}                           { Nothing }
 540         | explicit_activation                   { Just $1 }
 541
 542 explicit_activation :: { Activation }  -- In brackets
 543         : '[' INTEGER ']'               { ActiveAfter  (fromInteger (getINTEGER $2)) }
 544         | '[' '~' INTEGER ']'           { ActiveBefore (fromInteger (getINTEGER $3)) }
 545
 546 rule_forall :: { [RuleBndr RdrName] }
 547         : 'forall' rule_var_list '.'            { $2 }
 548         | {- empty -}                           { [] }
 549
 550 rule_var_list :: { [RuleBndr RdrName] }
 551         : rule_var                              { [$1] }
 552         | rule_var rule_var_list                { $1 : $2 }
 553
 554 rule_var :: { RuleBndr RdrName }
 555         : varid                                 { RuleBndr $1 }
 556         | '(' varid '::' ctype ')'              { RuleBndrSig $2 $4 }
 557
 558 -----------------------------------------------------------------------------
 559 -- Deprecations (c.f. rules)
 560
 561 deprecations :: { OrdList (LHsDecl RdrName) }
 562         : deprecations ';' deprecation          { $1 `appOL` $3 }
 563         | deprecations ';'                      { $1 }
 564         | deprecation                           { $1 }
 565         | {- empty -}                           { nilOL }
 566
 567 -- SUP: TEMPORARY HACK, not checking for `module Foo'
 568 deprecation :: { OrdList (LHsDecl RdrName) }
 569         : depreclist STRING
 570                 { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2))
 571                        | n <- unLoc $1 ] }
 572
 573
 574 -----------------------------------------------------------------------------
 575 -- Foreign import and export declarations
 576
 577 fdecl :: { LHsDecl RdrName }
 578 fdecl : 'import' callconv safety fspec
 579                 {% mkImport $2 $3 (unLoc $4) >>= return.LL }
 580       | 'import' callconv        fspec
 581                 {% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
 582                         return (LL d) } }
 583       | 'export' callconv fspec
 584                 {% mkExport $2 (unLoc $3) >>= return.LL }
 585
 586 callconv :: { CallConv }
 587           : 'stdcall'                   { CCall  StdCallConv }
 588           | 'ccall'                     { CCall  CCallConv   }
 589           | 'dotnet'                    { DNCall             }
 590
 591 safety :: { Safety }
 592         : 'unsafe'                      { PlayRisky }
 593         | 'safe'                        { PlaySafe  False }
 594         | 'threadsafe'                  { PlaySafe  True }
 595
 596 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
 597        : STRING var '::' sigtype      { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
 598        |        var '::' sigtype      { LL (noLoc nilFS, $1, $3) }
 599          -- if the entity string is missing, it defaults to the empty string;
 600          -- the meaning of an empty entity string depends on the calling
 601          -- convention
 602
 603 -----------------------------------------------------------------------------
 604 -- Type signatures
 605
 606 opt_sig :: { Maybe (LHsType RdrName) }
 607         : {- empty -}                   { Nothing }
 608         | '::' sigtype                  { Just $2 }
 609
 610 opt_asig :: { Maybe (LHsType RdrName) }
 611         : {- empty -}                   { Nothing }
 612         | '::' atype                    { Just $2 }
 613
 614 sigtypes1 :: { [LHsType RdrName] }
 615         : sigtype                       { [ $1 ] }
 616         | sigtype ',' sigtypes1         { $1 : $3 }
 617
 618 sigtype :: { LHsType RdrName }
 619         : ctype                         { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
 620         -- Wrap an Implicit forall if there isn't one there already
 621
 622 sig_vars :: { Located [Located RdrName] }
 623          : sig_vars ',' var             { LL ($3 : unLoc $1) }
 624          | var                          { L1 [$1] }
 625
 626 -----------------------------------------------------------------------------
 627 -- Types
 628
 629 strict_mark :: { Located HsBang }
 630         : '!'                           { L1 HsStrict }
 631         | '{-# UNPACK' '#-}' '!'        { LL HsUnbox }
 632
 633 -- A ctype is a for-all type
 634 ctype   :: { LHsType RdrName }
 635         : 'forall' tv_bndrs '.' ctype   { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
 636         | context '=>' type             { LL $ mkImplicitHsForAllTy   $1 $3 }
 637         -- A type of form (context => type) is an *implicit* HsForAllTy
 638         | type                          { $1 }
 639
 640 -- We parse a context as a btype so that we don't get reduce/reduce
 641 -- errors in ctype.  The basic problem is that
 642 --      (Eq a, Ord a)
 643 -- looks so much like a tuple type.  We can't tell until we find the =>
 644 context :: { LHsContext RdrName }
 645         : btype                         {% checkContext $1 }
 646
 647 type :: { LHsType RdrName }
 648         : ipvar '::' gentype            { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
 649         | gentype                       { $1 }
 650
 651 gentype :: { LHsType RdrName }
 652         : btype                         { $1 }
 653         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
 654         | btype tyvarop  gentype        { LL $ HsOpTy $1 $2 $3 }
 655         | btype '->' ctype              { LL $ HsFunTy $1 $3 }
 656
 657 btype :: { LHsType RdrName }
 658         : btype atype                   { LL $ HsAppTy $1 $2 }
 659         | atype                         { $1 }
 660
 661 atype :: { LHsType RdrName }
 662         : gtycon                        { L1 (HsTyVar (unLoc $1)) }
 663         | tyvar                         { L1 (HsTyVar (unLoc $1)) }
 664         | strict_mark atype             { LL (HsBangTy (unLoc $1) $2) }
 665         | '(' ctype ',' comma_types1 ')'  { LL $ HsTupleTy Boxed  ($2:$4) }
 666         | '(#' comma_types1 '#)'        { LL $ HsTupleTy Unboxed $2     }
 667         | '[' ctype ']'                 { LL $ HsListTy  $2 }
 668         | '[:' ctype ':]'               { LL $ HsPArrTy  $2 }
 669         | '(' ctype ')'                 { LL $ HsParTy   $2 }
 670         | '(' ctype '::' kind ')'       { LL $ HsKindSig $2 $4 }
 671 -- Generics
 672         | INTEGER                       { L1 (HsNumTy (getINTEGER $1)) }
 673
 674 -- An inst_type is what occurs in the head of an instance decl
 675 --      e.g.  (Foo a, Gaz b) => Wibble a b
 676 -- It's kept as a single type, with a MonoDictTy at the right
 677 -- hand corner, for convenience.
 678 inst_type :: { LHsType RdrName }
 679         : sigtype                       {% checkInstType $1 }
 680
 681 inst_types1 :: { [LHsType RdrName] }
 682         : inst_type                     { [$1] }
 683         | inst_type ',' inst_types1     { $1 : $3 }
 684
 685 comma_types0  :: { [LHsType RdrName] }
 686         : comma_types1                  { $1 }
 687         | {- empty -}                   { [] }
 688
 689 comma_types1    :: { [LHsType RdrName] }
 690         : ctype                         { [$1] }
 691         | ctype  ',' comma_types1       { $1 : $3 }
 692
 693 tv_bndrs :: { [LHsTyVarBndr RdrName] }
 694          : tv_bndr tv_bndrs             { $1 : $2 }
 695          | {- empty -}                  { [] }
 696
 697 tv_bndr :: { LHsTyVarBndr RdrName }
 698         : tyvar                         { L1 (UserTyVar (unLoc $1)) }
 699         | '(' tyvar '::' kind ')'       { LL (KindedTyVar (unLoc $2) $4) }
 700
 701 fds :: { Located [Located ([RdrName], [RdrName])] }
 702         : {- empty -}                   { noLoc [] }
 703         | '|' fds1                      { LL (reverse (unLoc $2)) }
 704
 705 fds1 :: { Located [Located ([RdrName], [RdrName])] }
 706         : fds1 ',' fd                   { LL ($3 : unLoc $1) }
 707         | fd                            { L1 [$1] }
 708
 709 fd :: { Located ([RdrName], [RdrName]) }
 710         : varids0 '->' varids0          { L (comb3 $1 $2 $3)
 711                                            (reverse (unLoc $1), reverse (unLoc $3)) }
 712
 713 varids0 :: { Located [RdrName] }
 714         : {- empty -}                   { noLoc [] }
 715         | varids0 tyvar                 { LL (unLoc $2 : unLoc $1) }
 716
 717 -----------------------------------------------------------------------------
 718 -- Kinds
 719
 720 kind    :: { Kind }
 721         : akind                 { $1 }
 722         | akind '->' kind       { mkArrowKind $1 $3 }
 723
 724 akind   :: { Kind }
 725         : '*'                   { liftedTypeKind }
 726         | '!'                   { unliftedTypeKind }
 727         | '(' kind ')'          { $2 }
 728
 729
 730 -----------------------------------------------------------------------------
 731 -- Datatype declarations
 732
 733 gadt_constrlist :: { Located [LConDecl RdrName] }
 734         : '{'            gadt_constrs '}'       { LL (unLoc $2) }
 735         |     vocurly    gadt_constrs close     { $2 }
 736
 737 gadt_constrs :: { Located [LConDecl RdrName] }
 738         : gadt_constrs ';' gadt_constr  { LL ($3 : unLoc $1) }
 739         | gadt_constrs ';'              { $1 }
 740         | gadt_constr                   { L1 [$1] }
 741
 742 -- We allow the following forms:
 743 --      C :: Eq a => a -> T a
 744 --      C :: forall a. Eq a => !a -> T a
 745 --      D { x,y :: a } :: T a
 746 --      forall a. Eq a => D { x,y :: a } :: T a
 747
 748 gadt_constr :: { LConDecl RdrName }
 749         : con '::' sigtype
 750               { LL (mkGadtDecl $1 $3) }
 751         -- Syntax: Maybe merge the record stuff with the single-case above?
 752         --         (to kill the mostly harmless reduce/reduce error)
 753         -- XXX revisit autrijus
 754         | constr_stuff_record '::' sigtype
 755                 { let (con,details) = unLoc $1 in
 756                   LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3)) }
 757 {-
 758         | forall context '=>' constr_stuff_record '::' sigtype
 759                 { let (con,details) = unLoc $4 in
 760                   LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6)) }
 761         | forall constr_stuff_record '::' sigtype
 762                 { let (con,details) = unLoc $2 in
 763                   LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4)) }
 764 -}
 765
 766
 767 constrs :: { Located [LConDecl RdrName] }
 768         : {- empty; a GHC extension -}  { noLoc [] }
 769         | '=' constrs1                  { LL (unLoc $2) }
 770
 771 constrs1 :: { Located [LConDecl RdrName] }
 772         : constrs1 '|' constr           { LL ($3 : unLoc $1) }
 773         | constr                        { L1 [$1] }
 774
 775 constr :: { LConDecl RdrName }
 776         : forall context '=>' constr_stuff
 777                 { let (con,details) = unLoc $4 in
 778                   LL (ConDecl con Explicit (unLoc $1) $2 details ResTyH98) }
 779         | forall constr_stuff
 780                 { let (con,details) = unLoc $2 in
 781                   LL (ConDecl con Explicit (unLoc $1) (noLoc []) details ResTyH98) }
 782
 783 forall :: { Located [LHsTyVarBndr RdrName] }
 784         : 'forall' tv_bndrs '.'         { LL $2 }
 785         | {- empty -}                   { noLoc [] }
 786
 787 constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
 788 -- We parse the constructor declaration
 789 --      C t1 t2
 790 -- as a btype (treating C as a type constructor) and then convert C to be
 791 -- a data constructor.  Reason: it might continue like this:
 792 --      C t1 t2 %: D Int
 793 -- in which case C really would be a type constructor.  We can't resolve this
 794 -- ambiguity till we come across the constructor oprerator :% (or not, more usually)
 795         : btype                         {% mkPrefixCon $1 [] >>= return.LL }
 796         | oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.LL }
 797         | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.LL }
 798         | btype conop btype             { LL ($2, InfixCon $1 $3) }
 799
 800 constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
 801         : oqtycon '{' '}'               {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
 802         | oqtycon '{' fielddecls '}'    {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
 803
 804 fielddecls :: { [([Located RdrName], LBangType RdrName)] }
 805         : fielddecl ',' fielddecls      { unLoc $1 : $3 }
 806         | fielddecl                     { [unLoc $1] }
 807
 808 fielddecl :: { Located ([Located RdrName], LBangType RdrName) }
 809         : sig_vars '::' ctype           { LL (reverse (unLoc $1), $3) }
 810
 811 -- We allow the odd-looking 'inst_type' in a deriving clause, so that
 812 -- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
 813 -- The 'C [a]' part is converted to an HsPredTy by checkInstType
 814 -- We don't allow a context, but that's sorted out by the type checker.
 815 deriving :: { Located (Maybe [LHsType RdrName]) }
 816         : {- empty -}                           { noLoc Nothing }
 817         | 'deriving' qtycon     {% do { let { L loc tv = $2 }
 818                                       ; p <- checkInstType (L loc (HsTyVar tv))
 819                                       ; return (LL (Just [p])) } }
 820         | 'deriving' '(' ')'                    { LL (Just []) }
 821         | 'deriving' '(' inst_types1 ')'        { LL (Just $3) }
 822              -- Glasgow extension: allow partial
 823              -- applications in derivings
 824
 825 -----------------------------------------------------------------------------
 826 -- Value definitions
 827
 828 {- There's an awkward overlap with a type signature.  Consider
 829         f :: Int -> Int = ...rhs...
 830    Then we can't tell whether it's a type signature or a value
 831    definition with a result signature until we see the '='.
 832    So we have to inline enough to postpone reductions until we know.
 833 -}
 834
 835 {-
 836   ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
 837   instead of qvar, we get another shift/reduce-conflict. Consider the
 838   following programs:
 839
 840      { (^^) :: Int->Int ; }          Type signature; only var allowed
 841
 842      { (^^) :: Int->Int = ... ; }    Value defn with result signature;
 843                                      qvar allowed (because of instance decls)
 844
 845   We can't tell whether to reduce var to qvar until after we've read the signatures.
 846 -}
 847
 848 decl    :: { Located (OrdList (LHsDecl RdrName)) }
 849         : sigdecl                       { $1 }
 850         | '!' infixexp rhs              {% do { pat <- checkPattern $2;
 851                                                 return (LL $ unitOL $ LL $ ValD $
 852                                                         PatBind (LL $ BangPat pat) (unLoc $3)
 853                                                                 placeHolderType placeHolderNames) } }
 854         | infixexp opt_sig rhs          {% do { r <- checkValDef $1 $2 $3;
 855                                                 return (LL $ unitOL (LL $ ValD r)) } }
 856
 857 rhs     :: { Located (GRHSs RdrName) }
 858         : '=' exp wherebinds    { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
 859         | gdrhs wherebinds      { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) }
 860
 861 gdrhs :: { Located [LGRHS RdrName] }
 862         : gdrhs gdrh            { LL ($2 : unLoc $1) }
 863         | gdrh                  { L1 [$1] }
 864
 865 gdrh :: { LGRHS RdrName }
 866         : '|' quals '=' exp     { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
 867
 868 sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
 869         : infixexp '::' sigtype
 870                                 {% do s <- checkValSig $1 $3;
 871                                       return (LL $ unitOL (LL $ SigD s)) }
 872                 -- See the above notes for why we need infixexp here
 873         | var ',' sig_vars '::' sigtype
 874                                 { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
 875         | infix prec ops        { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
 876                                              | n <- unLoc $3 ] }
 877         | '{-# INLINE'   activation qvar '#-}'
 878                                 { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
 879         | '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
 880                                 { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
 881                                             | t <- $4] }
 882         | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
 883                                 { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
 884                                             | t <- $5] }
 885         | '{-# SPECIALISE' 'instance' inst_type '#-}'
 886                                 { LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
 887
 888 -----------------------------------------------------------------------------
 889 -- Expressions
 890
 891 exp   :: { LHsExpr RdrName }
 892         : infixexp '::' sigtype         { LL $ ExprWithTySig $1 $3 }
 893         | infixexp '-<' exp             { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
 894         | infixexp '>-' exp             { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
 895         | infixexp '-<<' exp            { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
 896         | infixexp '>>-' exp            { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
 897         | infixexp                      { $1 }
 898
 899 infixexp :: { LHsExpr RdrName }
 900         : exp10                         { $1 }
 901         | infixexp qop exp10            { LL (OpApp $1 $2 (panic "fixity") $3) }
 902
 903 exp10 :: { LHsExpr RdrName }
 904         : '\\' aexp aexps opt_asig '->' exp
 905                         {% checkPatterns ($2 : reverse $3) >>= \ ps ->
 906                            return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4
 907                                             (GRHSs (unguardedRHS $6) emptyLocalBinds
 908                                                         )])) }
 909         | 'let' binds 'in' exp                  { LL $ HsLet (unLoc $2) $4 }
 910         | 'if' exp 'then' exp 'else' exp        { LL $ HsIf $2 $4 $6 }
 911         | 'case' exp 'of' altslist              { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
 912         | '-' fexp                              { LL $ mkHsNegApp $2 }
 913
 914         | 'do' stmtlist                 {% let loc = comb2 $1 $2 in
 915                                            checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
 916                                            return (L loc (mkHsDo DoExpr stmts body)) }
 917         | 'mdo' stmtlist                {% let loc = comb2 $1 $2 in
 918                                            checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
 919                                            return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
 920         | scc_annot exp                         { LL $ if opt_SccProfilingOn
 921                                                         then HsSCC (unLoc $1) $2
 922                                                         else HsPar $2 }
 923
 924         | 'proc' aexp '->' exp
 925                         {% checkPattern $2 >>= \ p ->
 926                            return (LL $ HsProc p (LL $ HsCmdTop $4 []
 927                                                    placeHolderType undefined)) }
 928                                                 -- TODO: is LL right here?
 929
 930         | '{-# CORE' STRING '#-}' exp           { LL $ HsCoreAnn (getSTRING $2) $4 }
 931                                                     -- hdaume: core annotation
 932         | fexp                                  { $1 }
 933
 934 scc_annot :: { Located FastString }
 935         : '_scc_' STRING                        { LL $ getSTRING $2 }
 936         | '{-# SCC' STRING '#-}'                { LL $ getSTRING $2 }
 937
 938 fexp    :: { LHsExpr RdrName }
 939         : fexp aexp                             { LL $ HsApp $1 $2 }
 940         | aexp                                  { $1 }
 941
 942 aexps   :: { [LHsExpr RdrName] }
 943         : aexps aexp                            { $2 : $1 }
 944         | {- empty -}                           { [] }
 945
 946 aexp    :: { LHsExpr RdrName }
 947         : qvar '@' aexp                 { LL $ EAsPat $1 $3 }
 948         | '~' aexp                      { LL $ ELazyPat $2 }
 949 --      | '!' aexp                      { LL $ EBangPat $2 }
 950         | aexp1                         { $1 }
 951
 952 aexp1   :: { LHsExpr RdrName }
 953         : aexp1 '{' fbinds '}'  {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4)
 954                                                         (reverse $3);
 955                                         return (LL r) }}
 956         | aexp2                 { $1 }
 957
 958 -- Here was the syntax for type applications that I was planning
 959 -- but there are difficulties (e.g. what order for type args)
 960 -- so it's not enabled yet.
 961 -- But this case *is* used for the left hand side of a generic definition,
 962 -- which is parsed as an expression before being munged into a pattern
 963         | qcname '{|' gentype '|}'      { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
 964                                                      (sL (getLoc $3) (HsType $3)) }
 965
 966 aexp2   :: { LHsExpr RdrName }
 967         : ipvar                         { L1 (HsIPVar $! unLoc $1) }
 968         | qcname                        { L1 (HsVar   $! unLoc $1) }
 969         | literal                       { L1 (HsLit   $! unLoc $1) }
 970         | INTEGER                       { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
 971         | RATIONAL                      { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
 972         | '(' exp ')'                   { LL (HsPar $2) }
 973         | '(' texp ',' texps ')'        { LL $ ExplicitTuple ($2 : reverse $4) Boxed }
 974         | '(#' texps '#)'               { LL $ ExplicitTuple (reverse $2)      Unboxed }
 975         | '[' list ']'                  { LL (unLoc $2) }
 976         | '[:' parr ':]'                { LL (unLoc $2) }
 977         | '(' infixexp qop ')'          { LL $ SectionL $2 $3 }
 978         | '(' qopm infixexp ')'         { LL $ SectionR $2 $3 }
 979         | '_'                           { L1 EWildPat }
 980
 981         -- Template Haskell Extension
 982         | TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice
 983                                         (L1 $ HsVar (mkUnqual varName
 984                                                         (getTH_ID_SPLICE $1)))) } -- $x
 985         | '$(' exp ')'          { LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
 986
 987         | TH_VAR_QUOTE qvar     { LL $ HsBracket (VarBr (unLoc $2)) }
 988         | TH_VAR_QUOTE qcon     { LL $ HsBracket (VarBr (unLoc $2)) }
 989         | TH_TY_QUOTE tyvar     { LL $ HsBracket (VarBr (unLoc $2)) }
 990         | TH_TY_QUOTE gtycon    { LL $ HsBracket (VarBr (unLoc $2)) }
 991         | '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }
 992         | '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }
 993         | '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
 994                                            return (LL $ HsBracket (PatBr p)) }
 995         | '[d|' cvtopbody '|]'  { LL $ HsBracket (DecBr (mkGroup $2)) }
 996
 997         -- arrow notation extension
 998         | '(|' aexp2 cmdargs '|)'       { LL $ HsArrForm $2 Nothing (reverse $3) }
 999
1000 cmdargs :: { [LHsCmdTop RdrName] }
1001         : cmdargs acmd                  { $2 : $1 }
1002         | {- empty -}                   { [] }
1003
1004 acmd    :: { LHsCmdTop RdrName }
1005         : aexp2                 { L1 $ HsCmdTop $1 [] placeHolderType undefined }
1006
1007 cvtopbody :: { [LHsDecl RdrName] }
1008         :  '{'            cvtopdecls0 '}'               { $2 }
1009         |      vocurly    cvtopdecls0 close             { $2 }
1010
1011 cvtopdecls0 :: { [LHsDecl RdrName] }
1012         : {- empty -}           { [] }
1013         | cvtopdecls            { $1 }
1014
1015 texp :: { LHsExpr RdrName }
1016         : exp                           { $1 }
1017         | qopm infixexp                 { LL $ SectionR $1 $2 }
1018         -- The second production is really here only for bang patterns
1019         -- but
1020
1021 texps :: { [LHsExpr RdrName] }
1022         : texps ',' texp                { $3 : $1 }
1023         | texp                          { [$1] }
1024
1025
1026 -----------------------------------------------------------------------------
1027 -- List expressions
1028
1029 -- The rules below are little bit contorted to keep lexps left-recursive while
1030 -- avoiding another shift/reduce-conflict.
1031
1032 list :: { LHsExpr RdrName }
1033         : texp                  { L1 $ ExplicitList placeHolderType [$1] }
1034         | lexps                 { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
1035         | texp '..'             { LL $ ArithSeq noPostTcExpr (From $1) }
1036         | texp ',' exp '..'     { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
1037         | texp '..' exp         { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
1038         | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1039         | texp pquals           { sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
1040
1041 lexps :: { Located [LHsExpr RdrName] }
1042         : lexps ',' texp                { LL ($3 : unLoc $1) }
1043         | texp ',' texp                 { LL [$3,$1] }
1044
1045 -----------------------------------------------------------------------------
1046 -- List Comprehensions
1047
1048 pquals :: { Located [LStmt RdrName] }   -- Either a singleton ParStmt,
1049                                         -- or a reversed list of Stmts
1050         : pquals1                       { case unLoc $1 of
1051                                             [qs] -> L1 qs
1052                                             qss  -> L1 [L1 (ParStmt stmtss)]
1053                                                  where
1054                                                     stmtss = [ (reverse qs, undefined)
1055                                                              | qs <- qss ]
1056                                         }
1057
1058 pquals1 :: { Located [[LStmt RdrName]] }
1059         : pquals1 '|' quals             { LL (unLoc $3 : unLoc $1) }
1060         | '|' quals                     { L (getLoc $2) [unLoc $2] }
1061
1062 quals :: { Located [LStmt RdrName] }
1063         : quals ',' qual                { LL ($3 : unLoc $1) }
1064         | qual                          { L1 [$1] }
1065
1066 -----------------------------------------------------------------------------
1067 -- Parallel array expressions
1068
1069 -- The rules below are little bit contorted; see the list case for details.
1070 -- Note that, in contrast to lists, we only have finite arithmetic sequences.
1071 -- Moreover, we allow explicit arrays with no element (represented by the nil
1072 -- constructor in the list case).
1073
1074 parr :: { LHsExpr RdrName }
1075         :                               { noLoc (ExplicitPArr placeHolderType []) }
1076         | exp                           { L1 $ ExplicitPArr placeHolderType [$1] }
1077         | lexps                         { L1 $ ExplicitPArr placeHolderType
1078                                                        (reverse (unLoc $1)) }
1079         | exp '..' exp                  { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
1080         | exp ',' exp '..' exp          { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
1081         | exp pquals                    { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
1082
1083 -- We are reusing `lexps' and `pquals' from the list case.
1084
1085 -----------------------------------------------------------------------------
1086 -- Case alternatives
1087
1088 altslist :: { Located [LMatch RdrName] }
1089         : '{'            alts '}'       { LL (reverse (unLoc $2)) }
1090         |     vocurly    alts  close    { L (getLoc $2) (reverse (unLoc $2)) }
1091
1092 alts    :: { Located [LMatch RdrName] }
1093         : alts1                         { L1 (unLoc $1) }
1094         | ';' alts                      { LL (unLoc $2) }
1095
1096 alts1   :: { Located [LMatch RdrName] }
1097         : alts1 ';' alt                 { LL ($3 : unLoc $1) }
1098         | alts1 ';'                     { LL (unLoc $1) }
1099         | alt                           { L1 [$1] }
1100
1101 alt     :: { LMatch RdrName }
1102         : infixexp opt_sig alt_rhs      {%  checkPattern $1 >>= \p ->
1103                                             return (LL (Match [p] $2 (unLoc $3))) }
1104
1105 alt_rhs :: { Located (GRHSs RdrName) }
1106         : ralt wherebinds               { LL (GRHSs (unLoc $1) (unLoc $2)) }
1107
1108 ralt :: { Located [LGRHS RdrName] }
1109         : '->' exp                      { LL (unguardedRHS $2) }
1110         | gdpats                        { L1 (reverse (unLoc $1)) }
1111
1112 gdpats :: { Located [LGRHS RdrName] }
1113         : gdpats gdpat                  { LL ($2 : unLoc $1) }
1114         | gdpat                         { L1 [$1] }
1115
1116 gdpat   :: { LGRHS RdrName }
1117         : '|' quals '->' exp            { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
1118
1119 -----------------------------------------------------------------------------
1120 -- Statement sequences
1121
1122 stmtlist :: { Located [LStmt RdrName] }
1123         : '{'           stmts '}'       { LL (unLoc $2) }
1124         |     vocurly   stmts close     { $2 }
1125
1126 --      do { ;; s ; s ; ; s ;; }
1127 -- The last Stmt should be an expression, but that's hard to enforce
1128 -- here, because we need too much lookahead if we see do { e ; }
1129 -- So we use ExprStmts throughout, and switch the last one over
1130 -- in ParseUtils.checkDo instead
1131 stmts :: { Located [LStmt RdrName] }
1132         : stmt stmts_help               { LL ($1 : unLoc $2) }
1133         | ';' stmts                     { LL (unLoc $2) }
1134         | {- empty -}                   { noLoc [] }
1135
1136 stmts_help :: { Located [LStmt RdrName] } -- might be empty
1137         : ';' stmts                     { LL (unLoc $2) }
1138         | {- empty -}                   { noLoc [] }
1139
1140 -- For typing stmts at the GHCi prompt, where
1141 -- the input may consist of just comments.
1142 maybe_stmt :: { Maybe (LStmt RdrName) }
1143         : stmt                          { Just $1 }
1144         | {- nothing -}                 { Nothing }
1145
1146 stmt  :: { LStmt RdrName }
1147         : qual                          { $1 }
1148         | infixexp '->' exp             {% checkPattern $3 >>= \p ->
1149                                            return (LL $ mkBindStmt p $1) }
1150         | 'rec' stmtlist                { LL $ mkRecStmt (unLoc $2) }
1151
1152 qual  :: { LStmt RdrName }
1153         : exp '<-' exp                  {% checkPattern $1 >>= \p ->
1154                                            return (LL $ mkBindStmt p $3) }
1155         | exp                           { L1 $ mkExprStmt $1 }
1156         | 'let' binds                   { LL $ LetStmt (unLoc $2) }
1157
1158 -----------------------------------------------------------------------------
1159 -- Record Field Update/Construction
1160
1161 fbinds  :: { HsRecordBinds RdrName }
1162         : fbinds1                       { $1 }
1163         | {- empty -}                   { [] }
1164
1165 fbinds1 :: { HsRecordBinds RdrName }
1166         : fbinds1 ',' fbind             { $3 : $1 }
1167         | fbind                         { [$1] }
1168
1169 fbind   :: { (Located RdrName, LHsExpr RdrName) }
1170         : qvar '=' exp                  { ($1,$3) }
1171
1172 -----------------------------------------------------------------------------
1173 -- Implicit Parameter Bindings
1174
1175 dbinds  :: { Located [LIPBind RdrName] }
1176         : dbinds ';' dbind              { LL ($3 : unLoc $1) }
1177         | dbinds ';'                    { LL (unLoc $1) }
1178         | dbind                         { L1 [$1] }
1179 --      | {- empty -}                   { [] }
1180
1181 dbind   :: { LIPBind RdrName }
1182 dbind   : ipvar '=' exp                 { LL (IPBind (unLoc $1) $3) }
1183
1184 ipvar   :: { Located (IPName RdrName) }
1185         : IPDUPVARID            { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
1186         | IPSPLITVARID          { L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
1187
1188 -----------------------------------------------------------------------------
1189 -- Deprecations
1190
1191 depreclist :: { Located [RdrName] }
1192 depreclist : deprec_var                 { L1 [unLoc $1] }
1193            | deprec_var ',' depreclist  { LL (unLoc $1 : unLoc $3) }
1194
1195 deprec_var :: { Located RdrName }
1196 deprec_var : var                        { $1 }
1197            | con                        { $1 }
1198
1199 -----------------------------------------
1200 -- Data constructors
1201 qcon    :: { Located RdrName }
1202         : qconid                { $1 }
1203         | '(' qconsym ')'       { LL (unLoc $2) }
1204         | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1205 -- The case of '[:' ':]' is part of the production `parr'
1206
1207 con     :: { Located RdrName }
1208         : conid                 { $1 }
1209         | '(' consym ')'        { LL (unLoc $2) }
1210         | sysdcon               { L1 $ nameRdrName (dataConName (unLoc $1)) }
1211
1212 sysdcon :: { Located DataCon }  -- Wired in data constructors
1213         : '(' ')'               { LL unitDataCon }
1214         | '(' commas ')'        { LL $ tupleCon Boxed $2 }
1215         | '[' ']'               { LL nilDataCon }
1216
1217 conop :: { Located RdrName }
1218         : consym                { $1 }
1219         | '`' conid '`'         { LL (unLoc $2) }
1220
1221 qconop :: { Located RdrName }
1222         : qconsym               { $1 }
1223         | '`' qconid '`'        { LL (unLoc $2) }
1224
1225 -----------------------------------------------------------------------------
1226 -- Type constructors
1227
1228 gtycon  :: { Located RdrName }  -- A "general" qualified tycon
1229         : oqtycon                       { $1 }
1230         | '(' ')'                       { LL $ getRdrName unitTyCon }
1231         | '(' commas ')'                { LL $ getRdrName (tupleTyCon Boxed $2) }
1232         | '(' '->' ')'                  { LL $ getRdrName funTyCon }
1233         | '[' ']'                       { LL $ listTyCon_RDR }
1234         | '[:' ':]'                     { LL $ parrTyCon_RDR }
1235
1236 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon
1237         : qtycon                        { $1 }
1238         | '(' qtyconsym ')'             { LL (unLoc $2) }
1239
1240 qtyconop :: { Located RdrName } -- Qualified or unqualified
1241         : qtyconsym                     { $1 }
1242         | '`' qtycon '`'                { LL (unLoc $2) }
1243
1244 qtycon :: { Located RdrName }   -- Qualified or unqualified
1245         : QCONID                        { L1 $! mkQual tcClsName (getQCONID $1) }
1246         | tycon                         { $1 }
1247
1248 tycon   :: { Located RdrName }  -- Unqualified
1249         : CONID                         { L1 $! mkUnqual tcClsName (getCONID $1) }
1250
1251 qtyconsym :: { Located RdrName }
1252         : QCONSYM                       { L1 $! mkQual tcClsName (getQCONSYM $1) }
1253         | tyconsym                      { $1 }
1254
1255 tyconsym :: { Located RdrName }
1256         : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
1257
1258 -----------------------------------------------------------------------------
1259 -- Operators
1260
1261 op      :: { Located RdrName }   -- used in infix decls
1262         : varop                 { $1 }
1263         | conop                 { $1 }
1264
1265 varop   :: { Located RdrName }
1266         : varsym                { $1 }
1267         | '`' varid '`'         { LL (unLoc $2) }
1268
1269 qop     :: { LHsExpr RdrName }   -- used in sections
1270         : qvarop                { L1 $ HsVar (unLoc $1) }
1271         | qconop                { L1 $ HsVar (unLoc $1) }
1272
1273 qopm    :: { LHsExpr RdrName }   -- used in sections
1274         : qvaropm               { L1 $ HsVar (unLoc $1) }
1275         | qconop                { L1 $ HsVar (unLoc $1) }
1276
1277 qvarop :: { Located RdrName }
1278         : qvarsym               { $1 }
1279         | '`' qvarid '`'        { LL (unLoc $2) }
1280
1281 qvaropm :: { Located RdrName }
1282         : qvarsym_no_minus      { $1 }
1283         | '`' qvarid '`'        { LL (unLoc $2) }
1284
1285 -----------------------------------------------------------------------------
1286 -- Type variables
1287
1288 tyvar   :: { Located RdrName }
1289 tyvar   : tyvarid               { $1 }
1290         | '(' tyvarsym ')'      { LL (unLoc $2) }
1291
1292 tyvarop :: { Located RdrName }
1293 tyvarop : '`' tyvarid '`'       { LL (unLoc $2) }
1294         | tyvarsym              { $1 }
1295
1296 tyvarid :: { Located RdrName }
1297         : VARID                 { L1 $! mkUnqual tvName (getVARID $1) }
1298         | special_id            { L1 $! mkUnqual tvName (unLoc $1) }
1299         | 'unsafe'              { L1 $! mkUnqual tvName FSLIT("unsafe") }
1300         | 'safe'                { L1 $! mkUnqual tvName FSLIT("safe") }
1301         | 'threadsafe'          { L1 $! mkUnqual tvName FSLIT("threadsafe") }
1302
1303 tyvarsym :: { Located RdrName }
1304 -- Does not include "!", because that is used for strictness marks
1305 --               or ".", because that separates the quantified type vars from the rest
1306 --               or "*", because that's used for kinds
1307 tyvarsym : VARSYM               { L1 $! mkUnqual tvName (getVARSYM $1) }
1308
1309 -----------------------------------------------------------------------------
1310 -- Variables
1311
1312 var     :: { Located RdrName }
1313         : varid                 { $1 }
1314         | '(' varsym ')'        { LL (unLoc $2) }
1315
1316 qvar    :: { Located RdrName }
1317         : qvarid                { $1 }
1318         | '(' varsym ')'        { LL (unLoc $2) }
1319         | '(' qvarsym1 ')'      { LL (unLoc $2) }
1320 -- We've inlined qvarsym here so that the decision about
1321 -- whether it's a qvar or a var can be postponed until
1322 -- *after* we see the close paren.
1323
1324 qvarid :: { Located RdrName }
1325         : varid                 { $1 }
1326         | QVARID                { L1 $ mkQual varName (getQVARID $1) }
1327
1328 varid :: { Located RdrName }
1329         : varid_no_unsafe       { $1 }
1330         | 'unsafe'              { L1 $! mkUnqual varName FSLIT("unsafe") }
1331         | 'safe'                { L1 $! mkUnqual varName FSLIT("safe") }
1332         | 'threadsafe'          { L1 $! mkUnqual varName FSLIT("threadsafe") }
1333
1334 varid_no_unsafe :: { Located RdrName }
1335         : VARID                 { L1 $! mkUnqual varName (getVARID $1) }
1336         | special_id            { L1 $! mkUnqual varName (unLoc $1) }
1337         | 'forall'              { L1 $! mkUnqual varName FSLIT("forall") }
1338
1339 qvarsym :: { Located RdrName }
1340         : varsym                { $1 }
1341         | qvarsym1              { $1 }
1342
1343 qvarsym_no_minus :: { Located RdrName }
1344         : varsym_no_minus       { $1 }
1345         | qvarsym1              { $1 }
1346
1347 qvarsym1 :: { Located RdrName }
1348 qvarsym1 : QVARSYM              { L1 $ mkQual varName (getQVARSYM $1) }
1349
1350 varsym :: { Located RdrName }
1351         : varsym_no_minus       { $1 }
1352         | '-'                   { L1 $ mkUnqual varName FSLIT("-") }
1353
1354 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
1355         : VARSYM                { L1 $ mkUnqual varName (getVARSYM $1) }
1356         | special_sym           { L1 $ mkUnqual varName (unLoc $1) }
1357
1358
1359 -- These special_ids are treated as keywords in various places,
1360 -- but as ordinary ids elsewhere.   'special_id' collects all these
1361 -- except 'unsafe' and 'forall' whose treatment differs depending on context
1362 special_id :: { Located FastString }
1363 special_id
1364         : 'as'                  { L1 FSLIT("as") }
1365         | 'qualified'           { L1 FSLIT("qualified") }
1366         | 'hiding'              { L1 FSLIT("hiding") }
1367         | 'export'              { L1 FSLIT("export") }
1368         | 'label'               { L1 FSLIT("label")  }
1369         | 'dynamic'             { L1 FSLIT("dynamic") }
1370         | 'stdcall'             { L1 FSLIT("stdcall") }
1371         | 'ccall'               { L1 FSLIT("ccall") }
1372
1373 special_sym :: { Located FastString }
1374 special_sym : '!'       { L1 FSLIT("!") }
1375             | '.'       { L1 FSLIT(".") }
1376             | '*'       { L1 FSLIT("*") }
1377
1378 -----------------------------------------------------------------------------
1379 -- Data constructors
1380
1381 qconid :: { Located RdrName }   -- Qualified or unqualified
1382         : conid                 { $1 }
1383         | QCONID                { L1 $ mkQual dataName (getQCONID $1) }
1384
1385 conid   :: { Located RdrName }
1386         : CONID                 { L1 $ mkUnqual dataName (getCONID $1) }
1387
1388 qconsym :: { Located RdrName }  -- Qualified or unqualified
1389         : consym                { $1 }
1390         | QCONSYM               { L1 $ mkQual dataName (getQCONSYM $1) }
1391
1392 consym :: { Located RdrName }
1393         : CONSYM                { L1 $ mkUnqual dataName (getCONSYM $1) }
1394
1395         -- ':' means only list cons
1396         | ':'                   { L1 $ consDataCon_RDR }
1397
1398
1399 -----------------------------------------------------------------------------
1400 -- Literals
1401
1402 literal :: { Located HsLit }
1403         : CHAR                  { L1 $ HsChar       $ getCHAR $1 }
1404         | STRING                { L1 $ HsString     $ getSTRING $1 }
1405         | PRIMINTEGER           { L1 $ HsIntPrim    $ getPRIMINTEGER $1 }
1406         | PRIMCHAR              { L1 $ HsCharPrim   $ getPRIMCHAR $1 }
1407         | PRIMSTRING            { L1 $ HsStringPrim $ getPRIMSTRING $1 }
1408         | PRIMFLOAT             { L1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
1409         | PRIMDOUBLE            { L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
1410
1411 -----------------------------------------------------------------------------
1412 -- Layout
1413
1414 close :: { () }
1415         : vccurly               { () } -- context popped in lexer.
1416         | error                 {% popContext }
1417
1418 -----------------------------------------------------------------------------
1419 -- Miscellaneous (mostly renamings)
1420
1421 modid   :: { Located ModuleName }
1422         : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
1423         | QCONID                { L1 $ let (mod,c) = getQCONID $1 in
1424                                   mkModuleNameFS
1425                                    (mkFastString
1426                                      (unpackFS mod ++ '.':unpackFS c))
1427                                 }
1428
1429 commas :: { Int }
1430         : commas ','                    { $1 + 1 }
1431         | ','                           { 2 }
1432
1433 -----------------------------------------------------------------------------
1434
1435 {
1436 happyError :: P a
1437 happyError = srcParseFail
1438
1439 getVARID        (L _ (ITvarid    x)) = x
1440 getCONID        (L _ (ITconid    x)) = x
1441 getVARSYM       (L _ (ITvarsym   x)) = x
1442 getCONSYM       (L _ (ITconsym   x)) = x
1443 getQVARID       (L _ (ITqvarid   x)) = x
1444 getQCONID       (L _ (ITqconid   x)) = x
1445 getQVARSYM      (L _ (ITqvarsym  x)) = x
1446 getQCONSYM      (L _ (ITqconsym  x)) = x
1447 getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
1448 getIPSPLITVARID (L _ (ITsplitipvarid x)) = x
1449 getCHAR         (L _ (ITchar     x)) = x
1450 getSTRING       (L _ (ITstring   x)) = x
1451 getINTEGER      (L _ (ITinteger  x)) = x
1452 getRATIONAL     (L _ (ITrational x)) = x
1453 getPRIMCHAR     (L _ (ITprimchar   x)) = x
1454 getPRIMSTRING   (L _ (ITprimstring x)) = x
1455 getPRIMINTEGER  (L _ (ITprimint    x)) = x
1456 getPRIMFLOAT    (L _ (ITprimfloat  x)) = x
1457 getPRIMDOUBLE   (L _ (ITprimdouble x)) = x
1458 getTH_ID_SPLICE (L _ (ITidEscape x)) = x
1459 getINLINE       (L _ (ITinline_prag b)) = b
1460 getSPEC_INLINE  (L _ (ITspec_inline_prag b)) = b
1461
1462 -- Utilities for combining source spans
1463 comb2 :: Located a -> Located b -> SrcSpan
1464 comb2 = combineLocs
1465
1466 comb3 :: Located a -> Located b -> Located c -> SrcSpan
1467 comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
1468
1469 comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
1470 comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
1471                 combineSrcSpans (getLoc c) (getLoc d)
1472
1473 -- strict constructor version:
1474 {-# INLINE sL #-}
1475 sL :: SrcSpan -> a -> Located a
1476 sL span a = span `seq` L span a
1477
1478 -- Make a source location for the file.  We're a bit lazy here and just
1479 -- make a point SrcSpan at line 1, column 0.  Strictly speaking we should
1480 -- try to find the span of the whole file (ToDo).
1481 fileSrcSpan :: P SrcSpan
1482 fileSrcSpan = do
1483   l <- getSrcLoc;
1484   let loc = mkSrcLoc (srcLocFile l) 1 0;
1485   return (mkSrcSpan loc loc)
1486 }