diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-09-17 13:09:22 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-09-17 13:09:22 +0100 |
| commit | b0db9308017fc14b600b3a85d9c55a037f12ee9e (patch) | |
| tree | b51b0b9d26b328b5e14e9d4d681219483f9c9b1f /compiler/parser | |
| parent | 633dd5589f8625a8771ac75c5341ea225301d882 (diff) | |
| parent | 8c3b9aca3aaf946a91c9af6c07fc9d2afb6bbb76 (diff) | |
| download | haskell-b0db9308017fc14b600b3a85d9c55a037f12ee9e.tar.gz | |
Merge remote-tracking branch 'origin/master' into tc-untouchables
Conflicts:
compiler/typecheck/TcMType.lhs
compiler/typecheck/TcSMonad.lhs
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Lexer.x | 7 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 18 |
2 files changed, 20 insertions, 5 deletions
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index b872a7d953..91f00ecf2f 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -57,7 +57,7 @@ module Lexer ( extension, bangPatEnabled, datatypeContextsEnabled, traditionalRecordSyntaxEnabled, typeLiteralsEnabled, - explicitNamespacesEnabled, sccProfilingOn, + explicitNamespacesEnabled, sccProfilingOn, hpcEnabled, addWarning, lexTokenStream ) where @@ -1851,6 +1851,8 @@ rawTokenStreamBit :: Int rawTokenStreamBit = 20 -- producing a token stream with all comments included sccProfilingOnBit :: Int sccProfilingOnBit = 21 +hpcBit :: Int +hpcBit = 22 alternativeLayoutRuleBit :: Int alternativeLayoutRuleBit = 23 relaxedLayoutBit :: Int @@ -1907,6 +1909,8 @@ rawTokenStreamEnabled :: Int -> Bool rawTokenStreamEnabled flags = testBit flags rawTokenStreamBit alternativeLayoutRule :: Int -> Bool alternativeLayoutRule flags = testBit flags alternativeLayoutRuleBit +hpcEnabled :: Int -> Bool +hpcEnabled flags = testBit flags hpcBit relaxedLayout :: Int -> Bool relaxedLayout flags = testBit flags relaxedLayoutBit nondecreasingIndentation :: Int -> Bool @@ -1977,6 +1981,7 @@ mkPState flags buf loc = .|. transformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags .|. transformComprehensionsBit `setBitIf` xopt Opt_MonadComprehensions flags .|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags + .|. hpcBit `setBitIf` dopt Opt_Hpc flags .|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags .|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags .|. sccProfilingOnBit `setBitIf` dopt Opt_SccProfilingOn flags diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 410f95bebf..718adcabfd 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -24,6 +24,16 @@ to inline certain key external functions, so we instruct GHC not to throw away inlinings as it would normally do in -O0 mode. -} +-- CPP tricks because we want the directives in the output of the +-- first CPP pass. +#define __IF_GHC_77__ #if __GLASGOW_HASKELL__ >= 707 +#define __ENDIF__ #endif +__IF_GHC_77__ +-- Required on x86 to avoid the register allocator running out of +-- stack slots when compiling this module with -fPIC -dynamic. +{-# OPTIONS_GHC -fcmm-sink #-} +__ENDIF__ + module Parser ( parseModule, parseStmt, parseIdentifier, parseType, parseHeader ) where @@ -43,7 +53,6 @@ import OccName ( varName, dataName, tcClsName, tvName ) import DataCon ( DataCon, dataConName ) import SrcLoc import Module -import StaticFlags ( opt_Hpc ) import Kind ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind ) import Class ( FunDep ) import BasicTypes @@ -1406,9 +1415,10 @@ exp10 :: { LHsExpr RdrName } ; return $ LL $ if on then HsSCC (unLoc $1) $2 else HsPar $2 } } - | hpc_annot exp { LL $ if opt_Hpc - then HsTickPragma (unLoc $1) $2 - else HsPar $2 } + | hpc_annot exp {% do { on <- extension hpcEnabled + ; return $ LL $ if on + then HsTickPragma (unLoc $1) $2 + else HsPar $2 } } | 'proc' aexp '->' exp {% checkPattern $2 >>= \ p -> |