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

Fixes to do with CM and module cycles.  Also to do with OPTIONS pragmas.

diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index cec13b2..0b72ebe 100644 (file)
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP Project, Glasgow University, 1992-1998
 %
 %
 % (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}
 
 %
 \section[CgRetConv]{Return conventions for the code generator}
 

@@ -58,7 +58,7 @@ ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
 
 ctrlReturnConvAlg tycon
   = case (tyConFamilySize tycon) of
 
 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
       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 (file)
--- 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,
 \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
 
                     getImports )
 where
 

@@ -58,6 +58,9 @@ instance Outputable ModImport where
 mimp_name (MINormal nm) = nm
 mimp_name (MISource nm) = 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
 
 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.
 
 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]
 \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]
 
 -- 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 (file)
--- 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,
 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 )
 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 HscMain         ( initPersistentCompilerState )
 import Finder          ( findModule, emptyHomeDirCache )
 import BasicTypes      ( GhciMode(..) )

-import Util            ( unJust )

 import DriverUtil      ( BarfKind(..) )
 import Exception       ( throwDyn )
 \end{code}
 import DriverUtil      ( BarfKind(..) )
 import Exception       ( throwDyn )
 \end{code}

@@ -143,7 +142,6 @@ cmLoadModule cmstate1 modname
 
         putStr "cmLoadModule: downsweep begins\n"
         mg2unsorted <- downsweep 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
 
         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"
         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.
 
         -- 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
 
      in
          sccs
 

+-- NB: ignores import-sources for the time being

 downsweep :: ModuleName          -- module to chase from
           -> IO [ModSummary]
 downsweep rootNm
 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 
                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) ++ "'"))
                                  
 
                                      ++ showSDoc (ppr nm) ++ "'"))
                                  
 

@@ -521,7 +520,8 @@ downsweep rootNm
         loop homeSummaries
            = do let allImps :: [ModuleName]
                     allImps   -- all imports
         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
                          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 (file)
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -305,7 +305,7 @@ data HscLang
   | HscAsm
   | HscJava
   | HscInterpreted
   | HscAsm
   | HscJava
   | HscInterpreted

-    deriving Eq
+    deriving (Eq, Show)

 
 dopt_HscLang :: DynFlags -> HscLang
 dopt_HscLang = hscLang
 
 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 (file)
--- 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
 --
 --
 -- 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
 
    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
 
    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 (file)
--- a/ghc/compiler/main/Finder.lhs
+++ b/ghc/compiler/main/Finder.lhs
@@ -109,14 +109,14 @@ maybeHomeModule mod_name = do
                                                 (path ++ '/':hs);
        Nothing -> 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
    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
        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
        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 (file)
--- 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)
                     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}
 
   | otherwise    = path
 \end{code}
 

diff --git a/ghc/compiler/utils/Digraph.lhs b/ghc/compiler/utils/Digraph.lhs
index df34dde..1544c7b 100644 (file)
--- 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 Maybe
 import Array
 import List

+import Outputable

 \end{code}
 
 
 \end{code}
 
 

@@ -61,6 +62,10 @@ flattenSCCs = concatMap flattenSCC
 
 flattenSCC (AcyclicSCC v) = [v]
 flattenSCC (CyclicSCC vs) = vs
 
 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}
 \end{code}
 
 \begin{code}