[project @ 2000-04-07 15:24:15 by simonpj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Module.lhs

diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs
index 4320bc3..9fcf38c 100644 (file)
--- a/ghc/compiler/basicTypes/Module.lhs
+++ b/ghc/compiler/basicTypes/Module.lhs
@@ -21,9 +21,9 @@ module Module
     , mkVanillaModule      -- :: ModuleName -> Module
     , mkThisModule         -- :: ModuleName -> Module
     , mkPrelModule          -- :: UserString -> Module
     , mkVanillaModule      -- :: ModuleName -> Module
     , mkThisModule         -- :: ModuleName -> Module
     , mkPrelModule          -- :: UserString -> Module

-
+    

     , isDynamicModule       -- :: Module -> Bool
     , isDynamicModule       -- :: Module -> Bool

-    , isLibModule
+    , isPrelModule

 
     , mkSrcModule
 
 
     , mkSrcModule
 

@@ -36,7 +36,7 @@ module Module
     , DllFlavour, dll, notDll
 
        -- ModFlavour
     , DllFlavour, dll, notDll
 
        -- ModFlavour

-    , ModFlavour, libMod, userMod
+    , ModFlavour,

 
        -- Where to find a .hi file
     , WhereFrom(..), SearchPath, mkSearchPath
 
        -- Where to find a .hi file
     , WhereFrom(..), SearchPath, mkSearchPath

@@ -48,7 +48,7 @@ module Module
 import OccName
 import Outputable
 import FiniteMap
 import OccName
 import Outputable
 import FiniteMap

-import CmdLineOpts     ( opt_Static, opt_CompilingPrelude, opt_WarnHiShadows )
+import CmdLineOpts     ( opt_Static, opt_CompilingPrelude, opt_WarnHiShadows, opt_HiMapSep )

 import Constants       ( interfaceFileFormatVersion )
 import Maybes          ( seqMaybe )
 import Maybe           ( fromMaybe )
 import Constants       ( interfaceFileFormatVersion )
 import Maybes          ( seqMaybe )
 import Maybe           ( fromMaybe )

@@ -101,12 +101,14 @@ We also track whether an imported module is from a 'system-ish' place.  In this
 we don't record the fact that this module depends on it, nor usages of things
 inside it.  
 
 we don't record the fact that this module depends on it, nor usages of things
 inside it.  
 

+Apr 00: We want to record dependencies on all modules other than
+prelude modules else STG Hugs gets confused because it uses this
+info to know what modules to link.  (Compiled GHC uses command line
+options to specify this.)
+

 \begin{code}
 \begin{code}

-data ModFlavour = LibMod       -- A library-ish module
+data ModFlavour = PrelMod      -- A Prelude module

                | UserMod       -- Not library-ish
                | UserMod       -- Not library-ish

-
-libMod  = LibMod
-userMod = UserMod

 \end{code}
 
 
 \end{code}
 
 

@@ -143,10 +145,9 @@ type ModuleName = EncodedFS
        -- Haskell module names can include the quote character ',
        -- so the module names have the z-encoding applied to them
 
        -- Haskell module names can include the quote character ',
        -- so the module names have the z-encoding applied to them
 

-type ModuleNameSet = FiniteMap ModuleName
-elemModuleNameSet  s x = elemFM s x
-moduleNameSetElems s   = eltsFM s
-
+isPrelModuleName :: ModuleName -> Bool
+       -- True for names of prelude modules
+isPrelModuleName m = take 4 (_UNPK_ m) == "Prel"

 
 pprModuleName :: ModuleName -> SDoc
 pprModuleName nm = pprEncodedFS nm
 
 pprModuleName :: ModuleName -> SDoc
 pprModuleName nm = pprEncodedFS nm

@@ -188,24 +189,49 @@ instance Ord Module where
 
 \begin{code}
 pprModule :: Module -> SDoc
 
 \begin{code}
 pprModule :: Module -> SDoc

-pprModule (Module mod _ _) = pprEncodedFS mod
+pprModule (Module mod _ _) = getPprStyle $ \ sty ->
+                            if userStyle sty then
+                               text (moduleNameUserString mod)                         
+                            else
+                               pprModuleName mod

 \end{code}
 
 
 \begin{code}
 \end{code}
 
 
 \begin{code}

-mkModule = Module
+mkModule :: FilePath   -- Directory in which this module is
+        -> ModuleName  -- Name of the module
+        -> DllFlavour
+        -> Module
+mkModule dir_path mod_nm is_dll
+  | isPrelModuleName mod_nm = mkPrelModule mod_nm
+  | otherwise              = Module mod_nm UserMod is_dll
+       -- Make every module into a 'user module'
+       -- except those constructed by mkPrelModule
+

 
 mkVanillaModule :: ModuleName -> Module
 
 mkVanillaModule :: ModuleName -> Module

-mkVanillaModule name = Module name UserMod NotDll
+mkVanillaModule name = Module name UserMod dell
+ where
+  main_mod = mkSrcModuleFS SLIT("Main")
+
+   -- Main can never be in a DLL - need this
+   -- special case in order to correctly
+   -- compile PrelMain
+  dell | opt_Static || opt_CompilingPrelude || 
+         name == main_mod = NotDll
+       | otherwise       = Dll
+

 
 mkThisModule :: ModuleName -> Module   -- The module being comiled
 
 mkThisModule :: ModuleName -> Module   -- The module being comiled

-mkThisModule name = Module name UserMod NotDll -- ToDo: correct Dll flag?
+mkThisModule name = 
+  Module name UserMod NotDll -- This is fine, a Dll flag is only
+                            -- pinned on imported modules.

 
 mkPrelModule :: ModuleName -> Module
 mkPrelModule name = Module name sys dll
  where 
   sys | opt_CompilingPrelude = UserMod
 
 mkPrelModule :: ModuleName -> Module
 mkPrelModule name = Module name sys dll
  where 
   sys | opt_CompilingPrelude = UserMod

-      | otherwise           = LibMod
+      | otherwise           = PrelMod

 
   dll | opt_Static || opt_CompilingPrelude = NotDll
       | otherwise                         = Dll
 
   dll | opt_Static || opt_CompilingPrelude = NotDll
       | otherwise                         = Dll

@@ -225,9 +251,9 @@ isDynamicModule :: Module -> Bool
 isDynamicModule (Module _ _ Dll)  = True
 isDynamicModule _                = False
 
 isDynamicModule (Module _ _ Dll)  = True
 isDynamicModule _                = False
 

-isLibModule :: Module -> Bool
-isLibModule (Module _ LibMod _) = True
-isLibModule _                  = False
+isPrelModule :: Module -> Bool
+isPrelModule (Module _ PrelMod _) = True
+isPrelModule _                   = False

 \end{code}
 
 
 \end{code}
 
 

@@ -284,8 +310,8 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do
                         return (if exists then Dll else NotDll)
                )
                (\ _ {-don't care-} -> return NotDll)
                         return (if exists then Dll else NotDll)
                )
                (\ _ {-don't care-} -> return NotDll)

-  return (foldl (addModules is_dll) hims fpaths)
-  )  -- soft failure
+  return (foldl (addModules is_dll) hims fpaths))
+  -- soft failure

       `catch` 
         (\ err -> do
              hPutStrLn stderr
       `catch` 
         (\ err -> do
              hPutStrLn stderr

@@ -298,12 +324,6 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do
               return hims
        )
  where
               return hims
        )
  where

-  
-       -- Dreadfully crude.  We want a better way to distinguish
-       -- "library-ish" modules.
-   is_sys | head dir_path == '/' = LibMod
-         | otherwise            = UserMod
-

    xiffus       = reverse dotted_suffix 
    dotted_suffix = case suffix of
                      []       -> []
    xiffus       = reverse dotted_suffix 
    dotted_suffix = case suffix of
                      []       -> []

@@ -316,17 +336,27 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do
 
    addModules is_dll his@(hi_env, hib_env) filename = fromMaybe his $ 
         FMAP add_hi   (go xiffus                rev_fname)     `seqMaybe`
 
    addModules is_dll his@(hi_env, hib_env) filename = fromMaybe his $ 
         FMAP add_hi   (go xiffus                rev_fname)     `seqMaybe`

-        FMAP add_vhib (go hi_boot_version_xiffus rev_fname)    `seqMaybe`
-       FMAP add_hib  (go hi_boot_xiffus         rev_fname)
-    where
-     rev_fname = reverse filename
-     path      = dir_path ++ '/':filename

 
 

-     mk_module mod_nm = Module mod_nm is_sys is_dll
-     add_hi    mod_nm = (addToFM_C addNewOne hi_env mod_nm (path, mk_module mod_nm), hib_env)
-     add_vhib  mod_nm = (hi_env, addToFM_C overrideNew hib_env mod_nm (path, mk_module mod_nm))
-     add_hib   mod_nm = (hi_env, addToFM_C addNewOne   hib_env mod_nm (path, mk_module mod_nm))
+        FMAP add_vhib (go hi_boot_version_xiffus rev_fname)    `seqMaybe`
+               -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot

 
 

+       FMAP add_hib  (go hi_boot_xiffus         rev_fname)
+     where
+       rev_fname = reverse filename
+       path      = dir_path ++ '/':filename
+
+         -- In these functions file_nm is the base of the filename,
+         -- with the path and suffix both stripped off.  The filename
+         -- is the *unencoded* module name (else 'make' gets confused).
+         -- But the domain of the HiMaps is ModuleName which is encoded.
+       add_hi    file_nm = (add_to_map addNewOne hi_env file_nm,   hib_env)
+       add_vhib  file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
+       add_hib   file_nm = (hi_env, add_to_map addNewOne   hib_env file_nm)
+
+       add_to_map combiner env file_nm 
+         = addToFM_C combiner env mod_nm (path, mkModule dir_path mod_nm is_dll)
+         where
+           mod_nm = mkSrcModuleFS file_nm

 
    -- go prefix (prefix ++ stuff) == Just (reverse stuff)
    go [] xs                    = Just (_PK_ (reverse xs))
 
    -- go prefix (prefix ++ stuff) == Just (reverse stuff)
    go [] xs                    = Just (_PK_ (reverse xs))

@@ -378,7 +408,7 @@ mkSearchPath (Just s) = go s
     go s  = 
       case span (/= '%') s of
        (dir,'%':rs) ->
     go s  = 
       case span (/= '%') s of
        (dir,'%':rs) ->

-         case span (/= ':') rs of
+         case span (/= opt_HiMapSep) rs of

           (hisuf,_:rest) -> (dir,hisuf):go rest
           (hisuf,[])     -> [(dir,hisuf)]
 \end{code}
           (hisuf,_:rest) -> (dir,hisuf):go rest
           (hisuf,[])     -> [(dir,hisuf)]
 \end{code}