Skip to content

GitLab

GHC
GHC
Commit 0a5f2918 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files
Options

Parser: don't require the HomeUnitId 

The HomeUnitId is only used by the Cmm parser and this one has access to
the DynFlags, so it can grab the UnitId of the HomeUnit from them.

Bump haddock submodule
parent 7fdcce6d
Hide whitespace changes
Inline Side-by-side
Showing with 115 additions and 98 deletions
compiler/GHC/Cmm/Lexer.x
View file @ 0a5f2918
......@@ -20,7 +20,7 @@ import GHC.Prelude
import GHC.Cmm.Expr
import GHC.Parser.Lexer
import GHC.Cmm.Monad
import GHC.Cmm.Parser.Monad
import GHC.Types.SrcLoc
import GHC.Types.Unique.FM
import GHC.Data.StringBuffer
......
compiler/GHC/Cmm/Parser.y
View file @ 0a5f2918
......@@ -234,8 +234,8 @@ import GHC.Cmm.Info
import GHC.Cmm.BlockId
import GHC.Cmm.Lexer
import GHC.Cmm.CLabel
import GHC.Cmm.Monad hiding (getPlatform, getProfile, getPtrOpts)
import qualified GHC.Cmm.Monad as PD
import GHC.Cmm.Parser.Monad hiding (getPlatform, getProfile, getPtrOpts)
import qualified GHC.Cmm.Parser.Monad as PD
import GHC.Cmm.CallConv
import GHC.Runtime.Heap.Layout
import GHC.Parser.Lexer
......@@ -385,9 +385,11 @@ cmmtop :: { CmmParse () }
| cmmdata { $1 }
| decl { $1 }
| 'CLOSURE' '(' NAME ',' NAME lits ')' ';'
{% liftP . withHomeUnitId $ \pkg ->
do lits <- sequence $6;
staticClosure pkg $3 $5 (map getLit lits) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
lits <- sequence $6;
staticClosure home_unit_id $3 $5 (map getLit lits) }
-- The only static closures in the RTS are dummy closures like
-- stg_END_TSO_QUEUE_closure and stg_dummy_ret. We don't need
......@@ -406,8 +408,10 @@ cmmdata :: { CmmParse () }
data_label :: { CmmParse CLabel }
: NAME ':'
{% liftP . withHomeUnitId $ \pkg ->
return (mkCmmDataLabel pkg (NeedExternDecl False) $1) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
pure (mkCmmDataLabel home_unit_id (NeedExternDecl False) $1) }
statics :: { [CmmParse [CmmStatic]] }
: {- empty -} { [] }
......@@ -464,103 +468,117 @@ maybe_body :: { CmmParse () }
info :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
: NAME
{% liftP . withHomeUnitId $ \pkg ->
do newFunctionName $1 pkg
return (mkCmmCodeLabel pkg $1, Nothing, []) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
newFunctionName $1 home_unit_id
return (mkCmmCodeLabel home_unit_id $1, Nothing, []) }
| 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
-- ptrs, nptrs, closure type, description, type
{% liftP . withHomeUnitId $ \pkg ->
do profile <- getProfile
let prof = profilingInfo profile $11 $13
rep = mkRTSRep (fromIntegral $9) $
mkHeapRep profile False (fromIntegral $5)
(fromIntegral $7) Thunk
-- not really Thunk, but that makes the info table
-- we want.
return (mkCmmEntryLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
[]) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
profile <- getProfile
let prof = profilingInfo profile $11 $13
rep = mkRTSRep (fromIntegral $9) $
mkHeapRep profile False (fromIntegral $5)
(fromIntegral $7) Thunk
-- not really Thunk, but that makes the info table
-- we want.
return (mkCmmEntryLabel home_unit_id $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel home_unit_id $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
[]) }
| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
-- ptrs, nptrs, closure type, description, type, fun type
{% liftP . withHomeUnitId $ \pkg ->
do profile <- getProfile
let prof = profilingInfo profile $11 $13
ty = Fun 0 (ArgSpec (fromIntegral $15))
-- Arity zero, arg_type $15
rep = mkRTSRep (fromIntegral $9) $
mkHeapRep profile False (fromIntegral $5)
(fromIntegral $7) ty
return (mkCmmEntryLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
[]) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
profile <- getProfile
let prof = profilingInfo profile $11 $13
ty = Fun 0 (ArgSpec (fromIntegral $15))
-- Arity zero, arg_type $15
rep = mkRTSRep (fromIntegral $9) $
mkHeapRep profile False (fromIntegral $5)
(fromIntegral $7) ty
return (mkCmmEntryLabel home_unit_id $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel home_unit_id $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
[]) }
-- we leave most of the fields zero here. This is only used
-- to generate the BCO info table in the RTS at the moment.
| 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
-- ptrs, nptrs, tag, closure type, description, type
{% liftP . withHomeUnitId $ \pkg ->
do profile <- getProfile
let prof = profilingInfo profile $13 $15
ty = Constr (fromIntegral $9) -- Tag
(BS8.pack $13)
rep = mkRTSRep (fromIntegral $11) $
mkHeapRep profile False (fromIntegral $5)
(fromIntegral $7) ty
return (mkCmmEntryLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing,cit_clo = Nothing },
[]) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
profile <- getProfile
let prof = profilingInfo profile $13 $15
ty = Constr (fromIntegral $9) -- Tag
(BS8.pack $13)
rep = mkRTSRep (fromIntegral $11) $
mkHeapRep profile False (fromIntegral $5)
(fromIntegral $7) ty
return (mkCmmEntryLabel home_unit_id $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel home_unit_id $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing,cit_clo = Nothing },
[]) }
-- If profiling is on, this string gets duplicated,
-- but that's the way the old code did it we can fix it some other time.
| 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
-- selector, closure type, description, type
{% liftP . withHomeUnitId $ \pkg ->
do profile <- getProfile
let prof = profilingInfo profile $9 $11
ty = ThunkSelector (fromIntegral $5)
rep = mkRTSRep (fromIntegral $7) $
mkHeapRep profile False 0 0 ty
return (mkCmmEntryLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
[]) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
profile <- getProfile
let prof = profilingInfo profile $9 $11
ty = ThunkSelector (fromIntegral $5)
rep = mkRTSRep (fromIntegral $7) $
mkHeapRep profile False 0 0 ty
return (mkCmmEntryLabel home_unit_id $3,
Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel home_unit_id $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
-- closure type (no live regs)
{% liftP . withHomeUnitId $ \pkg ->
do let prof = NoProfilingInfo
rep = mkRTSRep (fromIntegral $5) $ mkStackRep []
return (mkCmmRetLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
[]) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
let prof = NoProfilingInfo
rep = mkRTSRep (fromIntegral $5) $ mkStackRep []
return (mkCmmRetLabel home_unit_id $3,
Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel home_unit_id $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
[]) }
| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
-- closure type, live regs
{% liftP . withHomeUnitId $ \pkg ->
do platform <- getPlatform
live <- sequence $7
let prof = NoProfilingInfo
-- drop one for the info pointer
bitmap = mkLiveness platform (drop 1 live)
rep = mkRTSRep (fromIntegral $5) $ mkStackRep bitmap
return (mkCmmRetLabel pkg $3,
Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel pkg $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
live) }
{% do
home_unit_id <- getHomeUnitId
liftP $ pure $ do
platform <- getPlatform
live <- sequence $7
let prof = NoProfilingInfo
-- drop one for the info pointer
bitmap = mkLiveness platform (drop 1 live)
rep = mkRTSRep (fromIntegral $5) $ mkStackRep bitmap
return (mkCmmRetLabel home_unit_id $3,
Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel home_unit_id $3
, cit_rep = rep
, cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
live) }
body :: { CmmParse () }
: {- empty -} { return () }
......
compiler/GHC/Cmm/Monad.hs → compiler/GHC/Cmm/Parser/Monad.hs
View file @ 0a5f2918
......@@ -7,13 +7,14 @@
-- The parser for C-- requires access to a lot more of the 'DynFlags',
-- so 'PD' provides access to 'DynFlags' via a 'HasDynFlags' instance.
-----------------------------------------------------------------------------
module GHC.Cmm.Monad (
module GHC.Cmm.Parser.Monad (
PD(..)
, liftP
, failMsgPD
, getProfile
, getPlatform
, getPtrOpts
, getHomeUnitId
) where
import GHC.Prelude
......@@ -28,6 +29,8 @@ import GHC.Driver.Session
import GHC.Parser.Lexer
import GHC.Parser.Errors
import GHC.Types.SrcLoc
import GHC.Unit.Types
import GHC.Unit.Home
newtype PD a = PD { unPD :: DynFlags -> PState -> ParseResult a }
......@@ -73,3 +76,9 @@ getPtrOpts = do
{ po_profile = profile
, po_align_check = gopt Opt_AlignmentSanitisation dflags
}
-- | Return the UnitId of the home-unit. This is used to create labels.
getHomeUnitId :: PD UnitId
getHomeUnitId = do
dflags <- getDynFlags
pure (homeUnitId (mkHomeUnitFromFlags dflags))
compiler/GHC/Driver/Config.hs
View file @ 0a5f2918
......@@ -32,7 +32,6 @@ initParserOpts =
mkParserOpts
<$> warningFlags
<*> extensionFlags
<*> homeUnitId_
<*> safeImportsOn
<*> gopt Opt_Haddock
<*> gopt Opt_KeepRawTokenStream
......
compiler/GHC/Parser/Lexer.x
View file @ 0a5f2918
......@@ -55,7 +55,7 @@ module GHC.Parser.Lexer (
P(..), ParseResult(..),
allocateComments,
MonadP(..),
getRealSrcLoc, getPState, withHomeUnitId,
getRealSrcLoc, getPState,
failMsgP, failLocMsgP, srcParseFail,
getErrorMessages, getMessages,
popContext, pushModuleContext, setLastToken, setSrcLoc,
......@@ -104,7 +104,6 @@ import GHC.Data.OrdList
import GHC.Utils.Misc ( readRational, readHexRational )
import GHC.Types.SrcLoc
import GHC.Unit.Types
import GHC.Types.Basic ( InlineSpec(..), RuleMatchInfo(..),
IntegralLit(..), FractionalLit(..),
SourceText(..) )
......@@ -2210,10 +2209,8 @@ warnopt f options = f `EnumSet.member` pWarningFlags options
-- | Parser options.
--
-- See 'mkParserOpts' to construct this.
data ParserOpts = ParserOpts {
pWarningFlags :: EnumSet WarningFlag
, pHomeUnitId :: UnitId -- ^ id of the unit currently being compiled
-- (only used in Cmm parser)
data ParserOpts = ParserOpts
{ pWarningFlags :: EnumSet WarningFlag -- ^ enabled warning flags
, pExtsBitmap :: !ExtsBitmap -- ^ bitmap of permitted extensions
}
......@@ -2322,9 +2319,6 @@ failLocMsgP loc1 loc2 f =
getPState :: P PState
getPState = P $ \s -> POk s s
withHomeUnitId :: (UnitId -> a) -> P a
withHomeUnitId f = P $ \s@(PState{options = o}) -> POk s (f (pHomeUnitId o))
getExts :: P ExtsBitmap
getExts = P $ \s -> POk s (pExtsBitmap . options $ s)
......@@ -2637,8 +2631,6 @@ data ExtBits
mkParserOpts
:: EnumSet WarningFlag -- ^ warnings flags enabled
-> EnumSet LangExt.Extension -- ^ permitted language extensions enabled
-> UnitId -- ^ id of the unit currently being compiled
-- (used in Cmm parser)
-> Bool -- ^ are safe imports on?
-> Bool -- ^ keeping Haddock comment tokens
-> Bool -- ^ keep regular comment tokens
......@@ -2650,11 +2642,10 @@ mkParserOpts
-> ParserOpts
-- ^ Given exactly the information needed, set up the 'ParserOpts'
mkParserOpts warningFlags extensionFlags homeUnitId
mkParserOpts warningFlags extensionFlags
safeImports isHaddock rawTokStream usePosPrags =
ParserOpts {
pWarningFlags = warningFlags
, pHomeUnitId = homeUnitId
, pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits
}
where
......
compiler/ghc.cabal.in
View file @ 0a5f2918
......@@ -239,7 +239,7 @@ Library
GHC.Cmm.Lint
GHC.Cmm.Liveness
GHC.Cmm.MachOp
GHC.Cmm.Monad
GHC.Cmm.Parser.Monad
GHC.Cmm.Switch
GHC.Cmm.Node
GHC.Cmm.Opt
......
haddock @ 6f16399e
Compare 7b597240...6f16399e
Subproject commit 7b5972402afad755cd45aaad1a96aac509e9d5d2
Subproject commit 6f16399e0320d0ef5e6c3dd0329ce7ed3715b6b2
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment