module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
parseHeader ) where
-#define INCLUDE #include
-INCLUDE "HsVersions.h"
-
import HsSyn
import RdrHsSyn
import HscTypes ( IsBootInterface, DeprecTxt )
-- Declarations in binding groups other than classes and instances
--
decls :: { Located (OrdList (LHsDecl RdrName)) }
- : decls ';' decl { LL (unLoc $1 `appOL` unLoc $3) }
+ : decls ';' decl { let { this = unLoc $3;
+ rest = unLoc $1;
+ these = rest `appOL` this }
+ in rest `seq` this `seq` these `seq`
+ LL these }
| decls ';' { LL (unLoc $1) }
| decl { $1 }
| {- empty -} { noLoc nilOL }
return (LL $ unitOL $ LL $ ValD (
PatBind (LL $ BangPat pat) (unLoc $3)
placeHolderType placeHolderNames)) } }
- | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3;
- return (LL $! (unitOL $! (LL $ ValD r))) } }
+ | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3;
+ let { l = comb2 $1 $> };
+ return $! (sL l (unitOL $! (sL l $ ValD r))) } }
| docdecl { LL $ unitOL $1 }
rhs :: { Located (GRHSs RdrName) }
- : '=' exp wherebinds { L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
+ : '=' exp wherebinds { sL (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
| gdrhs wherebinds { LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) }
gdrhs :: { Located [LGRHS RdrName] }
| texp '|' flattenedpquals { sL (comb2 $1 $>) $ mkHsDo ListComp (unLoc $3) $1 }
lexps :: { Located [LHsExpr RdrName] }
- : lexps ',' texp { LL ($3 : unLoc $1) }
+ : lexps ',' texp { LL (((:) $! $3) $! unLoc $1) }
| texp ',' texp { LL [$3,$1] }
-----------------------------------------------------------------------------
-- Implicit Parameter Bindings
dbinds :: { Located [LIPBind RdrName] }
- : dbinds ';' dbind { LL ($3 : unLoc $1) }
+ : dbinds ';' dbind { let { this = $3; rest = unLoc $1 }
+ in rest `seq` this `seq` LL (this : rest) }
| dbinds ';' { LL (unLoc $1) }
- | dbind { L1 [$1] }
+ | dbind { let this = $1 in this `seq` L1 [this] }
-- | {- empty -} { [] }
dbind :: { LIPBind RdrName }
tyvarid :: { Located RdrName }
: VARID { L1 $! mkUnqual tvName (getVARID $1) }
| special_id { L1 $! mkUnqual tvName (unLoc $1) }
- | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") }
- | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") }
- | 'threadsafe' { L1 $! mkUnqual tvName FSLIT("threadsafe") }
+ | 'unsafe' { L1 $! mkUnqual tvName (fsLit "unsafe") }
+ | 'safe' { L1 $! mkUnqual tvName (fsLit "safe") }
+ | 'threadsafe' { L1 $! mkUnqual tvName (fsLit "threadsafe") }
tyvarsym :: { Located RdrName }
-- Does not include "!", because that is used for strictness marks
varid :: { Located RdrName }
: varid_no_unsafe { $1 }
- | 'unsafe' { L1 $! mkUnqual varName FSLIT("unsafe") }
- | 'safe' { L1 $! mkUnqual varName FSLIT("safe") }
- | 'threadsafe' { L1 $! mkUnqual varName FSLIT("threadsafe") }
+ | 'unsafe' { L1 $! mkUnqual varName (fsLit "unsafe") }
+ | 'safe' { L1 $! mkUnqual varName (fsLit "safe") }
+ | 'threadsafe' { L1 $! mkUnqual varName (fsLit "threadsafe") }
varid_no_unsafe :: { Located RdrName }
: VARID { L1 $! mkUnqual varName (getVARID $1) }
| special_id { L1 $! mkUnqual varName (unLoc $1) }
- | 'forall' { L1 $! mkUnqual varName FSLIT("forall") }
- | 'family' { L1 $! mkUnqual varName FSLIT("family") }
+ | 'forall' { L1 $! mkUnqual varName (fsLit "forall") }
+ | 'family' { L1 $! mkUnqual varName (fsLit "family") }
qvarsym :: { Located RdrName }
: varsym { $1 }
varsym :: { Located RdrName }
: varsym_no_minus { $1 }
- | '-' { L1 $ mkUnqual varName FSLIT("-") }
+ | '-' { L1 $ mkUnqual varName (fsLit "-") }
varsym_no_minus :: { Located RdrName } -- varsym not including '-'
: VARSYM { L1 $ mkUnqual varName (getVARSYM $1) }
-- depending on context
special_id :: { Located FastString }
special_id
- : 'as' { L1 FSLIT("as") }
- | 'qualified' { L1 FSLIT("qualified") }
- | 'hiding' { L1 FSLIT("hiding") }
- | 'export' { L1 FSLIT("export") }
- | 'label' { L1 FSLIT("label") }
- | 'dynamic' { L1 FSLIT("dynamic") }
- | 'stdcall' { L1 FSLIT("stdcall") }
- | 'ccall' { L1 FSLIT("ccall") }
+ : 'as' { L1 (fsLit "as") }
+ | 'qualified' { L1 (fsLit "qualified") }
+ | 'hiding' { L1 (fsLit "hiding") }
+ | 'export' { L1 (fsLit "export") }
+ | 'label' { L1 (fsLit "label") }
+ | 'dynamic' { L1 (fsLit "dynamic") }
+ | 'stdcall' { L1 (fsLit "stdcall") }
+ | 'ccall' { L1 (fsLit "ccall") }
special_sym :: { Located FastString }
-special_sym : '!' { L1 FSLIT("!") }
- | '.' { L1 FSLIT(".") }
- | '*' { L1 FSLIT("*") }
+special_sym : '!' { L1 (fsLit "!") }
+ | '.' { L1 (fsLit ".") }
+ | '*' { L1 (fsLit "*") }
-----------------------------------------------------------------------------
-- Data constructors
-- Utilities for combining source spans
comb2 :: Located a -> Located b -> SrcSpan
-comb2 = combineLocs
+comb2 a b = a `seq` b `seq` combineLocs a b
comb3 :: Located a -> Located b -> Located c -> SrcSpan
-comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
+comb3 a b c = a `seq` b `seq` c `seq`
+ combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
-comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
- combineSrcSpans (getLoc c) (getLoc d)
+comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
+ (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
+ combineSrcSpans (getLoc c) (getLoc d))
-- strict constructor version:
{-# INLINE sL #-}
sL :: SrcSpan -> a -> Located a
-sL span a = span `seq` L span a
+sL span a = span `seq` a `seq` L span a
-- Make a source location for the file. We're a bit lazy here and just
-- make a point SrcSpan at line 1, column 0. Strictly speaking we should