From c9da7b70042acf3cd005d3e5f447e109aefa5324 Mon Sep 17 00:00:00 2001 From: sewardj Date: Thu, 5 Oct 2000 10:05:53 +0000 Subject: [PATCH] [project @ 2000-10-05 10:05:53 by sewardj] Add finder, summariser, part of CM, to repo. --- ghc/compiler/ghci/CmFind.lhs | 135 ++++++++++++++++++++++++++++++++++-- ghc/compiler/ghci/CmStaticInfo.lhs | 23 +++++- ghc/compiler/ghci/CmSummarise.lhs | 21 ++++-- ghc/compiler/ghci/CompManager.lhs | 98 ++++++++++++++++++++------ 4 files changed, 239 insertions(+), 38 deletions(-) diff --git a/ghc/compiler/ghci/CmFind.lhs b/ghc/compiler/ghci/CmFind.lhs index 25888b4..c2c8069 100644 --- a/ghc/compiler/ghci/CmFind.lhs +++ b/ghc/compiler/ghci/CmFind.lhs @@ -5,27 +5,148 @@ \begin{code} module CmFind ( Path, ModName, PkgName, - ModLocation(..), Finder, newFinder ) + ModLocation(..), ml_modname, isPackageLoc, + Finder, newFinder ) where #include "HsVersions.h" +import IO ( hPutStr, stderr ) +import List ( maximumBy ) +import Maybe ( catMaybes ) +import Char ( isUpper ) +import List ( nub ) +import Time ( ClockTime ) +import Directory ( doesFileExist, getModificationTime, + getDirectoryContents) + import Module ( Module ) -import CmStaticInfo ( PCI ) +import CmStaticInfo ( PCI, Package(..) ) \end{code} \begin{code} -type Path = String +type Path = String type ModName = String type PkgName = String data ModLocation - = SourceOnly Module Path -- .hs - | ObjectCode Module Path Path -- .o, .hi - | InPackage Module PkgName + = SourceOnly ModName Path -- .hs + | ObjectCode ModName Path Path -- .o, .hi + | InPackage ModName PkgName + | NotFound + deriving Show type Finder = ModName -> IO ModLocation +ml_modname (SourceOnly nm _) = nm +ml_modname (ObjectCode nm _ _) = nm +ml_modname (InPackage nm _) = nm + +isPackageLoc (InPackage _ _) = True +isPackageLoc _ = False + +mkFinder :: [(ModName,PkgName,Path)] -> [Path] -> Finder +mkFinder pkg_ifaces home_dirs modnm + = do found <- mkFinderX pkg_ifaces home_dirs modnm + putStrLn ("FINDER pkginfo\n" ++ unlines (map show pkg_ifaces) ++ "\n") + putStrLn ("FINDER: request = " ++ modnm ++ "\n" ++ + "FINDER: response = " ++ show found) + return found + + +mkFinderX :: [(ModName,PkgName,Path)] -> [Path] -> Finder +mkFinderX pkg_ifaces home_dirs modnm + -- If the module exists both as package and home, emit a warning + -- and (arbitrarily) choose the user's one. + = do home_maybe_found <- mapM (homeModuleExists modnm) home_dirs + :: IO [Maybe (ModLocation, ClockTime)] + case (in_package, catMaybes home_maybe_found) of + ([], []) + -> return NotFound + ([], locs_n_times@(_:_)) + -> return (homeMod locs_n_times) + ((pkgname,path):_, []) + -> return (InPackage modnm pkgname) + (packages, locs_n_times) + -> do hPutStr stderr ( "GHCI: warning: module `" ++ modnm ++ + "' appears as both a home and package module\n") + return (homeMod locs_n_times) + where + in_package + = [(pkgname,path) | (modname,pkgname,path) <- pkg_ifaces, + modname == modnm] + homeMod :: [(ModLocation, ClockTime)] -> ModLocation + homeMod locs_n_times + = fst (maximumBy (\lt1 lt2 -> if snd lt1 > snd lt2 then lt1 else lt2) + locs_n_times) + + +-- See if a .hs or (.hi, .o) pair exist on the given path, +-- and return a ModLocation for whichever is younger +homeModuleExists :: ModName -> Path -> IO (Maybe (ModLocation, ClockTime)) +homeModuleExists modname path + = do m_ths <- maybeTime nm_hs + m_thi <- maybeTime nm_hi + m_to <- maybeTime nm_o + return ( + case (m_ths, m_thi, m_to) of + (Just ths, Just thi, Just to) + | thi >= ths && to >= ths -> object thi to + | otherwise -> source ths + (Just ths, _, _) -> source ths + (Nothing, Just thi, Just to) -> object thi to + (Nothing, _, _) -> Nothing + ) + where + object thi to = Just (ObjectCode modname nm_o nm_hi, max thi to) + source ths = Just (SourceOnly modname nm_hs, ths) + nm = path ++ "/" ++ modname + nm_hs = nm ++ ".hs" + nm_hi = nm ++ ".hi" + nm_o = nm ++ ".o" + + maybeTime :: String -> IO (Maybe ClockTime) + maybeTime f + = do putStrLn ("maybeTime: " ++ f) + exists <- doesFileExist f + if not exists + then do putStrLn " ... no" + return Nothing + else do tm <- getModificationTime f + putStrLn (" ... " ++ show tm) + return (Just tm) + + + newFinder :: PCI -> IO Finder -newFinder pci = return (error "newFinder:unimp") +newFinder pci + -- PCI is a list of packages and their names + = do + -- the list of directories where package interfaces are + let p_i_dirs :: [(PkgName,Path)] + p_i_dirs = concatMap nm_and_paths pci + + -- interface names in each directory + ifacess <- mapM ifaces_in_dir p_i_dirs + let ifaces :: [(ModName,PkgName,Path)] + ifaces = concat ifacess + + -- ToDo: allow a range of home package directories + return (mkFinder ifaces ["."]) + where + nm_and_paths :: Package -> [(PkgName,Path)] + nm_and_paths package + = [(name package, path) | path <- nub (import_dirs package)] + + ifaces_in_dir :: (PkgName,Path) -> IO [(ModName,PkgName,Path)] + ifaces_in_dir (pkgname,path) + = getDirectoryContents path >>= \ entries -> + return [(zap_hi if_nm, pkgname, path) + | if_nm <- entries, looks_like_iface_name if_nm] + looks_like_iface_name e + = not (null e) && isUpper (head e) + && take 3 (reverse e) == "ih." + zap_hi + = reverse . drop 3 . reverse + \end{code} diff --git a/ghc/compiler/ghci/CmStaticInfo.lhs b/ghc/compiler/ghci/CmStaticInfo.lhs index 48594f6..2bb52ba 100644 --- a/ghc/compiler/ghci/CmStaticInfo.lhs +++ b/ghc/compiler/ghci/CmStaticInfo.lhs @@ -4,7 +4,7 @@ \section[CmStaticInfo]{Session-static info for the Compilation Manager} \begin{code} -module CmStaticInfo ( FLAGS, PCI, +module CmStaticInfo ( FLAGS, Package(..), PCI, mkSI, SI -- abstract ) where @@ -15,8 +15,25 @@ where \begin{code} type FLAGS = [String] -- or some such fiction -type PCI = [PkgConfig] -data PkgConfig = PkgConfig -- add details here +type PCI = [Package] + +-- copied from the driver +data Package + = Package { + name :: String, + import_dirs :: [String], + library_dirs :: [String], + hs_libraries :: [String], + extra_libraries :: [String], + include_dirs :: [String], + c_includes :: [String], + package_deps :: [String], + extra_ghc_opts :: [String], + extra_cc_opts :: [String], + extra_ld_opts :: [String] + } + deriving (Read, Show) + data SI = MkSI FLAGS PCI diff --git a/ghc/compiler/ghci/CmSummarise.lhs b/ghc/compiler/ghci/CmSummarise.lhs index b3d3e6b..6d6b652 100644 --- a/ghc/compiler/ghci/CmSummarise.lhs +++ b/ghc/compiler/ghci/CmSummarise.lhs @@ -4,7 +4,8 @@ \section[CmSummarise]{Module summariser for GHCI} \begin{code} -module CmSummarise ( ModImport(..), ModSummary(..), summarise ) +module CmSummarise ( ModImport(..), mi_name, + ModSummary(..), summarise ) where #include "HsVersions.h" @@ -13,20 +14,26 @@ import List ( nub ) import Char ( ord, isAlphaNum ) import CmFind ( ModName, ModLocation(..) ) - +import Outputable ( pprPanic, text ) \end{code} \begin{code} data ModSummary - = ModSummary ModLocation -- location and kind - (Maybe (String, Fingerprint)) -- source and sig if .hs - (Maybe [ModImport]) -- imports if .hs or .hi + = ModSummary { + ms_loc :: ModLocation, -- location and kind + ms_source :: (Maybe (String, Fingerprint)), -- source and sig if .hs + ms_imports :: (Maybe [ModImport]) -- imports if .hs or .hi + } + deriving Show data ModImport = MINormal ModName | MISource ModName - deriving Eq + deriving (Eq, Show) + +mi_name (MINormal nm) = nm +mi_name (MISource nm) = nm type Fingerprint = Int @@ -46,6 +53,8 @@ summarise loc -> readFile hiPath >>= \ hisrc -> let imps = getImports hisrc in return (ModSummary loc Nothing (Just imps)) + NotFound + -> pprPanic "summarise:NotFound" (text (show loc)) fingerprint :: String -> Int fingerprint s diff --git a/ghc/compiler/ghci/CompManager.lhs b/ghc/compiler/ghci/CompManager.lhs index 02f33ca..2e0ca15 100644 --- a/ghc/compiler/ghci/CompManager.lhs +++ b/ghc/compiler/ghci/CompManager.lhs @@ -6,18 +6,21 @@ \begin{code} module CompManager ( cmInit, cmLoadModule, cmGetExpr, cmRunExpr, - CmState -- abstract + CmState, emptyCmState -- abstract ) where #include "HsVersions.h" +import List ( nub ) +import Maybe ( catMaybes ) import Outputable ( SDoc ) import FiniteMap ( emptyFM ) import CmStaticInfo ( FLAGS, PCI, SI, mkSI ) -import CmFind ( Finder, newFinder, ModName ) -import CmSummarise ( ) +import CmFind ( Finder, newFinder, + ModName, ml_modname, isPackageLoc ) +import CmSummarise ( summarise, ModSummary(..), mi_name ) import CmCompile ( PCS, emptyPCS, HST, HIT ) import CmLink ( PLS, emptyPLS, HValue, Linkable ) @@ -29,12 +32,6 @@ cmInit :: FLAGS cmInit flags pkginfo = emptyCmState flags pkginfo -cmLoadModule :: CmState - -> ModName - -> IO (CmState, Either [SDoc] ModHandle) -cmLoadModule cmstate modname - = return (error "cmLoadModule:unimp") - cmGetExpr :: CmState -> ModHandle -> String @@ -51,13 +48,18 @@ type ModHandle = String -- ToDo: do better? -- Persistent state just for CM, excluding link & compile subsystems data PCMS - = PCMS HST -- home symbol table - HIT -- home interface table - UI -- the unlinked images - MG -- the module graph + = PCMS { + hst :: HST, -- home symbol table + hit :: HIT, -- home interface table + ui :: UI, -- the unlinked images + mg :: MG -- the module graph + } emptyPCMS :: PCMS -emptyPCMS = PCMS emptyHST emptyHIT emptyUI emptyMG +emptyPCMS = PCMS { hst = emptyHST, + hit = emptyHIT, + ui = emptyUI, + mg = emptyMG } emptyHIT :: HIT emptyHIT = emptyFM @@ -69,11 +71,13 @@ emptyHST = emptyFM -- Persistent state for the entire system data CmState - = CmState PCMS -- CM's persistent state - PCS -- compile's persistent state - PLS -- link's persistent state - SI -- static info, never changes - Finder -- the module finder + = CmState { + pcms :: PCMS, -- CM's persistent state + pcs :: PCS, -- compile's persistent state + pls :: PLS, -- link's persistent state + si :: SI, -- static info, never changes + finder :: Finder -- the module finder + } emptyCmState :: FLAGS -> PCI -> IO CmState emptyCmState flags pci @@ -82,7 +86,11 @@ emptyCmState flags pci pls <- emptyPLS let si = mkSI flags pci finder <- newFinder pci - return (CmState pcms pcs pls si finder) + return (CmState { pcms = pcms, + pcs = pcs, + pls = pls, + si = si, + finder = finder }) -- CM internal types type UI = [Linkable] -- the unlinked images (should be a set, really) @@ -90,11 +98,57 @@ emptyUI :: UI emptyUI = [] -data MG = MG -- the module graph +type MG = [[ModSummary]] -- the module graph emptyMG :: MG -emptyMG = MG +emptyMG = [] +\end{code} +The real business of the compilation manager: given a system state and +a module name, try and bring the module up to date, probably changing +the system state at the same time. +\begin{code} +cmLoadModule :: CmState + -> ModName + -> IO (CmState, Either [SDoc] ModHandle) +cmLoadModule cmstate modname + = do putStr "cmLoadModule: downsweep begins\n" + let find = finder cmstate + mgNew <- downsweep modname find + putStrLn ( "after chasing:\n\n" ++ unlines (map show mgNew)) + return (error "cmLoadModule:unimp") + +downsweep :: ModName -- module to chase from + -> Finder + -> IO [ModSummary] +downsweep rootNm finder + = do rootLoc <- getSummary rootNm + loop [rootLoc] + where + getSummary :: ModName -> IO ModSummary + getSummary nm + = do loc <- finder nm + summary <- summarise loc + return summary + + -- loop invariant: homeSummaries doesn't contain package modules + loop :: [ModSummary] -> IO [ModSummary] + loop homeSummaries + = do let allImps -- all imports + = (nub . map mi_name . concat . catMaybes . map ms_imports) + homeSummaries + let allHome -- all modules currently in homeSummaries + = map (ml_modname.ms_loc) homeSummaries + let neededImps + = filter (`notElem` allHome) allImps + neededSummaries + <- mapM getSummary neededImps + let newHomeSummaries + = filter (not.isPackageLoc.ms_loc) neededSummaries + if null newHomeSummaries + then return homeSummaries + else loop (newHomeSummaries ++ homeSummaries) + \end{code} -- 1.7.10.4