From 00fe57d46c18e83674cc17c77643164289abdef5 Mon Sep 17 00:00:00 2001 From: sewardj Date: Tue, 14 Nov 2000 17:41:05 +0000 Subject: [PATCH] [project @ 2000-11-14 17:41:04 by sewardj] Fixes to do with CM and module cycles. Also to do with OPTIONS pragmas. --- ghc/compiler/codeGen/CgRetConv.lhs | 4 ++-- ghc/compiler/compMan/CmSummarise.lhs | 10 ++++++++-- ghc/compiler/compMan/CompManager.lhs | 12 ++++++------ ghc/compiler/main/CmdLineOpts.lhs | 2 +- ghc/compiler/main/DriverPipeline.hs | 11 ++++++----- ghc/compiler/main/Finder.lhs | 6 +++--- ghc/compiler/rename/RnHiFiles.lhs | 2 +- ghc/compiler/utils/Digraph.lhs | 5 +++++ 8 files changed, 32 insertions(+), 20 deletions(-) diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs index cec13b2..0b72ebe 100644 --- a/ghc/compiler/codeGen/CgRetConv.lhs +++ b/ghc/compiler/codeGen/CgRetConv.lhs @@ -1,7 +1,7 @@ % % (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 diff --git a/ghc/compiler/compMan/CmSummarise.lhs b/ghc/compiler/compMan/CmSummarise.lhs index ede8046..83393e4 100644 --- a/ghc/compiler/compMan/CmSummarise.lhs +++ b/ghc/compiler/compMan/CmSummarise.lhs @@ -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] diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index 61de1f9..c9ba801 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -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 diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index c2e3614..1466775 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -305,7 +305,7 @@ data HscLang | HscAsm | HscJava | HscInterpreted - deriving Eq + deriving (Eq, Show) dopt_HscLang :: DynFlags -> HscLang dopt_HscLang = hscLang diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 5eb5e0d..f1e9618 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index ae4ff77..5431719 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -109,14 +109,14 @@ maybeHomeModule mod_name = do (path ++ '/':hs); Nothing -> do - -- last chance: .hi-boot and .hi-boot- + -- last chance: .hi-boot- 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 diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs index dc0e71d..ad4f8c1 100644 --- a/ghc/compiler/rename/RnHiFiles.lhs +++ b/ghc/compiler/rename/RnHiFiles.lhs @@ -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} diff --git a/ghc/compiler/utils/Digraph.lhs b/ghc/compiler/utils/Digraph.lhs index df34dde..1544c7b 100644 --- a/ghc/compiler/utils/Digraph.lhs +++ b/ghc/compiler/utils/Digraph.lhs @@ -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} -- 1.7.10.4