From 7e55e663ba1d7af20eb15f7496f0706f3879eef8 Mon Sep 17 00:00:00 2001 From: krasimir Date: Tue, 12 Apr 2005 16:49:31 +0000 Subject: [PATCH] [project @ 2005-04-12 16:49:31 by krasimir] Few changes to GHC API: * The Instance type is removed. Each instance is represented as dictonary Id. Now there is: isDictonaryId :: Id -> Bool predicate which allows to distinguish them. * The full list of all available predicates of type (Id -> Bool) is exported * Few predicates for TyCon are exported * checkModule is removed. It isn't used anymore. Instead the full load is made. The hook API will be required at some time in order to make available the parsed/typechecked source. --- ghc/compiler/main/GHC.hs | 104 +++++++++++++++------------------------------- 1 file changed, 34 insertions(+), 70 deletions(-) diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs index 301db13..b8672b9 100644 --- a/ghc/compiler/main/GHC.hs +++ b/ghc/compiler/main/GHC.hs @@ -34,7 +34,6 @@ module GHC ( depanal, load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal workingDirectoryChanged, - checkModule, CheckedModule(..), -- * Inspecting the module structure of the program ModuleGraph, ModSummary(..), @@ -46,8 +45,8 @@ module GHC ( ModuleInfo, getModuleInfo, modInfoTyThings, - modInfoInstances, lookupName, + allNamesInScope, -- * Interactive evaluation getBindings, getPrintUnqual, @@ -70,21 +69,28 @@ module GHC ( -- ** Modules Module, mkModule, pprModule, - -- ** Identifiers + -- ** Names Name, + + -- ** Identifiers Id, idType, + isImplicitId, isDeadBinder, + isSpecPragmaId, isExportedId, isLocalId, isGlobalId, + isRecordSelector, + isPrimOpId, isFCallId, + isDataConWorkId, idDataCon, + isBottomingId, isDictonaryId, -- ** Type constructors TyCon, + isClassTyCon, isSynTyCon, isNewTyCon, -- ** Data constructors DataCon, -- ** Classes Class, - - -- ** Instances - Instance, + classSCTheta, classTvsFds, -- ** Types and Kinds Type, dropForAlls, @@ -133,12 +139,17 @@ import Packages ( initPackages ) import RdrName ( GlobalRdrEnv ) import HsSyn ( HsModule, LHsBinds ) import Type ( Kind, Type, dropForAlls ) -import Id ( Id, idType ) -import TyCon ( TyCon ) -import Class ( Class ) +import Id ( Id, idType, isImplicitId, isDeadBinder, + isSpecPragmaId, isExportedId, isLocalId, isGlobalId, + isRecordSelector, + isPrimOpId, isFCallId, + isDataConWorkId, idDataCon, + isBottomingId ) +import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon ) +import Class ( Class, classSCTheta, classTvsFds ) import DataCon ( DataCon ) -import Name ( Name ) -import RdrName ( RdrName ) +import Name ( Name, getName, nameModule_maybe ) +import RdrName ( RdrName, gre_name, globalRdrEnvElts ) import NameEnv ( nameEnvElts ) import SrcLoc ( Located(..) ) import DriverPipeline @@ -163,9 +174,10 @@ import Outputable import SysTools ( cleanTempFilesExcept ) import BasicTypes ( SuccessFlag(..), succeeded, failed ) import Maybes ( orElse, expectJust, mapCatMaybes ) +import TcType ( tcSplitSigmaTy, isDictTy ) import Directory ( getModificationTime, doesFileExist ) -import Maybe ( isJust, isNothing, fromJust ) +import Maybe ( isJust, isNothing, fromJust, fromMaybe, catMaybes ) import Maybes ( expectJust ) import List ( partition, nub ) import qualified List @@ -380,7 +392,6 @@ data ErrMsg = ErrMsg { data LoadHowMuch = LoadAllTargets | LoadUpTo Module - | LoadDependenciesOf Module -- | Try to load the program. If a Module is supplied, then just -- attempt to load up to this target. If no Module is supplied, @@ -464,22 +475,10 @@ load s@(Session ref) how_much maybe_top_mod = case how_much of LoadUpTo m -> Just m - LoadDependenciesOf m -> Just m _ -> Nothing - partial_mg0 :: [SCC ModSummary] - partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod - - -- LoadDependenciesOf m: we want the upsweep to stop just - -- short of the specified module (unless the specified module - -- is stable). - partial_mg - | LoadDependenciesOf mod <- how_much - = ASSERT( case last partial_mg0 of - AcyclicSCC ms -> ms_mod ms == mod; _ -> False ) - List.init partial_mg0 - | otherwise - = partial_mg0 + partial_mg :: [SCC ModSummary] + partial_mg = topSortModuleGraph False mod_graph maybe_top_mod stable_mg = [ AcyclicSCC ms @@ -600,42 +599,6 @@ discardProg hsc_env -- source file, but that doesn't do any harm. ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ] --- ----------------------------------------------------------------------------- --- Check module - -data CheckedModule = - CheckedModule { parsedSource :: ParsedSource, - -- ToDo: renamedSource - typecheckedSource :: Maybe TypecheckedSource - } - -type ParsedSource = Located (HsModule RdrName) -type TypecheckedSource = (LHsBinds Id, GlobalRdrEnv) - --- | This is the way to get access to parsed and typechecked source code --- for a module. 'checkModule' loads all the dependencies of the specified --- module in the Session, and then attempts to typecheck the module. If --- successful, it returns the abstract syntax for the module. -checkModule :: Session -> Module -> (Messages -> IO ()) - -> IO (Maybe CheckedModule) -checkModule session@(Session ref) mod msg_act = do - -- load up the dependencies first - r <- load session (LoadDependenciesOf mod) - if (failed r) then return Nothing else do - - -- now parse & typecheck the module - hsc_env <- readIORef ref - let mg = hsc_mod_graph hsc_env - case [ ms | ms <- mg, ms_mod ms == mod ] of - [] -> return Nothing - (ms:_) -> do - r <- hscFileCheck hsc_env msg_act ms - case r of - HscFail -> - return Nothing - HscChecked parsed tcd -> - return (Just (CheckedModule parsed tcd) ) - ----------------------------------------------------------------------------- -- Unloading @@ -1453,6 +1416,11 @@ parseName s str = withSession s $ \hsc_env -> do -- ToDo: should return error messages #endif +allNamesInScope :: Session -> IO [Name] +allNamesInScope s = withSession s $ \hsc_env -> do + eps <- readIORef (hsc_EPS hsc_env) + return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env)))) + -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any -- entity known to GHC, including 'Name's defined using 'runStmt'. lookupName :: Session -> Name -> IO (Maybe TyThing) @@ -1463,7 +1431,6 @@ lookupName s name = withSession s $ \hsc_env -> do eps <- readIORef (hsc_EPS hsc_env) return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name - -- | Container for information about a 'Module'. newtype ModuleInfo = ModuleInfo ModDetails -- ToDo: this should really contain the ModIface too @@ -1483,12 +1450,9 @@ getModuleInfo s mdl = withSession s $ \hsc_env -> do modInfoTyThings :: ModuleInfo -> [TyThing] modInfoTyThings (ModuleInfo md) = typeEnvElts (md_types md) --- | An instance of a class -newtype Instance = Instance DFunId - --- | The list of 'Instance's defined in a module -modInfoInstances :: ModuleInfo -> [Instance] -modInfoInstances (ModuleInfo md) = map Instance (md_insts md) +isDictonaryId :: Id -> Bool +isDictonaryId id + = case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau } #if 0 -- 1.7.10.4