diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-11-27 15:34:44 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-12-11 22:42:09 -0500 |
commit | 690c894616a539c59cb8e58d2bba8b9c02c5ad4c (patch) | |
tree | 95a3861b5c2e9f379c19cfc2650e1a9b744e4b3d | |
parent | b4a929a1e54272ff6ba67c1a2baba635bae93b0b (diff) | |
download | haskell-690c894616a539c59cb8e58d2bba8b9c02c5ad4c.tar.gz |
Parser: move parser utils into their own module
Move code unrelated to runtime evaluation out of GHC.Runtime.Eval
-rw-r--r-- | compiler/GHC.hs | 13 | ||||
-rw-r--r-- | compiler/GHC/Parser/Utils.hs | 58 | ||||
-rw-r--r-- | compiler/GHC/Runtime/Eval.hs | 58 | ||||
-rw-r--r-- | compiler/ghc.cabal.in | 1 |
4 files changed, 72 insertions, 58 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs index cc8f93bba0..d6fe5094d5 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -325,6 +325,7 @@ import qualified GHC.Parser as Parser import GHC.Parser.Lexer import GHC.Parser.Annotation import GHC.Parser.Errors.Ppr +import GHC.Parser.Utils import GHC.Iface.Load ( loadSysInterface ) import GHC.Hs @@ -1347,6 +1348,18 @@ getPackageModuleInfo hsc_env mdl minf_modBreaks = emptyModBreaks })) +availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv +availsToGlobalRdrEnv mod_name avails + = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails) + where + -- We're building a GlobalRdrEnv as if the user imported + -- all the specified modules into the global interactive module + imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} + decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, + is_qual = False, + is_dloc = srcLocSpan interactiveSrcLoc } + + getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) getHomeModuleInfo hsc_env mdl = case lookupHpt (hsc_HPT hsc_env) (moduleName mdl) of diff --git a/compiler/GHC/Parser/Utils.hs b/compiler/GHC/Parser/Utils.hs new file mode 100644 index 0000000000..2f5b93e90f --- /dev/null +++ b/compiler/GHC/Parser/Utils.hs @@ -0,0 +1,58 @@ +module GHC.Parser.Utils + ( isStmt + , hasImport + , isImport + , isDecl + ) +where + +import GHC.Prelude +import GHC.Hs +import GHC.Data.StringBuffer +import GHC.Data.FastString +import GHC.Types.SrcLoc + +import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) +import GHC.Parser.Lexer (ParserOpts) +import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) + + +-- | Returns @True@ if passed string is a statement. +isStmt :: ParserOpts -> 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 :: ParserOpts -> String -> Bool +hasImport pflags stmt = + case parseThing Parser.parseModule pflags stmt of + Lexer.POk _ thing -> hasImports thing + Lexer.PFailed _ -> False + where + hasImports = not . null . hsmodImports . unLoc + +-- | Returns @True@ if passed string is an import declaration. +isImport :: ParserOpts -> 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 :: ParserOpts -> String -> Bool +isDecl pflags stmt = + case parseThing Parser.parseDeclaration pflags stmt of + Lexer.POk _ thing -> + case unLoc thing of + SpliceD _ _ -> False + _ -> True + Lexer.PFailed _ -> False + +parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing +parseThing parser opts stmt = do + let buf = stringToStringBuffer stmt + loc = mkRealSrcLoc (fsLit "<interactive>") 1 1 + + Lexer.unP parser (Lexer.initParserState opts buf loc) diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs index 692a4c718c..0048256f0e 100644 --- a/compiler/GHC/Runtime/Eval.hs +++ b/compiler/GHC/Runtime/Eval.hs @@ -17,7 +17,6 @@ module GHC.Runtime.Eval ( Resume(..), History(..), execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec, runDecls, runDeclsWithLocation, runParsedDecls, - isStmt, hasImport, isImport, isDecl, parseImportDecl, SingleStep(..), abandon, abandonAll, getResumeContext, @@ -26,7 +25,6 @@ module GHC.Runtime.Eval ( getHistoryModule, back, forward, setContext, getContext, - availsToGlobalRdrEnv, getNamesInScope, getRdrNamesInScope, moduleIsInterpreted, @@ -96,17 +94,12 @@ import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Misc -import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState) -import GHC.Parser.Lexer (ParserOpts) -import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport) - import GHC.Types.RepType import GHC.Types.Fixity.Env import GHC.Types.Var import GHC.Types.Id as Id import GHC.Types.Name hiding ( varName ) import GHC.Types.Name.Set -import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Var.Env import GHC.Types.SrcLoc @@ -126,7 +119,6 @@ import qualified Data.IntMap as IntMap import Data.List (find,intercalate) import Data.Map (Map) import qualified Data.Map as Map -import GHC.Data.StringBuffer (stringToStringBuffer) import Control.Monad import Control.Monad.Catch as MC import Data.Array @@ -796,17 +788,6 @@ findGlobalRdrEnv hsc_env imports Left err -> Left (mod, err) Right env -> Right env -availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv -availsToGlobalRdrEnv mod_name avails - = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails) - where - -- We're building a GlobalRdrEnv as if the user imported - -- all the specified modules into the global interactive module - imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll} - decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, - is_qual = False, - is_dloc = srcLocSpan interactiveSrcLoc } - mkTopLevEnv :: HomePackageTable -> ModuleName -> Either String GlobalRdrEnv mkTopLevEnv hpt modl = case lookupHpt hpt modl of @@ -892,45 +873,6 @@ parseName str = withSession $ \hsc_env -> liftIO $ do { lrdr_name <- hscParseIdentifier hsc_env str ; hscTcRnLookupRdrName hsc_env lrdr_name } --- | Returns @True@ if passed string is a statement. -isStmt :: ParserOpts -> 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 :: ParserOpts -> String -> Bool -hasImport pflags stmt = - case parseThing Parser.parseModule pflags stmt of - Lexer.POk _ thing -> hasImports thing - Lexer.PFailed _ -> False - where - hasImports = not . null . hsmodImports . unLoc - --- | Returns @True@ if passed string is an import declaration. -isImport :: ParserOpts -> 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 :: ParserOpts -> String -> Bool -isDecl pflags stmt = - case parseThing Parser.parseDeclaration pflags stmt of - Lexer.POk _ thing -> - case unLoc thing of - SpliceD _ _ -> False - _ -> True - Lexer.PFailed _ -> False - -parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing -parseThing parser opts stmt = do - let buf = stringToStringBuffer stmt - loc = mkRealSrcLoc (fsLit "<interactive>") 1 1 - - Lexer.unP parser (Lexer.initParserState opts buf loc) getDocs :: GhcMonad m => Name diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 273678e3f4..ab97f3b0ef 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -480,6 +480,7 @@ Library GHC.Parser.PostProcess GHC.Parser.PostProcess.Haddock GHC.Parser.Types + GHC.Parser.Utils GHC.Platform GHC.Platform.ARM GHC.Platform.AArch64 |