[project @ 2000-11-02 13:58:44 by sewardj]

Most, but not all changes needed to get CompManager to compile.

ghc/compiler/basicTypes/Module.lhs

@@ -21,7 +21,7 @@ in a different DLL, by setting the DLL flag.
 \begin{code}
 module Module 
     (
-      Module, moduleName
+      Module, moduleName, packageOfModule,
 			    -- abstract, instance of Eq, Ord, Outputable
     , ModuleName
     , isModuleInThisPackage, mkModuleInThisPackage,
@@ -255,7 +255,7 @@ moduleString :: Module -> EncodedString
 moduleString (Module (ModuleName fs) _) = _UNPK_ fs
 
 moduleName :: Module -> ModuleName
-moduleName (Module mod _) = mod
+moduleName (Module mod pkg_info) = mod
 
 moduleUserString :: Module -> UserString
 moduleUserString (Module mod _) = moduleNameUserString mod
@@ -264,6 +264,10 @@ isModuleInThisPackage :: Module -> Bool
 isModuleInThisPackage (Module nm ThisPackage) = True
 isModuleInThisPackage _                       = False
 
+packageOfModule :: Module -> Maybe PackageName
+packageOfModule (Module nm (AnotherPackage pn)) = Just pn
+packageOfModule _                               = Nothing
+
 printModulePrefix :: Module -> Bool
   -- When printing, say M.x
 printModulePrefix (Module nm ThisPackage) = False

ghc/compiler/ghci/CmSummarise.lhs

@@ -13,10 +13,9 @@ where
 #include "HsVersions.h"
 
 import List 		( nub )
-import Char		( ord, isAlphaNum )
+import Char		( isAlphaNum )
 import Util		( unJust )
 import HscTypes		( ModuleLocation(..) )
-import FastTypes
 
 import Module
 import Outputable
@@ -36,7 +35,6 @@ data ModSummary
    = ModSummary {
         ms_mod      :: Module,                          -- name, package
 	ms_location :: ModuleLocation,			-- location
-        ms_ppsource :: (Maybe (FilePath, Fingerprint)), -- preprocessed and sig if .hs
         ms_imports  :: (Maybe [ModImport])              -- imports if .hs or .hi
      }
 
@@ -44,15 +42,9 @@ instance Outputable ModSummary where
    ppr ms
       = sep [text "ModSummary {",
              nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms),
-             text "ms_ppsource =" <+> fooble (ms_ppsource ms),
              text "ms_imports=" <+> ppr (ms_imports ms)]),
              char '}'
             ]
-        where
-           fooble Nothing = text "Nothing"
-           fooble (Just (cppd_source_name,fp)) 
-              = text "(fp =" <+> int fp <> text "," 
-                <+> text (show cppd_source_name) <> text ")"
 
 data ModImport
    = MINormal ModuleName | MISource ModuleName
@@ -80,28 +72,13 @@ type Fingerprint = Int
 
 summarise :: Module -> ModuleLocation -> IO ModSummary
 summarise mod location
-   = if isModuleInThisPackage mod
-	then do 
-	    let source_fn = unJust (ml_hspp_file location) "summarise"
-	    modsrc <- readFile source_fn
-            let imps = getImports modsrc
-                fp   = fingerprint modsrc
-            return (ModSummary mod location (Just (source_fn,fp)) (Just imps))
-	else
-           return (ModSummary mod location Nothing Nothing)
-	
-fingerprint :: String -> Int
-fingerprint s
-   = dofp s (_ILIT 3) (_ILIT 3)
-     where
-        -- Copied from hash() in Hugs' storage.c.
-        dofp :: String -> FastInt -> FastInt -> Int
-        dofp []     m fp = iBox fp
-        dofp (c:cs) m fp = dofp cs (m +# _ILIT 1) 
-				(iabs (fp +# m *# iUnbox (ord c)))
-
-        iabs :: FastInt -> FastInt
-        iabs n = if n <# _ILIT 0 then (_ILIT 0) -# n else n
+   | isModuleInThisPackage mod
+   = do let hspp_fn = unJust (ml_hspp_file location) "summarise"
+        modsrc <- readFile hspp_fn
+        let imps = getImports modsrc
+        return (ModSummary mod location (Just imps))
+   | otherwise
+   = return (ModSummary mod location Nothing)
 \end{code}
 
 Collect up the imports from a Haskell source module.  This is
@@ -141,21 +118,21 @@ clean s
      where
         -- running through text we want to keep
         keep []                   = []
-        keep ('"':cs)             = dquote cs
+        keep ('"':cs)             = dquote cs		-- "
 		-- try to eliminate single quotes when they're part of
 		-- an identifier...
 	keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
         keep ('\'':cs)            = squote cs
         keep ('-':'-':cs)         = linecomment cs
         keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
-        keep ('{':'-':cs)         = runcomment cs
+        keep ('{':'-':cs)         = runcomment cs	-- -}
         keep (c:cs)               = c : keep cs
 
         -- in a double-quoted string
         dquote []             = []
-        dquote ('\\':'\"':cs) = dquote cs
+        dquote ('\\':'\"':cs) = dquote cs		-- "
         dquote ('\\':'\\':cs) = dquote cs
-        dquote ('\"':cs)      = keep cs
+        dquote ('\"':cs)      = keep cs			-- "
         dquote (c:cs)         = dquote cs
 
         -- in a single-quoted string

ghc/compiler/main/DriverPipeline.hs

 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.14 2000/10/31 13:01:46 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.15 2000/11/02 13:58:45 sewardj Exp $
 --
 -- GHC Driver
 --
@@ -14,10 +14,10 @@ module DriverPipeline (
    genPipeline, runPipeline,
 
 	-- interfaces for the compilation manager (interpreted/batch-mode)
-   preprocess, compile,
+   preprocess, compile, CompResult(..),
 
 	-- batch-mode linking interface
-   doLink,
+   doLink
   ) where
 
 #include "HsVersions.h"

ghc/compiler/main/Finder.lhs

@@ -6,7 +6,8 @@
 \begin{code}
 module Finder (
     initFinder, 	-- :: PackageConfigInfo -> IO (), 
-    findModule		-- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
+    findModule,		-- :: ModuleName -> IO (Maybe (Module, ModuleLocation))
+    emptyHomeDirCache	-- :: IO ()
   ) where
 
 #include "HsVersions.h"
@@ -18,6 +19,7 @@ import DriverState
 import Module
 import FiniteMap
 import Util
+import Panic		( panic )
 
 import IOExts
 import Directory
@@ -35,11 +37,12 @@ source, interface, and object files for a module live.
 \begin{code}
 
 -- v_PkgDirCache caches contents of package directories, never expunged
-GLOBAL_VAR(v_PkgDirCache,    error "no pkg cache!",  FiniteMap String (PackageName, FilePath))
+GLOBAL_VAR(v_PkgDirCache, panic "no pkg cache!", 
+           FiniteMap String (PackageName, FilePath))
 
 -- v_HomeDirCache caches contents of home directories, 
 -- expunged whenever we create a new finder.
-GLOBAL_VAR(v_HomeDirCache,   Nothing,  Maybe (FiniteMap String FilePath))
+GLOBAL_VAR(v_HomeDirCache, Nothing, Maybe (FiniteMap String FilePath))
 
 
 initFinder :: PackageConfigInfo -> IO ()
@@ -54,6 +57,10 @@ initFinder pkgs
 --	; putStrLn (unlines (map show (fmToList pkg_dbg_info)))
 	}
 
+emptyHomeDirCache :: IO ()
+emptyHomeDirCache
+   = writeIORef v_HomeDirCache Nothing
+
 findModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))
 findModule name
   = do 	{ hPutStr stderr ("findModule: " ++ moduleNameUserString name ++ " ... ")
@@ -69,7 +76,7 @@ findModule_wrk name
   = do	{ j <- maybeHomeModule name
 	; case j of
 	    Just home_module -> return (Just home_module)
-	    Nothing		 -> maybePackageModule name
+	    Nothing	     -> maybePackageModule name
 	}
 
 maybeHomeModule :: ModuleName -> IO (Maybe (Module, ModuleLocation))