Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
8e3f00dd
Commit
8e3f00dd
authored
Sep 10, 2020
by
Sylvain Henry
Browse files
Make the parser module less dependent on DynFlags
Bump haddock submodule
parent
4365d77a
Changes
15
Hide whitespace changes
Inline
Side-by-side
compiler/GHC.hs
View file @
8e3f00dd
...
...
@@ -303,6 +303,7 @@ import GHCi.RemoteTypes
import
GHC.Core.Ppr.TyThing
(
pprFamInst
)
import
GHC.Driver.Backend
import
GHC.Driver.Config
import
GHC.Driver.Main
import
GHC.Driver.Make
import
GHC.Driver.Hooks
...
...
@@ -1426,9 +1427,9 @@ getModuleSourceAndFlags mod = do
-- Throws a 'GHC.Driver.Types.SourceError' on parse error.
getTokenStream
::
GhcMonad
m
=>
Module
->
m
[
Located
Token
]
getTokenStream
mod
=
do
(
sourceFile
,
source
,
flags
)
<-
getModuleSourceAndFlags
mod
(
sourceFile
,
source
,
d
flags
)
<-
getModuleSourceAndFlags
mod
let
startLoc
=
mkRealSrcLoc
(
mkFastString
sourceFile
)
1
1
case
lexTokenStream
source
startLoc
flags
of
case
lexTokenStream
(
initParserOpts
dflags
)
source
startLoc
of
POk
_
ts
->
return
ts
PFailed
pst
->
do
dflags
<-
getDynFlags
...
...
@@ -1439,9 +1440,9 @@ getTokenStream mod = do
-- 'showRichTokenStream'.
getRichTokenStream
::
GhcMonad
m
=>
Module
->
m
[(
Located
Token
,
String
)]
getRichTokenStream
mod
=
do
(
sourceFile
,
source
,
flags
)
<-
getModuleSourceAndFlags
mod
(
sourceFile
,
source
,
d
flags
)
<-
getModuleSourceAndFlags
mod
let
startLoc
=
mkRealSrcLoc
(
mkFastString
sourceFile
)
1
1
case
lexTokenStream
source
startLoc
flags
of
case
lexTokenStream
(
initParserOpts
dflags
)
source
startLoc
of
POk
_
ts
->
return
$
addSourceToTokens
startLoc
source
ts
PFailed
pst
->
do
dflags
<-
getDynFlags
...
...
@@ -1616,7 +1617,7 @@ parser str dflags filename =
loc
=
mkRealSrcLoc
(
mkFastString
filename
)
1
1
buf
=
stringToStringBuffer
str
in
case
unP
Parser
.
parseModule
(
mkPState
dflags
buf
loc
)
of
case
unP
Parser
.
parseModule
(
initParserState
(
initParserOpts
dflags
)
buf
loc
)
of
PFailed
pst
->
let
(
warns
,
errs
)
=
getMessages
pst
dflags
in
...
...
compiler/GHC/Cmm/Parser.y
View file @
8e3f00dd
...
...
@@ -249,6 +249,7 @@ import GHC.Types.Unique.FM
import GHC.Types.SrcLoc
import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Driver.Config
import GHC.Utils.Error
import GHC.Data.StringBuffer
import GHC.Data.FastString
...
...
@@ -1432,7 +1433,8 @@ parseCmmFile dflags filename = withTiming dflags (text "ParseCmm"<+>brackets (te
buf <- hGetStringBuffer filename
let
init_loc = mkRealSrcLoc (mkFastString filename) 1 1
init_state = (mkPState dflags buf init_loc) { lex_state = [0] }
opts = initParserOpts dflags
init_state = (initParserState opts buf init_loc) { lex_state = [0] }
-- reset the lex_state: the Lexer monad leaves some stuff
-- in there we don't want.
case unPD cmmParse dflags init_state of
...
...
compiler/GHC/Driver/Backpack.hs
View file @
8e3f00dd
...
...
@@ -27,6 +27,7 @@ import GHC.Parser.Annotation
import
GHC
hiding
(
Failed
,
Succeeded
)
import
GHC.Parser
import
GHC.Parser.Lexer
import
GHC.Driver.Config
import
GHC.Driver.Monad
import
GHC.Driver.Session
import
GHC.Driver.Ppr
...
...
@@ -83,7 +84,7 @@ doBackpack [src_filename] = do
buf
<-
liftIO
$
hGetStringBuffer
src_filename
let
loc
=
mkRealSrcLoc
(
mkFastString
src_filename
)
1
1
-- TODO: not great
case
unP
parseBackpack
(
mkPState
dflags
buf
loc
)
of
case
unP
parseBackpack
(
initParserState
(
initParserOpts
dflags
)
buf
loc
)
of
PFailed
pst
->
throwErrors
(
getErrorMessages
pst
dflags
)
POk
_
pkgname_bkp
->
do
-- OK, so we have an LHsUnit PackageName, but we want an
...
...
compiler/GHC/Driver/Config.hs
View file @
8e3f00dd
...
...
@@ -2,6 +2,7 @@
module
GHC.Driver.Config
(
initOptCoercionOpts
,
initSimpleOpts
,
initParserOpts
)
where
...
...
@@ -10,6 +11,7 @@ import GHC.Prelude
import
GHC.Driver.Session
import
GHC.Core.SimpleOpt
import
GHC.Core.Coercion.Opt
import
GHC.Parser.Lexer
-- | Initialise coercion optimiser configuration from DynFlags
initOptCoercionOpts
::
DynFlags
->
OptCoercionOpts
...
...
@@ -23,3 +25,15 @@ initSimpleOpts dflags = SimpleOpts
{
so_uf_opts
=
unfoldingOpts
dflags
,
so_co_opts
=
initOptCoercionOpts
dflags
}
-- | Extracts the flag information needed for parsing
initParserOpts
::
DynFlags
->
ParserOpts
initParserOpts
=
mkParserOpts
<$>
warningFlags
<*>
extensionFlags
<*>
homeUnitId_
<*>
safeImportsOn
<*>
gopt
Opt_Haddock
<*>
gopt
Opt_KeepRawTokenStream
<*>
const
True
compiler/GHC/Driver/Main.hs
View file @
8e3f00dd
...
...
@@ -138,6 +138,7 @@ import GHC.Cmm.Info.Build
import
GHC.Cmm.Pipeline
import
GHC.Cmm.Info
import
GHC.Driver.CodeOutput
import
GHC.Driver.Config
import
GHC.Core.InstEnv
import
GHC.Core.FamInstEnv
import
GHC.Utils.Fingerprint
(
Fingerprint
)
...
...
@@ -353,7 +354,7 @@ hscParse' mod_summary
=
parseSignature
|
otherwise
=
parseModule
case
unP
parseMod
(
mkPState
dflags
buf
loc
)
of
case
unP
parseMod
(
initParserState
(
initParserOpts
dflags
)
buf
loc
)
of
PFailed
pst
->
handleWarningsThrowErrors
(
getMessages
pst
dflags
)
POk
pst
rdr_module
->
do
...
...
@@ -1875,7 +1876,7 @@ hscParseThingWithLocation source linenumber parser str
let
buf
=
stringToStringBuffer
str
loc
=
mkRealSrcLoc
(
fsLit
source
)
linenumber
1
case
unP
parser
(
mkPState
dflags
buf
loc
)
of
case
unP
parser
(
initParserState
(
initParserOpts
dflags
)
buf
loc
)
of
PFailed
pst
->
do
handleWarningsThrowErrors
(
getMessages
pst
dflags
)
...
...
compiler/GHC/Parser.y
View file @
8e3f00dd
...
...
@@ -21,13 +21,13 @@
-- and then parse that string:
--
-- @
-- runParser ::
DynFlag
s -> String -> P a -> ParseResult a
-- runParser
flag
s str parser = unP parser parseState
-- runParser ::
ParserOpt
s -> String -> P a -> ParseResult a
-- runParser
opt
s str parser = unP parser parseState
-- where
-- filename = "\<interactive\>"
-- location = mkRealSrcLoc (mkFastString filename) 1 1
-- buffer = stringToStringBuffer str
-- parseState =
mkP
State
flag
s buffer location
-- parseState =
initParser
State
opt
s buffer location
-- @
module
GHC.Parser
(
parseModule
,
parseSignature
,
parseImport
,
parseStatement
,
parseBackpack
...
...
compiler/GHC/Parser/Header.hs
View file @
8e3f00dd
...
...
@@ -37,6 +37,7 @@ import GHC.Builtin.Names
import
GHC.Data.StringBuffer
import
GHC.Types.SrcLoc
import
GHC.Driver.Session
import
GHC.Driver.Config
import
GHC.Utils.Error
import
GHC.Utils.Misc
import
GHC.Utils.Outputable
as
Outputable
...
...
@@ -73,7 +74,7 @@ getImports :: DynFlags
-- names from -XPackageImports), and the module name.
getImports
dflags
buf
filename
source_filename
=
do
let
loc
=
mkRealSrcLoc
(
mkFastString
filename
)
1
1
case
unP
parseHeader
(
mkPState
dflags
buf
loc
)
of
case
unP
parseHeader
(
initParserState
(
initParserOpts
dflags
)
buf
loc
)
of
PFailed
pst
->
-- assuming we're not logging warnings here as per below
return
$
Left
$
getErrorMessages
pst
dflags
...
...
@@ -178,7 +179,8 @@ blockSize = 1024
lazyGetToks
::
DynFlags
->
FilePath
->
Handle
->
IO
[
Located
Token
]
lazyGetToks
dflags
filename
handle
=
do
buf
<-
hGetStringBufferBlock
handle
blockSize
unsafeInterleaveIO
$
lazyLexBuf
handle
(
pragState
dflags
buf
loc
)
False
blockSize
let
prag_state
=
initPragState
(
initParserOpts
dflags
)
buf
loc
unsafeInterleaveIO
$
lazyLexBuf
handle
prag_state
False
blockSize
where
loc
=
mkRealSrcLoc
(
mkFastString
filename
)
1
1
...
...
@@ -214,8 +216,9 @@ lazyGetToks dflags filename handle = do
getToks
::
DynFlags
->
FilePath
->
StringBuffer
->
[
Located
Token
]
getToks
dflags
filename
buf
=
lexAll
(
pragState
dflags
buf
loc
)
getToks
dflags
filename
buf
=
lexAll
pstate
where
pstate
=
initPragState
(
initParserOpts
dflags
)
buf
loc
loc
=
mkRealSrcLoc
(
mkFastString
filename
)
1
1
lexAll
state
=
case
unP
(
lexer
False
return
)
state
of
...
...
compiler/GHC/Parser/Lexer.x
View file @
8e3f00dd
...
...
@@ -49,8 +49,10 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Parser.Lexer (
Token(..), lexer, lexerDbg, pragState, mkPState, mkPStatePure, PState(..),
P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags(..),
Token(..), lexer, lexerDbg,
ParserOpts(..), mkParserOpts,
PState (..), initParserState, initPragState,
P(..), ParseResult(..),
appendWarning,
appendError,
allocateComments,
...
...
@@ -62,7 +64,7 @@ module GHC.Parser.Lexer (
activeContext, nextIsEOF,
getLexState, popLexState, pushLexState,
ExtBits(..),
xtest,
xtest,
xunset, xset,
lexTokenStream,
AddAnn(..),mkParensApiAnn,
addAnnsAt,
...
...
@@ -2207,12 +2209,13 @@ data ParseResult a
-- a non-empty bag of errors.
-- | Test whether a 'WarningFlag' is set
warnopt :: WarningFlag -> Parser
Flag
s -> Bool
warnopt :: WarningFlag -> Parser
Opt
s -> Bool
warnopt f options = f `EnumSet.member` pWarningFlags options
-- | The subset of the 'DynFlags' used by the parser.
-- See 'mkParserFlags' or 'mkParserFlags'' for ways to construct this.
data ParserFlags = ParserFlags {
-- | 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)
...
...
@@ -2230,7 +2233,7 @@ data HdkComment
data PState = PState {
buffer :: StringBuffer,
options :: Parser
Flag
s,
options :: Parser
Opt
s,
-- This needs to take DynFlags as an argument until
-- we have a fix for #10143
messages :: DynFlags -> Messages,
...
...
@@ -2570,6 +2573,12 @@ xbit = bit . fromEnum
xtest :: ExtBits -> ExtsBitmap -> Bool
xtest ext xmap = testBit xmap (fromEnum ext)
xset :: ExtBits -> ExtsBitmap -> ExtsBitmap
xset ext xmap = setBit xmap (fromEnum ext)
xunset :: ExtBits -> ExtsBitmap -> ExtsBitmap
xunset ext xmap = clearBit xmap (fromEnum ext)
-- | Various boolean flags, mostly language extensions, that impact lexing and
-- parsing. Note that a handful of these can change during lexing/parsing.
data ExtBits
...
...
@@ -2630,19 +2639,8 @@ data ExtBits
-- tokens of their own.
deriving Enum
-- PState for parsing options pragmas
--
pragState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
pragState dynflags buf loc = (mkPState dynflags buf loc) {
lex_state = [bol, option_prags, 0]
}
{-# INLINE mkParserFlags' #-}
mkParserFlags'
{-# INLINE mkParserOpts #-}
mkParserOpts
:: EnumSet WarningFlag -- ^ warnings flags enabled
-> EnumSet LangExt.Extension -- ^ permitted language extensions enabled
-> UnitId -- ^ id of the unit currently being compiled
...
...
@@ -2656,11 +2654,11 @@ mkParserFlags'
-- the internal position kept by the parser. Otherwise, those pragmas are
-- lexed as 'ITline_prag' and 'ITcolumn_prag' tokens.
-> Parser
Flag
s
-- ^ Given exactly the information needed, set up the 'Parser
Flag
s'
mkParser
Flags'
warningFlags extensionFlags homeUnitId
-> Parser
Opt
s
-- ^ Given exactly the information needed, set up the 'Parser
Opt
s'
mkParser
Opts
warningFlags extensionFlags homeUnitId
safeImports isHaddock rawTokStream usePosPrags =
Parser
Flag
s {
Parser
Opt
s {
pWarningFlags = warningFlags
, pHomeUnitId = homeUnitId
, pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits
...
...
@@ -2722,25 +2720,15 @@ mkParserFlags' warningFlags extensionFlags homeUnitId
b `setBitIf` cond | cond = xbit b
| otherwise = 0
-- | Extracts the flag information needed for parsing
mkParserFlags :: DynFlags -> ParserFlags
mkParserFlags =
mkParserFlags'
<$> DynFlags.warningFlags
<*> DynFlags.extensionFlags
<*> DynFlags.homeUnitId_
<*> safeImportsOn
<*> gopt Opt_Haddock
<*> gopt Opt_KeepRawTokenStream
<*> const True
-- | Creates a parse state from a 'DynFlags' value
mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
mkPState flags = mkPStatePure (mkParserFlags flags)
-- | Creates a parse state from a 'ParserFlags' value
mkPStatePure :: ParserFlags -> StringBuffer -> RealSrcLoc -> PState
mkPStatePure options buf loc =
-- | Set parser options for parsing OPTIONS pragmas
initPragState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initPragState options buf loc = (initParserState options buf loc)
{ lex_state = [bol, option_prags, 0]
}
-- | Creates a parse state from a 'ParserOpts' value
initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState options buf loc =
PState {
buffer = buf,
options = options,
...
...
@@ -2818,7 +2806,7 @@ appendError srcspan msg m =
in (ws, es')
appendWarning
:: Parser
Flag
s
:: Parser
Opt
s
-> WarningFlag
-> SrcSpan
-> SDoc
...
...
@@ -2928,7 +2916,7 @@ getOffside = P $ \s@PState{last_loc=loc, context=stk} ->
-- Construct a parse error
srcParseErr
:: Parser
Flag
s
:: Parser
Opt
s
-> StringBuffer -- current buffer (placed just after the last token)
-> Int -- length of the previous token
-> MsgDoc
...
...
@@ -3248,16 +3236,20 @@ reportLexError loc1 loc2 buf str
then failLocMsgP loc2 loc2 (str ++ " (UTF-8 decoding error)")
else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c)
lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]
lexTokenStream buf loc dflags = unP go initState{ options = opts' }
where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream
initState@PState{ options = opts } = mkPState dflags' buf loc
opts' = opts{ pExtsBitmap = complement (xbit UsePosPragsBit) .&. pExtsBitmap opts }
go = do
ltok <- lexer False return
case ltok of
L _ ITeof -> return []
_ -> liftM (ltok:) go
lexTokenStream :: ParserOpts -> StringBuffer -> RealSrcLoc -> ParseResult [Located Token]
lexTokenStream opts buf loc = unP go initState{ options = opts' }
where
new_exts = xunset HaddockBit -- disable Haddock
$ xunset UsePosPragsBit -- parse LINE/COLUMN pragmas as tokens
$ xset RawTokenStreamBit -- include comments
$ pExtsBitmap opts
opts' = opts { pExtsBitmap = new_exts }
initState = initParserState opts' buf loc
go = do
ltok <- lexer False return
case ltok of
L _ ITeof -> return []
_ -> liftM (ltok:) go
linePrags = Map.singleton "line" linePrag
...
...
compiler/GHC/Parser/PostProcess.hs
View file @
8e3f00dd
...
...
@@ -2660,7 +2660,7 @@ failOpFewArgs (L loc op) =
data
PV_Context
=
PV_Context
{
pv_options
::
Parser
Flag
s
{
pv_options
::
Parser
Opt
s
,
pv_hint
::
SDoc
-- See Note [Parser-Validator Hint]
}
...
...
compiler/GHC/Runtime/Eval.hs
View file @
8e3f00dd
...
...
@@ -96,8 +96,8 @@ import GHC.Utils.Outputable
import
GHC.Data.FastString
import
GHC.Data.Bag
import
GHC.Utils.Misc
import
qualified
GHC.Parser.Lexer
as
Lexer
(
P
(
..
),
ParseResult
(
..
),
unP
,
mkPStatePur
e
)
import
GHC.Parser.Lexer
(
Parser
Flag
s
)
import
qualified
GHC.Parser.Lexer
as
Lexer
(
P
(
..
),
ParseResult
(
..
),
unP
,
initParserStat
e
)
import
GHC.Parser.Lexer
(
Parser
Opt
s
)
import
qualified
GHC.Parser
as
Parser
(
parseStmt
,
parseModule
,
parseDeclaration
,
parseImport
)
import
System.Directory
...
...
@@ -877,14 +877,14 @@ parseName str = withSession $ \hsc_env -> liftIO $
;
hscTcRnLookupRdrName
hsc_env
lrdr_name
}
-- | Returns @True@ if passed string is a statement.
isStmt
::
Parser
Flag
s
->
String
->
Bool
isStmt
::
Parser
Opt
s
->
String
->
Bool
isStmt
pflags
stmt
=
case
parseThing
Parser
.
parseStmt
pflags
stmt
of
Lexer
.
POk
_
_
->
True
Lexer
.
PFailed
_
->
False
-- | Returns @True@ if passed string has an import declaration.
hasImport
::
Parser
Flag
s
->
String
->
Bool
hasImport
::
Parser
Opt
s
->
String
->
Bool
hasImport
pflags
stmt
=
case
parseThing
Parser
.
parseModule
pflags
stmt
of
Lexer
.
POk
_
thing
->
hasImports
thing
...
...
@@ -893,14 +893,14 @@ hasImport pflags stmt =
hasImports
=
not
.
null
.
hsmodImports
.
unLoc
-- | Returns @True@ if passed string is an import declaration.
isImport
::
Parser
Flag
s
->
String
->
Bool
isImport
::
Parser
Opt
s
->
String
->
Bool
isImport
pflags
stmt
=
case
parseThing
Parser
.
parseImport
pflags
stmt
of
Lexer
.
POk
_
_
->
True
Lexer
.
PFailed
_
->
False
-- | Returns @True@ if passed string is a declaration but __/not a splice/__.
isDecl
::
Parser
Flag
s
->
String
->
Bool
isDecl
::
Parser
Opt
s
->
String
->
Bool
isDecl
pflags
stmt
=
do
case
parseThing
Parser
.
parseDeclaration
pflags
stmt
of
Lexer
.
POk
_
thing
->
...
...
@@ -909,12 +909,12 @@ isDecl pflags stmt = do
_
->
True
Lexer
.
PFailed
_
->
False
parseThing
::
Lexer
.
P
thing
->
Parser
Flag
s
->
String
->
Lexer
.
ParseResult
thing
parseThing
parser
pflag
s
stmt
=
do
parseThing
::
Lexer
.
P
thing
->
Parser
Opt
s
->
String
->
Lexer
.
ParseResult
thing
parseThing
parser
opt
s
stmt
=
do
let
buf
=
stringToStringBuffer
stmt
loc
=
mkRealSrcLoc
(
fsLit
"<interactive>"
)
1
1
Lexer
.
unP
parser
(
Lexer
.
mkPStatePure
pflag
s
buf
loc
)
Lexer
.
unP
parser
(
Lexer
.
initParserState
opt
s
buf
loc
)
getDocs
::
GhcMonad
m
=>
Name
...
...
ghc/GHCi/UI.hs
View file @
8e3f00dd
...
...
@@ -50,6 +50,7 @@ import GHC.Driver.Ppr hiding (printForUser)
import
GHC.Utils.Error
hiding
(
traceCmd
)
import
GHC.Driver.Finder
as
Finder
import
GHC.Driver.Monad
(
modifySession
)
import
GHC.Driver.Config
import
qualified
GHC
import
GHC
(
LoadHowMuch
(
..
),
Target
(
..
),
TargetId
(
..
),
InteractiveImport
(
..
),
TyThing
(
..
),
Phase
,
BreakIndex
,
Resume
,
SingleStep
,
Ghc
,
...
...
@@ -1133,7 +1134,7 @@ checkInputForLayout stmt getStmt = do
st0
<-
getGHCiState
let
buf'
=
stringToStringBuffer
stmt
loc
=
mkRealSrcLoc
(
fsLit
(
progname
st0
))
(
line_number
st0
)
1
pstate
=
Lexer
.
mkPState
dflags
buf'
loc
pstate
=
Lexer
.
initParserState
(
initParserOpts
dflags
)
buf'
loc
case
Lexer
.
unP
goToEnd
pstate
of
(
Lexer
.
POk
_
False
)
->
return
$
Just
stmt
_other
->
do
...
...
@@ -1175,7 +1176,7 @@ enqueueCommands cmds = do
-- The return value True indicates success, as in `runOneCommand`.
runStmt
::
GhciMonad
m
=>
String
->
SingleStep
->
m
(
Maybe
GHC
.
ExecResult
)
runStmt
input
step
=
do
pflags
<-
Lexer
.
mk
Parser
Flag
s
<$>
GHC
.
getInteractiveDynFlags
pflags
<-
init
Parser
Opt
s
<$>
GHC
.
getInteractiveDynFlags
-- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`
-- and `-fdefer-out-of-scope-variables` for **naked expressions**. The
-- declarations and statements are not affected.
...
...
testsuite/tests/ghc-api/T11579.hs
View file @
8e3f00dd
import
System.Environment
import
GHC.Driver.Session
import
GHC.Driver.Config
import
GHC.Data.FastString
import
GHC
import
GHC.Data.StringBuffer
...
...
@@ -16,7 +17,8 @@ main = do
hdk_comments
<-
runGhc
(
Just
libdir
)
$
do
dflags
<-
getSessionDynFlags
let
pstate
=
mkPState
(
dflags
`
gopt_set
`
Opt_Haddock
)
stringBuffer
loc
let
opts
=
initParserOpts
(
dflags
`
gopt_set
`
Opt_Haddock
)
pstate
=
initParserState
opts
stringBuffer
loc
case
unP
(
lexer
False
return
)
pstate
of
POk
s
(
L
_
ITeof
)
->
return
(
map
unLoc
(
toList
(
hdk_comments
s
)))
_
->
error
"No token"
...
...
testsuite/tests/ghc-api/T9015.hs
View file @
8e3f00dd
...
...
@@ -3,7 +3,7 @@ module Main where
import
GHC
import
GHC.Driver.Session
import
GHC.Driver.Monad
import
GHC.
Parser.Lexer
(
mkParserFlags
)
import
GHC.
Driver.Config
import
System.Environment
testStrings
=
[
...
...
@@ -53,7 +53,7 @@ main = do
where
testWithParser
parser
=
do
dflags
<-
getSessionDynFlags
let
pflags
=
mk
Parser
Flag
s
dflags
let
pflags
=
init
Parser
Opt
s
dflags
liftIO
.
putStrLn
.
unlines
$
map
(
testExpr
(
parser
pflags
))
testStrings
testExpr
parser
expr
=
do
...
...
testsuite/tests/parser/should_run/CountParserDeps.hs
View file @
8e3f00dd
...
...
@@ -28,9 +28,12 @@ main = do
[
libdir
]
<-
getArgs
modules
<-
parserDeps
libdir
let
num
=
sizeUniqSet
modules
-- print num
-- print (map moduleNameString $ nonDetEltsUniqSet modules)
unless
(
num
<=
201
)
$
exitWith
(
ExitFailure
num
)
max_num
=
201
min_num
=
max_num
-
10
-- so that we don't forget to change the number
-- when the number of dependencies decreases
-- putStrLn $ "Found " ++ show num ++ " parser module dependencies"
-- forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn
unless
(
num
<=
max_num
&&
num
>=
min_num
)
$
exitWith
(
ExitFailure
num
)
parserDeps
::
FilePath
->
IO
(
UniqSet
ModuleName
)
parserDeps
libdir
=
...
...
haddock
@
a18c3af7
Compare
37c47822
...
a18c3af7
Subproject commit
37c47822d390b553ce24fe256c9700d5fd83bf9f
Subproject commit
a18c3af7f983f3b6d3cd84093c9079031da58468
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment