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