Commit d68df63f authored by sewardj's avatar sewardj
Browse files

[project @ 2000-11-15 15:43:30 by sewardj]

Overhaul of CM, reducing the complexity of recursive module machinery.
Also, don't compute package dependencies at all, and don't pass them
to the linker.
parent 8b653a82
......@@ -6,6 +6,7 @@
\begin{code}
module CmLink ( Linkable(..), Unlinked(..),
filterModuleLinkables,
findModuleLinkable,
modname_of_linkable, is_package_linkable,
LinkResult(..),
link,
......@@ -17,7 +18,7 @@ import Interpreter
import CmStaticInfo ( PackageConfigInfo, GhciMode(..) )
import Module ( ModuleName, PackageName )
import Outputable ( SDoc )
import Digraph ( SCC(..), flattenSCC, flattenSCCs )
import Digraph ( SCC(..), flattenSCC )
import Outputable
import Panic ( panic )
......@@ -85,6 +86,13 @@ instance Outputable Linkable where
ppr (LM mod_nm unlinkeds) = text "LinkableM" <+> ppr mod_nm <+> ppr unlinkeds
ppr (LP package_nm) = text "LinkableP" <+> ptext package_nm
findModuleLinkable :: [Linkable] -> ModuleName -> Linkable
findModuleLinkable lis mod
= case [LM nm us | LM nm us <- lis, nm == mod] of
[li] -> li
other -> pprPanic "findModuleLinkable" (ppr mod)
emptyPLS :: IO PersistentLinkerState
#ifdef GHCI
emptyPLS = return (PersistentLinkerState { closure_env = emptyFM,
......@@ -102,8 +110,7 @@ emptyPLS = return (PersistentLinkerState {})
link :: ([String] -> IO ())
-> GhciMode -- interactive or batch
-> Bool -- attempt linking in batch mode?
-> PackageConfigInfo
-> [SCC Linkable]
-> [Linkable] -- only contains LMs, not LPs
-> PersistentLinkerState
-> IO LinkResult
......@@ -117,11 +124,11 @@ link :: ([String] -> IO ())
-- batch mode. It should only be True if the upsweep was
-- successful and someone exports main, i.e., we have good
-- reason to believe that linking will succeed.
link doLink Batch batch_attempt_linking pci groups pls1
link doLink Batch batch_attempt_linking linkables pls1
| batch_attempt_linking
= do putStrLn "LINK(batch): linkables are ..."
putStrLn (showSDoc (vcat (map ppLinkableSCC groups)))
let o_files = concatMap getOfiles (flattenSCCs groups)
putStrLn (showSDoc (vcat (map ppr linkables)))
let o_files = concatMap getOfiles linkables
doLink o_files
-- doLink only returns if it succeeds
putStrLn "LINK(batch): done"
......@@ -131,10 +138,10 @@ link doLink Batch batch_attempt_linking pci groups pls1
putStrLn " -- not doing linking"
return (LinkOK pls1)
where
getOfiles (LP _) = []
getOfiles (LP _) = panic "link.getOfiles: shouldn't get package linkables"
getOfiles (LM _ us) = map nameOfObject (filter isObject us)
link doLink Interactive batch_attempt_linking pci groups pls1
link doLink Interactive batch_attempt_linking linkables pls1
= do putStrLn "LINKER(interactive): not yet implemented"
return (LinkOK pls1)
......
......@@ -4,19 +4,19 @@
\section[CmSummarise]{Module summariser for GHCI}
\begin{code}
module CmSummarise ( ModImport(..), mimp_name,
ModSummary(..), summarise, ms_get_imports,
name_of_summary, deps_of_summary, is_source_import,
getImports )
module CmSummarise ( ModSummary(..), summarise, name_of_summary,
getImports {-, source_has_changed-} )
where
#include "HsVersions.h"
import List ( nub )
import Char ( isAlphaNum )
--import Time ( ClockTime )
--import Directory ( getModificationTime )
import Util ( unJust )
import HscTypes ( ModuleLocation(..) )
import Module
import Outputable
\end{code}
......@@ -24,54 +24,35 @@ import Outputable
\begin{code}
-- The Module contains the original source filename of the module.
-- The ms_ppsource field contains another filename, which is intended to
-- be the cleaned-up source file after all preprocessing has happened to
-- it. The point is that the summariser will have to cpp/unlit/whatever
-- The ModuleLocation contains both the original source filename and the
-- filename of the cleaned-up source file after all preprocessing has been
-- done. The point is that the summariser will have to cpp/unlit/whatever
-- all files anyway, and there's no point in doing this twice -- just
-- park the result in a temp file, put the name of it in ms_ppsource,
-- park the result in a temp file, put the name of it in the location,
-- and let @compile@ read from that file on the way back up.
data ModSummary
= ModSummary {
ms_mod :: Module, -- name, package
ms_location :: ModuleLocation, -- location
ms_imports :: (Maybe [ModImport]) -- imports if .hs or .hi
ms_mod :: Module, -- name, package
ms_location :: ModuleLocation, -- location
ms_srcimps :: [ModuleName], -- source imports
ms_imps :: [ModuleName] -- non-source imports
--ms_date :: Maybe ClockTime -- timestamp of summarised
-- file, if home && source
}
instance Outputable ModSummary where
ppr ms
= sep [text "ModSummary {",
= sep [--text "ModSummary { ms_date = " <> text (show ms_date),
text "ModSummary {",
nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms) <> comma,
text "ms_imports =" <+> ppr (ms_imports ms)]),
text "ms_imps =" <+> ppr (ms_imps ms),
text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
char '}'
]
data ModImport
= MINormal ModuleName | MISource ModuleName
deriving Eq
instance Outputable ModImport where
ppr (MINormal nm) = ppr nm
ppr (MISource nm) = text "{-# SOURCE #-}" <+> ppr nm
mimp_name (MINormal nm) = nm
mimp_name (MISource nm) = nm
is_source_import (MINormal _) = False
is_source_import (MISource _) = True
name_of_summary :: ModSummary -> ModuleName
name_of_summary = moduleName . ms_mod
deps_of_summary :: ModSummary -> [ModuleName]
deps_of_summary = map mimp_name . ms_get_imports
ms_get_imports :: ModSummary -> [ModImport]
ms_get_imports summ
= case ms_imports summ of { Just is -> is; Nothing -> [] }
type Fingerprint = Int
-- The first arg is supposed to be DriverPipeline.preprocess.
-- Passed in here to avoid a hard-to-avoid circular dependency
......@@ -84,10 +65,35 @@ summarise preprocess mod location
= do let hs_fn = unJust (ml_hs_file location) "summarise"
hspp_fn <- preprocess hs_fn
modsrc <- readFile hspp_fn
let imps = getImports modsrc
return (ModSummary mod location{ml_hspp_file=Just hspp_fn} (Just imps))
let (srcimps,imps) = getImports modsrc
-- maybe_timestamp
-- <- case ml_hs_file location of
-- Nothing -> return Nothing
-- Just src_fn -> getModificationTime src_fn >>= Just
return (ModSummary mod location{ml_hspp_file=Just hspp_fn}
srcimps imps
{-maybe_timestamp-} )
| otherwise
= return (ModSummary mod location Nothing)
= return (ModSummary mod location [] [])
-- Compare the timestamp on the source file with that already
-- in the summary, and see if the source file is younger. If
-- in any doubt, return True (because False could cause compilation
-- to be omitted).
{-
source_has_changed :: ModSummary -> IO Bool
source_has_changed summary
= case ms_date summary of {
Nothing -> True; -- don't appear to have a previous timestamp
Just summ_date ->
case ml_hs_file (ms_loc summary) of {
Nothing -> True; -- don't appear to have a source file (?!?!)
Just src_fn -> do now_date <- getModificationTime src_fn
return (now_date > summ_date)
}}
-}
\end{code}
Collect up the imports from a Haskell source module. This is
......@@ -95,28 +101,31 @@ approximate: we don't parse the module, but we do eliminate comments
and strings. Doesn't currently know how to unlit or cppify the module
first.
NB !!!!! Ignores source imports, pro tem.
\begin{code}
getImports :: String -> [ModImport]
getImports = filter (not . is_source_import) .
nub . gmiBase . clean
getImports :: String -> ([ModuleName], [ModuleName])
getImports str
= let all_imps = (nub . gmiBase . clean) str
srcs = concatMap (either unit nil) all_imps
normals = concatMap (either nil unit) all_imps
unit x = [x]
nil x = []
in (srcs, normals)
-- really get the imports from a de-litted, cpp'd, de-literal'd string
gmiBase :: String -> [ModImport]
-- Lefts are source imports. Rights are normal ones.
gmiBase :: String -> [Either ModuleName ModuleName]
gmiBase s
= f (words s)
where
f ("foreign" : "import" : ws) = f ws
f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
= MISource (mkMN m) : f ws
= Left (mkMN m) : f ws
f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
= MISource (mkMN m) : f ws
= Left (mkMN m) : f ws
f ("import" : "qualified" : m : ws)
= MINormal (mkMN m) : f ws
= Right (mkMN m) : f ws
f ("import" : m : ws)
= MINormal (mkMN m) : f ws
= Right (mkMN m) : f ws
f (w:ws) = f ws
f [] = []
......
This diff is collapsed.
-----------------------------------------------------------------------------
-- $Id: DriverMkDepend.hs,v 1.4 2000/11/15 09:58:00 sewardj Exp $
-- $Id: DriverMkDepend.hs,v 1.5 2000/11/15 15:43:31 sewardj Exp $
--
-- GHC Driver
--
......@@ -11,7 +11,6 @@ module DriverMkDepend where
#include "HsVersions.h"
import CmSummarise -- for mkdependHS stuff
import DriverState
import DriverUtil
import DriverFlags
......@@ -164,23 +163,19 @@ endMkDependHS = do
(unwords [ "cp", tmp_file, makefile ])
findDependency :: String -> ModImport -> IO (Maybe (String, Bool))
findDependency mod imp = do
findDependency :: Bool -> String -> ModuleName -> IO (Maybe (String, Bool))
findDependency is_source mod imp = do
dir_contents <- readIORef v_Dep_dir_contents
ignore_dirs <- readIORef v_Dep_ignore_dirs
hisuf <- readIORef v_Hi_suf
let
(imp_mod, is_source) =
case imp of
MINormal str -> (moduleNameUserString str, False)
MISource str -> (moduleNameUserString str, True )
imp_hi = imp_mod ++ '.':hisuf
imp_hiboot = imp_mod ++ ".hi-boot"
imp_mod = moduleNameUserString imp
imp_hi = imp_mod ++ '.':hisuf
imp_hiboot = imp_mod ++ ".hi-boot"
imp_hiboot_v = imp_mod ++ ".hi-boot-" ++ cHscIfaceFileVersion
imp_hs = imp_mod ++ ".hs"
imp_lhs = imp_mod ++ ".lhs"
imp_hs = imp_mod ++ ".hs"
imp_lhs = imp_mod ++ ".lhs"
deps | is_source = [ imp_hiboot_v, imp_hiboot, imp_hs, imp_lhs ]
| otherwise = [ imp_hi, imp_hs, imp_lhs ]
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.25 2000/11/14 17:41:04 sewardj Exp $
-- $Id: DriverPipeline.hs,v 1.26 2000/11/15 15:43:31 sewardj Exp $
--
-- GHC Driver
--
......@@ -338,9 +338,11 @@ run_phase Cpp basename suff input_fn output_fn
run_phase MkDependHS basename suff input_fn _output_fn = do
src <- readFile input_fn
let imports = getImports src
let (import_sources, import_normals) = getImports src
deps <- mapM (findDependency basename) imports
deps_sources <- mapM (findDependency True basename) import_sources
deps_normals <- mapM (findDependency False basename) import_normals
let deps = deps_sources ++ deps_normals
osuf_opt <- readIORef v_Object_suf
let osuf = case osuf_opt of
......
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