diff options
author | simonmar <unknown> | 2005-05-13 10:59:28 +0000 |
---|---|---|
committer | simonmar <unknown> | 2005-05-13 10:59:28 +0000 |
commit | 7a445480ac5fa95e72bd1734f32ef2337cb99360 (patch) | |
tree | 53f1815362cb848f98763af4f3a14879661cccaa /ghc/compiler/ghci | |
parent | 145c989f0f2b6b648376ce3fe3b42e1a08d13a14 (diff) | |
download | haskell-7a445480ac5fa95e72bd1734f32ef2337cb99360.tar.gz |
[project @ 2005-05-13 10:59:28 by simonmar]
Add undocumented :check command, for testing GHC.checkModule
Diffstat (limited to 'ghc/compiler/ghci')
-rw-r--r-- | ghc/compiler/ghci/InteractiveUI.hs | 24 |
1 files changed, 22 insertions, 2 deletions
diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs index 2da72ea8fb..4a4b822587 100644 --- a/ghc/compiler/ghci/InteractiveUI.hs +++ b/ghc/compiler/ghci/InteractiveUI.hs @@ -18,7 +18,8 @@ import qualified GHC import GHC ( Session, verbosity, dopt, DynFlag(..), mkModule, pprModule, Type, Module, SuccessFlag(..), TyThing(..), Name, LoadHowMuch(..), - GhcException(..), showGhcException ) + GhcException(..), showGhcException, + CheckedModule(..) ) import Outputable -- following all needed for :info... ToDo: remove @@ -29,7 +30,7 @@ import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..), import FunDeps ( pprFundeps ) import SrcLoc ( SrcLoc, pprDefnLoc ) import OccName ( OccName, parenSymOcc, occNameUserString ) -import BasicTypes ( StrictnessMark(..), defaultFixity, failed ) +import BasicTypes ( StrictnessMark(..), defaultFixity, failed, successIf ) -- Other random utilities import Panic ( panic, installSignalHandlers ) @@ -38,6 +39,7 @@ import StaticFlags ( opt_IgnoreDotGhci ) import Linker ( showLinkerState ) import Util ( removeSpaces, handle, global, toArgs, looksLikeModuleName, prefixMatch ) +import ErrUtils ( printErrorsAndWarnings ) #ifndef mingw32_HOST_OS import Util ( handle ) @@ -105,6 +107,7 @@ builtin_commands = [ ("load", keepGoingPaths loadModule_), ("module", keepGoing setContext), ("reload", keepGoing reloadModule), + ("check", keepGoing checkModule), ("set", keepGoing setCmd), ("show", keepGoing showCmd), ("type", keepGoing typeOfExpr), @@ -747,6 +750,23 @@ loadModule' files = do afterLoad ok session return ok +checkModule :: String -> GHCi () +checkModule m = do + let modl = mkModule m + session <- getSession + result <- io (GHC.checkModule session modl printErrorsAndWarnings) + case result of + Nothing -> io $ putStrLn "Nothing" + Just r -> io $ putStrLn (showSDoc ( + case checkedModuleInfo r of + Just cm | Just scope <- GHC.modInfoTopLevelScope cm -> + let + (local,global) = partition ((== modl) . GHC.nameModule) scope + in + (text "global names: " <+> ppr global) $$ + text "local names: " <+> ppr local)) + _ -> empty + afterLoad (successIf (isJust result)) session reloadModule :: String -> GHCi () reloadModule "" = do |