Commit 00fe57d4 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-11-14 17:41:04 by sewardj]

Fixes to do with CM and module cycles.  Also to do with OPTIONS pragmas.
parent a37ef0a9
%
% (c) The GRASP Project, Glasgow University, 1992-1998
%
% $Id: CgRetConv.lhs,v 1.28 2000/10/18 09:40:17 simonmar Exp $
% $Id: CgRetConv.lhs,v 1.29 2000/11/14 17:41:04 sewardj Exp $
%
\section[CgRetConv]{Return conventions for the code generator}
......@@ -58,7 +58,7 @@ ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
ctrlReturnConvAlg tycon
= case (tyConFamilySize tycon) of
0 -> panic "ctrlRetConvAlg"
0 -> pprPanic "ctrlRetConvAlg" (ppr tycon)
size -> -- we're supposed to know...
if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
VectoredReturn size
......
......@@ -6,7 +6,7 @@
\begin{code}
module CmSummarise ( ModImport(..), mimp_name,
ModSummary(..), summarise, ms_get_imports,
name_of_summary, deps_of_summary,
name_of_summary, deps_of_summary, is_source_import,
getImports )
where
......@@ -58,6 +58,9 @@ instance Outputable ModImport where
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
......@@ -92,10 +95,13 @@ 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 = nub . gmiBase . clean
getImports = filter (not . is_source_import) .
nub . gmiBase . clean
-- really get the imports from a de-litted, cpp'd, de-literal'd string
gmiBase :: String -> [ModImport]
......
......@@ -27,7 +27,7 @@ import CmLink ( PersistentLinkerState, emptyPLS, Linkable(..),
import Interpreter ( HValue )
import CmSummarise ( summarise, ModSummary(..),
name_of_summary, deps_of_summary,
mimp_name, ms_get_imports )
mimp_name, ms_get_imports, is_source_import )
import Module ( ModuleName, moduleName, packageOfModule,
isModuleInThisPackage, PackageName, moduleEnvElts )
import CmStaticInfo ( Package(..), PackageConfigInfo )
......@@ -39,7 +39,6 @@ import PrelNames ( mainName )
import HscMain ( initPersistentCompilerState )
import Finder ( findModule, emptyHomeDirCache )
import BasicTypes ( GhciMode(..) )
import Util ( unJust )
import DriverUtil ( BarfKind(..) )
import Exception ( throwDyn )
\end{code}
......@@ -143,7 +142,6 @@ cmLoadModule cmstate1 modname
putStr "cmLoadModule: downsweep begins\n"
mg2unsorted <- downsweep modname
putStrLn (showSDoc (vcat (map ppr mg2unsorted)))
let modnames1 = map name_of_summary (flattenSCCs mg1)
let modnames2 = map name_of_summary mg2unsorted
......@@ -155,7 +153,7 @@ cmLoadModule cmstate1 modname
let mg2 = topological_sort mg2unsorted
putStrLn "after tsort:\n"
putStrLn (showSDoc (vcat (map ppr (flattenSCCs mg2))))
putStrLn (showSDoc (vcat (map ppr ({-flattenSCCs-} mg2))))
-- Now do the upsweep, calling compile for each module in
-- turn. Final result is version 3 of everything.
......@@ -499,6 +497,7 @@ topological_sort summaries
in
sccs
-- NB: ignores import-sources for the time being
downsweep :: ModuleName -- module to chase from
-> IO [ModSummary]
downsweep rootNm
......@@ -512,7 +511,7 @@ downsweep rootNm
case found of
Just (mod, location) -> summarise preprocess mod location
Nothing -> throwDyn (OtherError
("ghc --make: no signs of life for module `"
("no signs of life for module `"
++ showSDoc (ppr nm) ++ "'"))
......@@ -521,7 +520,8 @@ downsweep rootNm
loop homeSummaries
= do let allImps :: [ModuleName]
allImps -- all imports
= (nub . map mimp_name . concat . map ms_get_imports)
= (nub . map mimp_name
. concat . map ms_get_imports)
homeSummaries
let allHome -- all modules currently in homeSummaries
= map (moduleName.ms_mod) homeSummaries
......
......@@ -305,7 +305,7 @@ data HscLang
| HscAsm
| HscJava
| HscInterpreted
deriving Eq
deriving (Eq, Show)
dopt_HscLang :: DynFlags -> HscLang
dopt_HscLang = hscLang
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.24 2000/11/14 16:28:38 simonmar Exp $
-- $Id: DriverPipeline.hs,v 1.25 2000/11/14 17:41:04 sewardj Exp $
--
-- GHC Driver
--
......@@ -764,12 +764,13 @@ compile summary old_iface hst hit pcs = do
init_dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags init_dyn_flags
let location = ms_location summary
let input_fn = unJust (ml_hs_file location) "compile:hs"
let location = ms_location summary
let input_fn = unJust (ml_hs_file location) "compile:hs"
let input_fnpp = unJust (ml_hspp_file location) "compile:hspp"
when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
when verb (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
opts <- getOptionsFromSource input_fn
opts <- getOptionsFromSource input_fnpp
processArgs dynamic_flags opts []
dyn_flags <- readIORef v_DynFlags
......
......@@ -109,14 +109,14 @@ maybeHomeModule mod_name = do
(path ++ '/':hs);
Nothing -> do
-- last chance: .hi-boot and .hi-boot-<ver>
-- last chance: .hi-boot-<ver> and .hi-boot
let hi_boot = basename ++ ".hi-boot"
let hi_boot_ver = basename ++ ".hi-boot-" ++ cHscIfaceFileVersion
case lookupFM home_map hi_boot of {
case lookupFM home_map hi_boot_ver of {
Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename)
(path ++ '/':hs);
Nothing -> do
case lookupFM home_map hi_boot_ver of {
case lookupFM home_map hi_boot of {
Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename)
(path ++ '/':hs);
Nothing -> return Nothing
......
......@@ -501,7 +501,7 @@ findAndReadIface doc_str mod_name hi_boot_file
nest 4 (ptext SLIT("reason:") <+> doc_str)]
mkHiPath hi_boot_file (Just path)
| hi_boot_file = path ++ "-boot"
| hi_boot_file = path ++ "-boot-5"
| otherwise = path
\end{code}
......
......@@ -43,6 +43,7 @@ import ST
import Maybe
import Array
import List
import Outputable
\end{code}
......@@ -61,6 +62,10 @@ flattenSCCs = concatMap flattenSCC
flattenSCC (AcyclicSCC v) = [v]
flattenSCC (CyclicSCC vs) = vs
instance Outputable a => Outputable (SCC a) where
ppr (AcyclicSCC v) = text "NONREC" $$ (nest 3 (ppr v))
ppr (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map ppr vs)))
\end{code}
\begin{code}
......
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