, mkVanillaModule -- :: ModuleName -> Module
, mkThisModule -- :: ModuleName -> Module
, mkPrelModule -- :: UserString -> Module
-
+
, isDynamicModule -- :: Module -> Bool
- , isLibModule
+ , isPrelModule
, mkSrcModule
, DllFlavour, dll, notDll
-- ModFlavour
- , ModFlavour, libMod, userMod
+ , ModFlavour,
-- Where to find a .hi file
, WhereFrom(..), SearchPath, mkSearchPath
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 )
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}
-data ModFlavour = LibMod -- A library-ish module
+data ModFlavour = PrelMod -- A Prelude module
| UserMod -- Not library-ish
-
-libMod = LibMod
-userMod = UserMod
\end{code}
-- Haskell module names can include the quote character ',
-- so the module names have the z-encoding applied to them
+isPrelModuleName :: ModuleName -> Bool
+ -- True for names of prelude modules
+isPrelModuleName m = take 4 (_UNPK_ m) == "Prel"
pprModuleName :: ModuleName -> SDoc
pprModuleName nm = pprEncodedFS nm
\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}
-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 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 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
- | otherwise = LibMod
+ | otherwise = PrelMod
dll | opt_Static || opt_CompilingPrelude = NotDll
| otherwise = Dll
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}
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
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
[] -> []
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 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}
projects / ghc-hetmet.git / blobdiff