X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=f4e413d26336a50b571444fd344bf134b15758cd;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=70e02091e0df3df11220a409fc0e988570552e90;hpb=c464eda3010831d8e5fb97c950aef953a1217db6;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs
index 70e0209..f4e413d 100644
--- a/ghc/compiler/basicTypes/Module.lhs
+++ b/ghc/compiler/basicTypes/Module.lhs
@@ -4,33 +4,31 @@
 
 Module
 ~~~~~~~~~~
-Simply the name of a module, represented as a Z-encoded FastString.
+Simply the name of a module, represented as a FastString.
 These are Uniquable, hence we can build FiniteMaps with ModuleNames as
 the keys.
 
 \begin{code}
 module Module 
     (
-      Module, 		   	-- Abstract, instance of Eq, Ord, Outputable
+      Module 		   	-- Abstract, instance of Eq, Ord, Outputable
     , pprModule			-- :: ModuleName -> SDoc
 
-    , ModLocation(..),
-    , showModMsg
+    , ModLocation(..)
+    , addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn
 
-    , moduleString		-- :: ModuleName -> EncodedString
-    , moduleUserString		-- :: ModuleName -> UserString
-    , moduleFS			-- :: ModuleName -> EncodedFS
+    , moduleString		-- :: ModuleName -> String
+    , moduleFS			-- :: ModuleName -> FastString
 
-    , mkModule			-- :: UserString -> ModuleName
-    , mkModuleFS		-- :: UserFS    -> ModuleName
-    , mkSysModuleFS		-- :: EncodedFS -> ModuleName
+    , mkModule			-- :: String -> ModuleName
+    , mkModuleFS		-- :: FastString -> ModuleName
  
-    , ModuleEnv,
+    , ModuleEnv
     , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C
     , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
     , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
     , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv
-    , extendModuleEnv_C
+    , extendModuleEnv_C, filterModuleEnv
 
     , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
 
@@ -40,11 +38,9 @@ module Module
 import OccName
 import Outputable
 import Unique		( Uniquable(..) )
-import Maybes		( expectJust )
 import UniqFM
 import UniqSet
 import Binary
-import StringBuffer	( StringBuffer )
 import FastString
 \end{code}
 
@@ -58,15 +54,9 @@ import FastString
 data ModLocation
    = ModLocation {
         ml_hs_file   :: Maybe FilePath,
-		-- the source file, if we have one.  Package modules
+		-- The source file, if we have one.  Package modules
 		-- probably don't have source files.
 
-        ml_hspp_file :: Maybe FilePath,
-		-- filename of preprocessed source, if we have
-		-- preprocessed it.
-	ml_hspp_buf  :: Maybe StringBuffer,
-		-- the actual preprocessed source, maybe.
-
         ml_hi_file   :: FilePath,
 		-- Where the .hi file is, whether or not it exists
 		-- yet.  Always of form foo.hi, even if there is an
@@ -81,18 +71,6 @@ data ModLocation
 
 instance Outputable ModLocation where
    ppr = text . show
-
--- Rather a gruesome function to have in Module
-
-showModMsg :: Bool -> Module -> ModLocation -> String
-showModMsg use_object mod location =
-    mod_str ++ replicate (max 0 (16 - length mod_str)) ' '
-    ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", "
-    ++ (if use_object
-	  then ml_obj_file location
-	  else "interpreted")
-    ++ " )"
- where mod_str = moduleUserString mod
 \end{code}
 
 For a module in another package, the hs_file and obj_file
@@ -103,6 +81,23 @@ correspond to actual files yet: for example, even if the object
 file doesn't exist, the ModLocation still contains the path to
 where the object file will reside if/when it is created.
 
+\begin{code}
+addBootSuffix :: FilePath -> FilePath
+-- Add the "-boot" suffix to .hs, .hi and .o files
+addBootSuffix path = path ++ "-boot"
+
+addBootSuffix_maybe :: Bool -> FilePath -> FilePath
+addBootSuffix_maybe is_boot path
+ | is_boot   = addBootSuffix path
+ | otherwise = path
+
+addBootSuffixLocn :: ModLocation -> ModLocation
+addBootSuffixLocn locn
+  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
+	 , ml_hi_file  = addBootSuffix (ml_hi_file locn)
+	 , ml_obj_file = addBootSuffix (ml_obj_file locn) }
+\end{code}
+
 
 %************************************************************************
 %*									*
@@ -111,7 +106,7 @@ where the object file will reside if/when it is created.
 %************************************************************************
 
 \begin{code}
-newtype Module = Module EncodedFS
+newtype Module = Module FastString
 	-- Haskell module names can include the quote character ',
 	-- so the module names have the z-encoding applied to them
 
@@ -134,30 +129,26 @@ instance Ord Module where
 instance Outputable Module where
   ppr = pprModule
 
-
 pprModule :: Module -> SDoc
-pprModule (Module nm) = pprEncodedFS nm
+pprModule (Module nm) = 
+    getPprStyle $ \ sty ->
+    if codeStyle sty 
+	then ftext (zEncodeFS nm)
+	else ftext nm
 
-moduleFS :: Module -> EncodedFS
+moduleFS :: Module -> FastString
 moduleFS (Module mod) = mod
 
-moduleString :: Module -> EncodedString
+moduleString :: Module -> String
 moduleString (Module mod) = unpackFS mod
 
-moduleUserString :: Module -> UserString
-moduleUserString (Module mod) = decode (unpackFS mod)
-
 -- used to be called mkSrcModule
-mkModule :: UserString -> Module
-mkModule s = Module (mkFastString (encode s))
+mkModule :: String -> Module
+mkModule s = Module (mkFastString s)
 
 -- used to be called mkSrcModuleFS
-mkModuleFS :: UserFS -> Module
-mkModuleFS s = Module (encodeFS s)
-
--- used to be called mkSysModuleFS
-mkSysModuleFS :: EncodedFS -> Module
-mkSysModuleFS s = Module s 
+mkModuleFS :: FastString -> Module
+mkModuleFS s = Module s
 \end{code}
 
 %************************************************************************
@@ -188,7 +179,9 @@ lookupModuleEnv      :: ModuleEnv a -> Module     -> Maybe a
 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
 elemModuleEnv        :: Module -> ModuleEnv a -> Bool
 foldModuleEnv        :: (a -> b -> b) -> b -> ModuleEnv a -> b
+filterModuleEnv      :: (a -> Bool) -> ModuleEnv a -> ModuleEnv a
 
+filterModuleEnv	    = filterUFM
 elemModuleEnv       = elemUFM
 extendModuleEnv     = addToUFM
 extendModuleEnv_C   = addToUFM_C