Commit c1d8b21c authored by sewardj's avatar sewardj
Browse files

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

Most, but not all changes needed to get CompManager to compile.
parent 31c886b4
......@@ -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
......
......@@ -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
......
This diff is collapsed.
-----------------------------------------------------------------------------
-- $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"
......
......@@ -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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment