[project @ 2004-11-26 16:19:45 by simonmar]
authorsimonmar <unknown>
Fri, 26 Nov 2004 16:22:13 +0000 (16:22 +0000)
committersimonmar <unknown>
Fri, 26 Nov 2004 16:22:13 +0000 (16:22 +0000)
Further integration with the new package story.  GHC now supports
pretty much everything in the package proposal.

  - GHC now works in terms of PackageIds (<pkg>-<version>) rather than
    just package names.  You can still specify package names without
    versions on the command line, as long as the name is unambiguous.

  - GHC understands hidden/exposed modules in a package, and will refuse
    to import a hidden module.  Also, the hidden/eposed status of packages
    is taken into account.

  - I had to remove the old package syntax from ghc-pkg, backwards
    compatibility isn't really practical.

  - All the package.conf.in files have been rewritten in the new syntax,
    and contain a complete list of modules in the package.  I've set all
    the versions to 1.0 for now - please check your package(s) and fix the
    version number & other info appropriately.

  - New options:

-hide-package P    sets the expose flag on package P to False
-ignore-package P  unregisters P for this compilation

For comparison, -package P sets the expose flag on package P
        to True, and also causes P to be linked in eagerly.

        -package-name is no longer officially supported.  Unofficially, it's
a synonym for -ignore-package, which has more or less the same effect
as -package-name used to.

Note that a package may be hidden and yet still be linked into
the program, by virtue of being a dependency of some other package.
To completely remove a package from the compiler's internal database,
        use -ignore-package.

The compiler will complain if any two packages in the
        transitive closure of exposed packages contain the same
        module.

You *must* use -ignore-package P when compiling modules for
        package P, if package P (or an older version of P) is already
        registered.  The compiler will helpfully complain if you don't.
The fptools build system does this.

   - Note: the Cabal library won't work yet.  It still thinks GHC uses
     the old package config syntax.

Internal changes/cleanups:

   - The ModuleName type has gone away.  Modules are now just (a
     newtype of) FastStrings, and don't contain any package information.
     All the package-related knowledge is in DynFlags, which is passed
     down to where it is needed.

   - DynFlags manipulation has been cleaned up somewhat: there are no
     global variables holding DynFlags any more, instead the DynFlags
     are passed around properly.

   - There are a few less global variables in GHC.  Lots more are
     scheduled for removal.

   - -i is now a dynamic flag, as are all the package-related flags (but
     using them in {-# OPTIONS #-} is Officially Not Recommended).

   - make -j now appears to work under fptools/libraries/.  Probably
     wouldn't take much to get it working for a whole build.

77 files changed:
ghc/compiler/Makefile
ghc/compiler/basicTypes/Module.hi-boot-5
ghc/compiler/basicTypes/Module.hi-boot-6
ghc/compiler/basicTypes/Module.lhs
ghc/compiler/basicTypes/Name.lhs
ghc/compiler/basicTypes/RdrName.lhs
ghc/compiler/cmm/CLabel.hs
ghc/compiler/cmm/CmmParse.y
ghc/compiler/codeGen/CgBindery.lhs
ghc/compiler/codeGen/CgCase.lhs
ghc/compiler/codeGen/CgClosure.lhs
ghc/compiler/codeGen/CgCon.lhs
ghc/compiler/codeGen/CgExpr.lhs
ghc/compiler/codeGen/CgHeapery.lhs
ghc/compiler/codeGen/CgMonad.lhs
ghc/compiler/codeGen/CgProf.hs
ghc/compiler/codeGen/CgTailCall.lhs
ghc/compiler/codeGen/CgUtils.hs
ghc/compiler/codeGen/ClosureInfo.lhs
ghc/compiler/codeGen/CodeGen.lhs
ghc/compiler/compMan/CompManager.lhs
ghc/compiler/coreSyn/CoreUtils.lhs
ghc/compiler/coreSyn/MkExternalCore.lhs
ghc/compiler/deSugar/Desugar.lhs
ghc/compiler/deSugar/DsMeta.hs
ghc/compiler/ghci/InteractiveUI.hs
ghc/compiler/ghci/Linker.lhs
ghc/compiler/hsSyn/Convert.lhs
ghc/compiler/hsSyn/HsImpExp.lhs
ghc/compiler/iface/BinIface.hs
ghc/compiler/iface/IfaceEnv.lhs
ghc/compiler/iface/IfaceSyn.lhs
ghc/compiler/iface/IfaceType.lhs
ghc/compiler/iface/LoadIface.lhs
ghc/compiler/iface/MkIface.lhs
ghc/compiler/iface/TcIface.lhs
ghc/compiler/main/CmdLineOpts.lhs
ghc/compiler/main/CodeOutput.lhs
ghc/compiler/main/DriverFlags.hs
ghc/compiler/main/DriverMkDepend.hs
ghc/compiler/main/DriverPipeline.hs
ghc/compiler/main/DriverState.hs
ghc/compiler/main/Finder.lhs
ghc/compiler/main/GetImports.hs
ghc/compiler/main/HscTypes.lhs
ghc/compiler/main/Main.hs
ghc/compiler/main/Packages.lhs
ghc/compiler/main/ParsePkgConf.y
ghc/compiler/main/SysTools.lhs
ghc/compiler/main/TidyPgm.lhs
ghc/compiler/parser/Parser.y.pp
ghc/compiler/parser/ParserCore.y
ghc/compiler/parser/RdrHsSyn.lhs
ghc/compiler/prelude/PrelNames.lhs
ghc/compiler/profiling/CostCentre.lhs
ghc/compiler/profiling/SCCfinal.lhs
ghc/compiler/rename/RnEnv.lhs
ghc/compiler/rename/RnNames.lhs
ghc/compiler/simplCore/SimplCore.lhs
ghc/compiler/simplStg/SimplStg.lhs
ghc/compiler/stgSyn/CoreToStg.lhs
ghc/compiler/stgSyn/StgSyn.lhs
ghc/compiler/typecheck/Inst.lhs
ghc/compiler/typecheck/TcGenDeriv.lhs
ghc/compiler/typecheck/TcRnDriver.lhs
ghc/compiler/typecheck/TcRnMonad.lhs
ghc/compiler/typecheck/TcRnTypes.lhs
ghc/compiler/typecheck/TcSplice.lhs
ghc/compiler/types/Generics.lhs
ghc/compiler/utils/Outputable.lhs
ghc/configure.ac
ghc/lib/compat/Makefile
ghc/rts/package.conf.in
ghc/utils/ghc-pkg/Main.hs
ghc/utils/ghc-pkg/Package.hs [deleted file]
ghc/utils/ghc-pkg/ParsePkgConfLite.y [deleted file]
mk/package.mk

index 1a61d1f..f709768 100644 (file)
@@ -522,6 +522,7 @@ endif
 # from mkDependHS.
 SRC_MKDEPENDHS_OPTS += \
        -optdep--exclude-module=Compat.RawSystem \
+       -optdep--exclude-module=Compat.Directory \
        -optdep--exclude-module=Data.Version \
        -optdep--exclude-module=Distribution.Package \
        -optdep--exclude-module=Distribution.InstalledPackageInfo \
index ebde9b7..cdc5fbf 100644 (file)
@@ -1,4 +1,4 @@
 __interface Module 1 0 where
-__export Module ModuleName ;
-1 data ModuleName ;
+__export Module Module ;
+1 data Module ;
 
index ea4de1e..8d48884 100644 (file)
@@ -1,72 +1,29 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-2002
+% (c) The University of Glasgow, 2004
 %
 
-ModuleName
+Module
 ~~~~~~~~~~
 Simply the name of a module, represented as a Z-encoded FastString.
 These are Uniquable, hence we can build FiniteMaps with ModuleNames as
 the keys.
 
-Module
-~~~~~~
-
-A ModuleName with some additional information, namely whether the
-module resides in the Home package or in a different package.  We need
-to know this for two reasons: 
-  
-  * generating cross-DLL calls is different from intra-DLL calls 
-    (see below).
-  * we don't record version information in interface files for entities
-    in a different package.
-
-The unique of a Module is identical to the unique of a ModuleName, so
-it is safe to look up in a Module map using a ModuleName and vice
-versa.
-
-Notes on DLLs
-~~~~~~~~~~~~~
-When compiling module A, which imports module B, we need to 
-know whether B will be in the same DLL as A.  
-       If it's in the same DLL, we refer to B_f_closure
-       If it isn't, we refer to _imp__B_f_closure
-When compiling A, we record in B's Module value whether it's
-in a different DLL, by setting the DLL flag.
-
-
-
-
 \begin{code}
 module Module 
     (
       Module,                  -- Abstract, instance of Eq, Ord, Outputable
+    , pprModule                        -- :: ModuleName -> SDoc
 
     , ModLocation(..),
     , showModMsg
 
-    , ModuleName
-    , pprModuleName            -- :: ModuleName -> SDoc
-    , printModulePrefix
+    , moduleString             -- :: ModuleName -> EncodedString
+    , moduleUserString         -- :: ModuleName -> UserString
+    , moduleFS                 -- :: ModuleName -> EncodedFS
 
-    , moduleName               -- :: Module -> ModuleName 
-    , moduleNameString         -- :: ModuleName -> EncodedString
-    , moduleNameUserString     -- :: ModuleName -> UserString
-    , moduleNameFS             -- :: ModuleName -> EncodedFS
-
-    , moduleString             -- :: Module -> EncodedString
-    , moduleUserString         -- :: Module -> UserString
-
-    , mkModule
-    , mkBasePkgModule          -- :: UserString -> Module
-    , mkHomeModule             -- :: ModuleName -> Module
-    , isHomeModule             -- :: Module -> Bool
-    , mkPackageModule          -- :: ModuleName -> Module
-
-    , mkModuleName             -- :: UserString -> ModuleName
-    , mkModuleNameFS           -- :: UserFS    -> ModuleName
-    , mkSysModuleNameFS                -- :: EncodedFS -> ModuleName
-
-    , pprModule,
+    , mkModule                 -- :: UserString -> ModuleName
+    , mkModuleFS               -- :: UserFS    -> ModuleName
+    , mkSysModuleFS            -- :: EncodedFS -> ModuleName
  
     , ModuleEnv,
     , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C
@@ -74,7 +31,6 @@ module Module
     , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
     , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv
     , extendModuleEnv_C
-    , lookupModuleEnvByName, extendModuleEnvByName, unitModuleEnvByName
 
     , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
 
@@ -83,8 +39,6 @@ module Module
 #include "HsVersions.h"
 import OccName
 import Outputable
-import Packages                ( PackageName, basePackage )
-import CmdLineOpts     ( opt_InPackage )
 import Unique          ( Uniquable(..) )
 import Maybes          ( expectJust )
 import UniqFM
@@ -93,44 +47,6 @@ import Binary
 import FastString
 \end{code}
 
-
-%************************************************************************
-%*                                                                     *
-\subsection{Interface file flavour}
-%*                                                                     *
-%************************************************************************
-
-A further twist to the tale is the support for dynamically linked
-libraries under Win32. Here, dealing with the use of global variables
-that's residing in a DLL requires special handling at the point of use
-(there's an extra level of indirection, i.e., (**v) to get at v's
-value, rather than just (*v) .) When slurping in an interface file we
-then record whether it's coming from a .hi corresponding to a module
-that's packaged up in a DLL or not, so that we later can emit the
-appropriate code.
-
-The logic for how an interface file is marked as corresponding to a
-module that's hiding in a DLL is explained elsewhere (ToDo: give
-renamer href here.)
-
-\begin{code}
-data Module = Module ModuleName !PackageInfo
-
-data PackageInfo
-  = ThisPackage                                -- A module from the same package 
-                                       -- as the one being compiled
-  | AnotherPackage                     -- A module from a different package
-
-packageInfoPackage :: PackageInfo -> PackageName
-packageInfoPackage ThisPackage        = opt_InPackage
-packageInfoPackage AnotherPackage     = FSLIT("<pkg>")
-
-instance Outputable PackageInfo where
-       -- Just used in debug prints of lex tokens and in debug modde
-   ppr pkg_info = ppr (packageInfoPackage pkg_info)
-\end{code}
-
-
 %************************************************************************
 %*                                                                     *
 \subsection{Module locations}
@@ -187,124 +103,54 @@ where the object file will reside if/when it is created.
 %************************************************************************
 
 \begin{code}
-newtype ModuleName = ModuleName EncodedFS
+newtype Module = Module EncodedFS
        -- Haskell module names can include the quote character ',
        -- so the module names have the z-encoding applied to them
 
-instance Binary ModuleName where
-   put_ bh (ModuleName m) = put_ bh m
-   get bh = do m <- get bh; return (ModuleName m)
+instance Binary Module where
+   put_ bh (Module m) = put_ bh m
+   get bh = do m <- get bh; return (Module m)
 
-instance Uniquable ModuleName where
-  getUnique (ModuleName nm) = getUnique nm
+instance Uniquable Module where
+  getUnique (Module nm) = getUnique nm
 
-instance Eq ModuleName where
+instance Eq Module where
   nm1 == nm2 = getUnique nm1 == getUnique nm2
 
 -- Warning: gives an ordering relation based on the uniques of the
 -- FastStrings which are the (encoded) module names.  This is _not_
 -- a lexicographical ordering.
-instance Ord ModuleName where
+instance Ord Module where
   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 
-instance Outputable ModuleName where
-  ppr = pprModuleName
-
-
-pprModuleName :: ModuleName -> SDoc
-pprModuleName (ModuleName nm) = pprEncodedFS nm
-
-moduleNameFS :: ModuleName -> EncodedFS
-moduleNameFS (ModuleName mod) = mod
-
-moduleNameString :: ModuleName -> EncodedString
-moduleNameString (ModuleName mod) = unpackFS mod
-
-moduleNameUserString :: ModuleName -> UserString
-moduleNameUserString (ModuleName mod) = decode (unpackFS mod)
-
--- used to be called mkSrcModule
-mkModuleName :: UserString -> ModuleName
-mkModuleName s = ModuleName (mkFastString (encode s))
-
--- used to be called mkSrcModuleFS
-mkModuleNameFS :: UserFS -> ModuleName
-mkModuleNameFS s = ModuleName (encodeFS s)
-
--- used to be called mkSysModuleFS
-mkSysModuleNameFS :: EncodedFS -> ModuleName
-mkSysModuleNameFS s = ModuleName s 
-\end{code}
-
-\begin{code}
 instance Outputable Module where
   ppr = pprModule
 
-instance Uniquable Module where
-  getUnique (Module nm _) = getUnique nm
-
--- Same if they have the same name.
-instance Eq Module where
-  m1 == m2 = getUnique m1 == getUnique m2
-
--- Warning: gives an ordering relation based on the uniques of the
--- FastStrings which are the (encoded) module names.  This is _not_
--- a lexicographical ordering.
-instance Ord Module where
-  m1 `compare` m2 = getUnique m1 `compare` getUnique m2
-\end{code}
-
 
-\begin{code}
 pprModule :: Module -> SDoc
-pprModule (Module mod p) = getPprStyle $ \ sty ->
-                          if debugStyle sty then
-                               -- Print the package too
-                               -- Don't use '.' because it gets confused
-                               --      with module names
-                               brackets (ppr p) <> pprModuleName mod
-                          else
-                               pprModuleName mod
-\end{code}
-
-
-\begin{code}
-mkModule :: PackageName -> ModuleName -> Module
-mkModule pkg_name mod_name 
-  = Module mod_name pkg_info
-  where
-    pkg_info
-      | opt_InPackage == pkg_name = ThisPackage
-      | otherwise                = AnotherPackage
-
-mkBasePkgModule :: ModuleName -> Module
-mkBasePkgModule mod_nm = mkModule basePackage mod_nm
-
-mkHomeModule :: ModuleName -> Module
-mkHomeModule mod_nm = Module mod_nm ThisPackage
-
-isHomeModule :: Module -> Bool
-isHomeModule (Module nm ThisPackage) = True
-isHomeModule _                       = False
+pprModule (Module nm) = pprEncodedFS nm
 
-mkPackageModule :: ModuleName -> Module
-mkPackageModule mod_nm = Module mod_nm AnotherPackage
+moduleFS :: Module -> EncodedFS
+moduleFS (Module mod) = mod
 
 moduleString :: Module -> EncodedString
-moduleString (Module (ModuleName fs) _) = unpackFS fs
-
-moduleName :: Module -> ModuleName
-moduleName (Module mod pkg_info) = mod
+moduleString (Module mod) = unpackFS mod
 
 moduleUserString :: Module -> UserString
-moduleUserString (Module mod _) = moduleNameUserString mod
+moduleUserString (Module mod) = decode (unpackFS mod)
 
-printModulePrefix :: Module -> Bool
-  -- When printing, say M.x
-printModulePrefix (Module nm ThisPackage) = False
-printModulePrefix _                       = True
-\end{code}
+-- used to be called mkSrcModule
+mkModule :: UserString -> Module
+mkModule s = Module (mkFastString (encode 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 
+\end{code}
 
 %************************************************************************
 %*                                                                      *
@@ -314,9 +160,6 @@ printModulePrefix _                       = True
 
 \begin{code}
 type ModuleEnv elt = UniqFM elt
--- A ModuleName and Module have the same Unique,
--- so both will work as keys.  
--- The 'ByName' variants work on ModuleNames
 
 emptyModuleEnv       :: ModuleEnv a
 mkModuleEnv          :: [(Module, a)] -> ModuleEnv a
@@ -338,14 +181,8 @@ lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
 elemModuleEnv        :: Module -> ModuleEnv a -> Bool
 foldModuleEnv        :: (a -> b -> b) -> b -> ModuleEnv a -> b
 
--- The ByName variants
-lookupModuleEnvByName :: ModuleEnv a -> ModuleName -> Maybe a
-unitModuleEnvByName   :: ModuleName -> a -> ModuleEnv a
-extendModuleEnvByName :: ModuleEnv a -> ModuleName -> a -> ModuleEnv a
-
 elemModuleEnv       = elemUFM
 extendModuleEnv     = addToUFM
-extendModuleEnvByName = addToUFM
 extendModuleEnv_C   = addToUFM_C
 extendModuleEnvList = addListToUFM
 plusModuleEnv_C     = plusUFM_C
@@ -353,20 +190,17 @@ delModuleEnvList    = delListFromUFM
 delModuleEnv        = delFromUFM
 plusModuleEnv       = plusUFM
 lookupModuleEnv     = lookupUFM
-lookupModuleEnvByName = lookupUFM
 lookupWithDefaultModuleEnv = lookupWithDefaultUFM
 mapModuleEnv        = mapUFM
 mkModuleEnv         = listToUFM
 emptyModuleEnv      = emptyUFM
 moduleEnvElts       = eltsUFM
 unitModuleEnv       = unitUFM
-unitModuleEnvByName = unitUFM
 isEmptyModuleEnv    = isNullUFM
 foldModuleEnv       = foldUFM
 \end{code}
 
 \begin{code}
-
 type ModuleSet = UniqSet Module
 mkModuleSet    :: [Module] -> ModuleSet
 extendModuleSet :: ModuleSet -> Module -> ModuleSet
index c440369..f0ef363 100644 (file)
@@ -17,16 +17,16 @@ module Name (
        mkExternalName, mkWiredInName,
 
        nameUnique, setNameUnique,
-       nameOccName, nameModule, nameModule_maybe, nameModuleName,
+       nameOccName, nameModule, nameModule_maybe,
        setNameOcc, 
        hashName, localiseName,
 
        nameSrcLoc, nameParent, nameParent_maybe,
 
        isSystemName, isInternalName, isExternalName,
-       isTyVarName, isDllName, isWiredInName, isBuiltInSyntax,
+       isTyVarName, isWiredInName, isBuiltInSyntax,
        wiredInNameTyThing_maybe, 
-       nameIsLocalOrFrom, isHomePackageName,
+       nameIsLocalOrFrom,
        
        -- Class NamedThing and overloaded friends
        NamedThing(..),
@@ -38,8 +38,7 @@ module Name (
 import {-# SOURCE #-} TypeRep( TyThing )
 
 import OccName         -- All of it
-import Module          ( Module, ModuleName, moduleName, isHomeModule )
-import CmdLineOpts     ( opt_Static )
+import Module          ( Module )
 import SrcLoc          ( noSrcLoc, wiredInSrcLoc, SrcLoc )
 import Unique          ( Unique, Uniquable(..), getKey, pprUnique )
 import Maybes          ( orElse )
@@ -120,7 +119,6 @@ All built-in syntax is for wired-in things.
 nameUnique             :: Name -> Unique
 nameOccName            :: Name -> OccName 
 nameModule             :: Name -> Module
-nameModuleName         :: Name -> ModuleName
 nameSrcLoc             :: Name -> SrcLoc
 
 nameUnique  name = n_uniq name
@@ -133,7 +131,6 @@ nameIsLocalOrFrom :: Module -> Name -> Bool
 isInternalName   :: Name -> Bool
 isExternalName   :: Name -> Bool
 isSystemName     :: Name -> Bool
-isHomePackageName :: Name -> Bool
 isWiredInName    :: Name -> Bool
 
 isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
@@ -163,8 +160,6 @@ nameParent name = case nameParent_maybe name of
                        Nothing     -> name
 
 nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
-nameModuleName name = moduleName (nameModule name)
-
 nameModule_maybe (Name { n_sort = External mod _})    = Just mod
 nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
 nameModule_maybe name                                = Nothing
@@ -173,13 +168,6 @@ nameIsLocalOrFrom from name
   | isExternalName name = from == nameModule name
   | otherwise          = True
 
-isHomePackageName name
-  | isExternalName name = isHomeModule (nameModule name)
-  | otherwise          = True          -- Internal and system names
-
-isDllName :: Name -> Bool      -- Does this name refer to something in a different DLL?
-isDllName nm = not opt_Static && not (isHomePackageName nm)
-
 isTyVarName :: Name -> Bool
 isTyVarName name = isTvOcc (nameOccName name)
 
@@ -326,20 +314,18 @@ pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
       Internal               -> pprInternal sty uniq occ
 
 pprExternal sty uniq mod occ is_wired is_builtin
-  | codeStyle sty        = ppr mod_name <> char '_' <> ppr_occ_name occ
+  | codeStyle sty        = ppr mod <> char '_' <> ppr_occ_name occ
        -- In code style, always qualify
        -- ToDo: maybe we could print all wired-in things unqualified
        --       in code style, to reduce symbol table bloat?
-  | debugStyle sty       = ppr mod_name <> dot <> ppr_occ_name occ
+  | debugStyle sty       = ppr mod <> dot <> ppr_occ_name occ
                           <> braces (hsep [if is_wired then ptext SLIT("(w)") else empty,
                                            text (briefOccNameFlavour occ), 
                                            pprUnique uniq])
   | BuiltInSyntax <- is_builtin  = ppr_occ_name occ
        -- never qualify builtin syntax
-  | unqualStyle sty mod_name occ = ppr_occ_name occ
-  | otherwise                   = ppr mod_name <> dot <> ppr_occ_name occ
-  where
-    mod_name = moduleName mod
+  | unqualStyle sty mod occ = ppr_occ_name occ
+  | otherwise              = ppr mod <> dot <> ppr_occ_name occ
 
 pprInternal sty uniq occ
   | codeStyle sty  = pprUnique uniq
index a4e34d4..c4d71ca 100644 (file)
@@ -47,8 +47,8 @@ import OccName        ( NameSpace, varName,
                  elemOccEnv, plusOccEnv_C, extendOccEnv_C, foldOccEnv,
                  occEnvElts
                )
-import Module   ( ModuleName, mkModuleNameFS   )
-import Name    ( Name, NamedThing(getName), nameModuleName, nameParent_maybe,
+import Module   ( Module, mkModuleFS )
+import Name    ( Name, NamedThing(getName), nameModule, nameParent_maybe,
                  nameOccName, isExternalName, nameSrcLoc )
 import SrcLoc  ( isGoodSrcLoc, SrcSpan )
 import Outputable
@@ -67,13 +67,13 @@ data RdrName
   = Unqual OccName
        -- Used for ordinary, unqualified occurrences 
 
-  | Qual ModuleName OccName
+  | Qual Module OccName
        -- A qualified name written by the user in 
        -- *source* code.  The module isn't necessarily 
        -- the module where the thing is defined; 
        -- just the one from which it is imported
 
-  | Orig ModuleName OccName
+  | Orig Module OccName
        -- An original name; the module is the *defining* module.
        -- This is used when GHC generates code that will be fed
        -- into the renamer (e.g. from deriving clauses), but where
@@ -97,10 +97,10 @@ data RdrName
 %************************************************************************
 
 \begin{code}
-rdrNameModule :: RdrName -> ModuleName
+rdrNameModule :: RdrName -> Module
 rdrNameModule (Qual m _) = m
 rdrNameModule (Orig m _) = m
-rdrNameModule (Exact n)  = nameModuleName n
+rdrNameModule (Exact n)  = nameModule n
 rdrNameModule (Unqual n) = pprPanic "rdrNameModule" (ppr n)
 
 rdrNameOcc :: RdrName -> OccName
@@ -121,7 +121,7 @@ setRdrNameSpace :: RdrName -> NameSpace -> RdrName
 setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
-setRdrNameSpace (Exact n)    ns = Orig (nameModuleName n)
+setRdrNameSpace (Exact n)    ns = Orig (nameModule n)
                                       (setOccNameSpace ns (nameOccName n))
 \end{code}
 
@@ -130,16 +130,16 @@ setRdrNameSpace (Exact n)    ns = Orig (nameModuleName n)
 mkRdrUnqual :: OccName -> RdrName
 mkRdrUnqual occ = Unqual occ
 
-mkRdrQual :: ModuleName -> OccName -> RdrName
+mkRdrQual :: Module -> OccName -> RdrName
 mkRdrQual mod occ = Qual mod occ
 
-mkOrig :: ModuleName -> OccName -> RdrName
+mkOrig :: Module -> OccName -> RdrName
 mkOrig mod occ = Orig mod occ
 
 ---------------
 mkDerivedRdrName :: Name -> (OccName -> OccName) -> (RdrName)
 mkDerivedRdrName parent mk_occ
-  = mkOrig (nameModuleName parent) (mk_occ (nameOccName parent))
+  = mkOrig (nameModule parent) (mk_occ (nameOccName parent))
 
 ---------------
        -- These two are used when parsing source files
@@ -151,7 +151,7 @@ mkVarUnqual :: UserFS -> RdrName
 mkVarUnqual n = Unqual (mkOccFS varName n)
 
 mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
-mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccFS sp n)
+mkQual sp (m, n) = Qual (mkModuleFS m) (mkOccFS sp n)
 
 getRdrName :: NamedThing thing => thing -> RdrName
 getRdrName name = nameRdrName (getName name)
@@ -164,7 +164,7 @@ nameRdrName name = Exact name
 
 nukeExact :: Name -> RdrName
 nukeExact n 
-  | isExternalName n = Orig (nameModuleName n) (nameOccName n)
+  | isExternalName n = Orig (nameModule n) (nameOccName n)
   | otherwise       = Unqual (nameOccName n)
 \end{code}
 
@@ -368,7 +368,7 @@ unQualOK :: GlobalRdrElt -> Bool
 unQualOK (GRE {gre_prov = LocalDef _})    = True
 unQualOK (GRE {gre_prov = Imported is _}) = not (all is_qual is)
 
-hasQual :: ModuleName -> GlobalRdrElt -> Bool
+hasQual :: Module -> GlobalRdrElt -> Bool
 -- A qualified version of this thing is in scope
 hasQual mod (GRE {gre_prov = LocalDef m})    = m == mod
 hasQual mod (GRE {gre_prov = Imported is _}) = any ((== mod) . is_as) is
@@ -411,7 +411,7 @@ The "provenance" of something says how it came to be in scope.
 \begin{code}
 data Provenance
   = LocalDef           -- Defined locally
-       ModuleName
+       Module
 
   | Imported           -- Imported
        [ImportSpec]    -- INVARIANT: non-empty
@@ -429,10 +429,10 @@ data ImportSpec           -- Describes a particular import declaration
                        -- Shared among all the Provenaces for a particular
                        -- import declaration
   = ImportSpec {
-       is_mod  :: ModuleName,          -- 'import Muggle'
+       is_mod  :: Module,              -- 'import Muggle'
                                        -- Note the Muggle may well not be 
                                        -- the defining module for this thing!
-       is_as   :: ModuleName,          -- 'as M' (or 'Muggle' if there is no 'as' clause)
+       is_as   :: Module,              -- 'as M' (or 'Muggle' if there is no 'as' clause)
        is_qual :: Bool,                -- True <=> qualified (only)
        is_loc  :: SrcSpan }            -- Location of import statment
 
index f50d406..a18755f 100644 (file)
@@ -22,6 +22,16 @@ module CLabel (
        mkStaticInfoTableLabel,
        mkApEntryLabel,
        mkApInfoTableLabel,
+       mkClosureTableLabel,
+
+       mkLocalClosureLabel,
+       mkLocalInfoTableLabel,
+       mkLocalEntryLabel,
+       mkLocalConEntryLabel,
+       mkLocalStaticConEntryLabel,
+       mkLocalConInfoTableLabel,
+       mkLocalStaticInfoTableLabel,
+       mkLocalClosureTableLabel,
 
        mkReturnPtLabel,
        mkReturnInfoLabel,
@@ -30,8 +40,6 @@ module CLabel (
        mkBitmapLabel,
        mkStringLitLabel,
 
-       mkClosureTblLabel,
-
        mkAsmTempLabel,
 
        mkModuleInitLabel,
@@ -91,11 +99,11 @@ module CLabel (
 #include "HsVersions.h"
 #include "../includes/ghcconfig.h"
 
-import CmdLineOpts      ( opt_Static, opt_DoTickyProfiling )
+import CmdLineOpts      ( DynFlags, opt_Static, opt_DoTickyProfiling )
+import Packages                ( isHomeModule )
 import DataCon         ( ConTag )
-import Module          ( moduleName, moduleNameFS, 
-                         Module, isHomeModule )
-import Name            ( Name, isDllName, isExternalName )
+import Module          ( moduleFS, Module )
+import Name            ( Name, isExternalName, nameModule )
 import Unique          ( pprUnique, Unique )
 import PrimOp          ( PrimOp )
 import Config          ( cLeadingUnderscore )
@@ -133,6 +141,10 @@ data CLabel
        Name                    -- definition of a particular Id or Con
        IdLabelInfo
 
+  | DynIdLabel                 -- like IdLabel, but in a separate package,
+       Name                    -- and might therefore need a dynamic
+       IdLabelInfo             -- reference.
+
   | CaseLabel                  -- A family of labels related to a particular
                                -- case expression.
        {-# UNPACK #-} !Unique  -- Unique says which case expression
@@ -147,13 +159,16 @@ data CLabel
   | ModuleInitLabel 
        Module                  -- the module name
        String                  -- its "way"
+       Bool                    -- True <=> is in a different package
        -- at some point we might want some kind of version number in
        -- the module init label, to guard against compiling modules in
        -- the wrong order.  We can't use the interface file version however,
        -- because we don't always recompile modules which depend on a module
        -- whose version has changed.
 
-  | PlainModuleInitLabel Module         -- without the vesrion & way info
+  | PlainModuleInitLabel       -- without the vesrion & way info
+       Module
+       Bool                    -- True <=> is in a different package
 
   | ModuleRegdLabel
 
@@ -187,7 +202,7 @@ data IdLabelInfo
   = Closure            -- Label for closure
   | SRT                 -- Static reference table
   | SRTDesc             -- Static reference table descriptor
-  | InfoTbl            -- Info tables for closures; always read-only
+  | InfoTable          -- Info tables for closures; always read-only
   | Entry              -- entry point
   | Slow               -- slow entry point
 
@@ -197,9 +212,9 @@ data IdLabelInfo
   | Bitmap             -- A bitmap (function or case return)
 
   | ConEntry           -- constructor entry point
-  | ConInfoTbl                 -- corresponding info table
+  | ConInfoTable               -- corresponding info table
   | StaticConEntry     -- static constructor entry point
-  | StaticInfoTbl      -- corresponding info table
+  | StaticInfoTable    -- corresponding info table
 
   | ClosureTable       -- table of closures for Enum tycons
 
@@ -215,10 +230,10 @@ data CaseLabelInfo
 
 
 data RtsLabelInfo
-  = RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-} -- Selector thunks
+  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}       -- Selector thunks
   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
 
-  | RtsApInfoTbl Bool{-updatable-} Int{-arity-}                -- AP thunks
+  | RtsApInfoTable Bool{-updatable-} Int{-arity-}              -- AP thunks
   | RtsApEntry   Bool{-updatable-} Int{-arity-}
 
   | RtsPrimOp PrimOp
@@ -254,21 +269,60 @@ data DynamicLinkerLabelInfo
 -- -----------------------------------------------------------------------------
 -- Constructing CLabels
 
-mkClosureLabel         id      = IdLabel id  Closure
-mkSRTLabel             id      = IdLabel id  SRT
-mkSRTDescLabel         id      = IdLabel id  SRTDesc
-mkInfoTableLabel       id      = IdLabel id  InfoTbl
-mkEntryLabel           id      = IdLabel id  Entry
-mkSlowEntryLabel       id      = IdLabel id  Slow
-mkBitmapLabel          id      = IdLabel id  Bitmap
-mkRednCountsLabel      id      = IdLabel id  RednCounts
+-- These are always local:
+mkSRTLabel             name    = IdLabel name  SRT
+mkSRTDescLabel         name    = IdLabel name  SRTDesc
+mkSlowEntryLabel       name    = IdLabel name  Slow
+mkBitmapLabel          name    = IdLabel name  Bitmap
+mkRednCountsLabel      name    = IdLabel name  RednCounts
+
+-- These have local & (possibly) external variants:
+mkLocalClosureLabel    name    = IdLabel name  Closure
+mkLocalInfoTableLabel          name    = IdLabel name  InfoTable
+mkLocalEntryLabel      name    = IdLabel name  Entry
+mkLocalClosureTableLabel name  = IdLabel name ClosureTable
+
+mkClosureLabel dflags name
+  | opt_Static || isHomeModule dflags mod = IdLabel    name Closure
+  | otherwise                            = DynIdLabel name Closure
+  where mod = nameModule name
+
+mkInfoTableLabel dflags name
+  | opt_Static || isHomeModule dflags mod = IdLabel    name InfoTable
+  | otherwise                            = DynIdLabel name InfoTable
+  where mod = nameModule name
+
+mkEntryLabel dflags name
+  | opt_Static || isHomeModule dflags mod = IdLabel    name Entry
+  | otherwise                            = DynIdLabel name Entry
+  where mod = nameModule name
+
+mkClosureTableLabel dflags name
+  | opt_Static || isHomeModule dflags mod = IdLabel    name ClosureTable
+  | otherwise                            = DynIdLabel name ClosureTable
+  where mod = nameModule name
+
+mkLocalConInfoTableLabel     con = IdLabel con ConInfoTable
+mkLocalConEntryLabel        con = IdLabel con ConEntry
+mkLocalStaticInfoTableLabel  con = IdLabel con StaticInfoTable
+mkLocalStaticConEntryLabel   con = IdLabel con StaticConEntry
+
+mkConInfoTableLabel name False = IdLabel    name ConInfoTable
+mkConInfoTableLabel name True  = DynIdLabel name ConInfoTable
+
+mkStaticInfoTableLabel name False = IdLabel    name StaticInfoTable
+mkStaticInfoTableLabel name True  = DynIdLabel name StaticInfoTable
+
+mkConEntryLabel dflags name
+  | opt_Static || isHomeModule dflags mod = IdLabel    name ConEntry
+  | otherwise                            = DynIdLabel name ConEntry
+  where mod = nameModule name
+
+mkStaticConEntryLabel dflags name
+  | opt_Static || isHomeModule dflags mod = IdLabel    name StaticConEntry
+  | otherwise                            = DynIdLabel name StaticConEntry
+  where mod = nameModule name
 
-mkConInfoTableLabel     con    = IdLabel con ConInfoTbl
-mkConEntryLabel                con     = IdLabel con ConEntry
-mkStaticInfoTableLabel  con    = IdLabel con StaticInfoTbl
-mkStaticConEntryLabel  con     = IdLabel con StaticConEntry
-
-mkClosureTblLabel      id      = IdLabel id ClosureTable
 
 mkReturnPtLabel uniq           = CaseLabel uniq CaseReturnPt
 mkReturnInfoLabel uniq         = CaseLabel uniq CaseReturnInfo
@@ -278,8 +332,13 @@ mkDefaultLabel  uniq               = CaseLabel uniq CaseDefault
 mkStringLitLabel               = StringLitLabel
 mkAsmTempLabel                         = AsmTempLabel
 
-mkModuleInitLabel              = ModuleInitLabel
-mkPlainModuleInitLabel         = PlainModuleInitLabel
+mkModuleInitLabel :: DynFlags -> Module -> String -> CLabel
+mkModuleInitLabel dflags mod way
+  = ModuleInitLabel mod way $! (not (isHomeModule dflags mod))
+
+mkPlainModuleInitLabel :: DynFlags -> Module -> CLabel
+mkPlainModuleInitLabel dflags mod
+  = PlainModuleInitLabel mod $! (not (isHomeModule dflags mod))
 
        -- Some fixed runtime system labels
 
@@ -301,10 +360,10 @@ mkRtsPrimOpLabel primop           = RtsLabel (RtsPrimOp primop)
 
 moduleRegdLabel                        = ModuleRegdLabel
 
-mkSelectorInfoLabel  upd off   = RtsLabel (RtsSelectorInfoTbl upd off)
+mkSelectorInfoLabel  upd off   = RtsLabel (RtsSelectorInfoTable upd off)
 mkSelectorEntryLabel upd off   = RtsLabel (RtsSelectorEntry   upd off)
 
-mkApInfoTableLabel  upd off    = RtsLabel (RtsApInfoTbl upd off)
+mkApInfoTableLabel  upd off    = RtsLabel (RtsApInfoTable upd off)
 mkApEntryLabel upd off         = RtsLabel (RtsApEntry   upd off)
 
        -- Foreign labels
@@ -352,9 +411,12 @@ mkPicBaseLabel = PicBaseLabel
 -- Converting info labels to entry labels.
 
 infoLblToEntryLbl :: CLabel -> CLabel 
-infoLblToEntryLbl (IdLabel n InfoTbl) = IdLabel n Entry
-infoLblToEntryLbl (IdLabel n ConInfoTbl) = IdLabel n ConEntry
-infoLblToEntryLbl (IdLabel n StaticInfoTbl) = IdLabel n StaticConEntry
+infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
+infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
+infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
+infoLblToEntryLbl (DynIdLabel n InfoTable) = DynIdLabel n Entry
+infoLblToEntryLbl (DynIdLabel n ConInfoTable) = DynIdLabel n ConEntry
+infoLblToEntryLbl (DynIdLabel n StaticInfoTable) = DynIdLabel n StaticConEntry
 infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
 infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
 infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
@@ -363,9 +425,12 @@ infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
 infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
 
 entryLblToInfoLbl :: CLabel -> CLabel 
-entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTbl
-entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTbl
-entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTbl
+entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
+entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
+entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
+entryLblToInfoLbl (DynIdLabel n Entry) = DynIdLabel n InfoTable
+entryLblToInfoLbl (DynIdLabel n ConEntry) = DynIdLabel n ConInfoTable
+entryLblToInfoLbl (DynIdLabel n StaticConEntry) = DynIdLabel n StaticInfoTable
 entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
 entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
 entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
@@ -384,9 +449,10 @@ needsCDecl (IdLabel _ SRT)         = False
 needsCDecl (IdLabel _ SRTDesc)         = False
 needsCDecl (IdLabel _ Bitmap)          = False
 needsCDecl (IdLabel _ _)               = True
+needsCDecl (DynIdLabel _ _)            = True
 needsCDecl (CaseLabel _ _)             = True
-needsCDecl (ModuleInitLabel _ _)       = True
-needsCDecl (PlainModuleInitLabel _)    = True
+needsCDecl (ModuleInitLabel _ _ _)     = True
+needsCDecl (PlainModuleInitLabel _ _)  = True
 needsCDecl ModuleRegdLabel             = False
 
 needsCDecl (CaseLabel _ _)             = False
@@ -414,12 +480,13 @@ externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 externallyVisibleCLabel (CaseLabel _ _)           = False
 externallyVisibleCLabel (StringLitLabel _) = False
 externallyVisibleCLabel (AsmTempLabel _)   = False
-externallyVisibleCLabel (ModuleInitLabel _ _)= True
-externallyVisibleCLabel (PlainModuleInitLabel _)= True
+externallyVisibleCLabel (ModuleInitLabel _ _ _)= True
+externallyVisibleCLabel (PlainModuleInitLabel _ _)= True
 externallyVisibleCLabel ModuleRegdLabel    = False
 externallyVisibleCLabel (RtsLabel _)      = True
 externallyVisibleCLabel (ForeignLabel _ _ _) = True
-externallyVisibleCLabel (IdLabel id _)     = isExternalName id
+externallyVisibleCLabel (IdLabel name _)     = isExternalName name
+externallyVisibleCLabel (DynIdLabel name _)  = isExternalName name
 externallyVisibleCLabel (CC_Label _)      = True
 externallyVisibleCLabel (CCS_Label _)     = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
@@ -434,8 +501,8 @@ data CLabelType
   | DataLabel
 
 labelType :: CLabel -> CLabelType
-labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = DataLabel
-labelType (RtsLabel (RtsApInfoTbl _ _))       = DataLabel
+labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
+labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
 labelType (RtsLabel (RtsData _))              = DataLabel
 labelType (RtsLabel (RtsCode _))              = CodeLabel
 labelType (RtsLabel (RtsInfo _))              = DataLabel
@@ -450,21 +517,23 @@ labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
 labelType (RtsLabel (RtsRetFS _))             = CodeLabel
 labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
 labelType (CaseLabel _ _)                    = CodeLabel
-labelType (ModuleInitLabel _ _)               = CodeLabel
-labelType (PlainModuleInitLabel _)            = CodeLabel
+labelType (ModuleInitLabel _ _ _)             = CodeLabel
+labelType (PlainModuleInitLabel _ _)          = CodeLabel
 
-labelType (IdLabel _ info) = 
+labelType (IdLabel _ info) = idInfoLabelType info
+labelType (DynIdLabel _ info) = idInfoLabelType info
+labelType _        = DataLabel
+
+idInfoLabelType info =
   case info of
-    InfoTbl              -> DataLabel
+    InfoTable            -> DataLabel
     Closure              -> DataLabel
     Bitmap               -> DataLabel
-    ConInfoTbl           -> DataLabel
-    StaticInfoTbl -> DataLabel
+    ConInfoTable  -> DataLabel
+    StaticInfoTable -> DataLabel
     ClosureTable  -> DataLabel
     _            -> CodeLabel
 
-labelType _        = DataLabel
-
 
 -- -----------------------------------------------------------------------------
 -- Does a CLabel need dynamic linkage?
@@ -478,7 +547,8 @@ labelDynamic :: CLabel -> Bool
 labelDynamic lbl = 
   case lbl of
    RtsLabel _               -> not opt_Static  -- i.e., is the RTS in a DLL or not?
-   IdLabel n k       -> isDllName n
+   IdLabel n k       -> False
+   DynIdLabel n k    -> True
 #if mingw32_TARGET_OS
    ForeignLabel _ _ d  -> d
 #else
@@ -486,8 +556,8 @@ labelDynamic lbl =
    -- so we claim that all foreign imports come from dynamic libraries
    ForeignLabel _ _ _ -> True
 #endif
-   ModuleInitLabel m _  -> (not opt_Static) && (not (isHomeModule m))
-   PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
+   ModuleInitLabel m _ dyn    -> not opt_Static && dyn
+   PlainModuleInitLabel m dyn -> not opt_Static && dyn
    
    -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
    _                -> False
@@ -595,7 +665,7 @@ pprCLbl (RtsLabel (RtsData str))   = ptext str
 pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
 pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
 
-pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
+pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
   = hcat [ptext SLIT("stg_sel_"), text (show offset),
                ptext (if upd_reqd 
                        then SLIT("_upd_info") 
@@ -609,7 +679,7 @@ pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
                        else SLIT("_noupd_entry"))
        ]
 
-pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity))
+pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
   = hcat [ptext SLIT("stg_ap_"), text (show arity),
                ptext (if upd_reqd 
                        then SLIT("_upd_info") 
@@ -659,16 +729,17 @@ pprCLbl ModuleRegdLabel
 pprCLbl (ForeignLabel str _ _)
   = ftext str
 
-pprCLbl (IdLabel id  flavor) = ppr id <> ppIdFlavor flavor
+pprCLbl (IdLabel name  flavor) = ppr name <> ppIdFlavor flavor
+pprCLbl (DynIdLabel name  flavor) = ppr name <> ppIdFlavor flavor
 
 pprCLbl (CC_Label cc)          = ppr cc
 pprCLbl (CCS_Label ccs)        = ppr ccs
 
-pprCLbl (ModuleInitLabel mod way)      
-   = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
+pprCLbl (ModuleInitLabel mod way _)    
+   = ptext SLIT("__stginit_") <> ftext (moduleFS mod)
        <> char '_' <> text way
-pprCLbl (PlainModuleInitLabel mod)     
-   = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
+pprCLbl (PlainModuleInitLabel mod _)   
+   = ptext SLIT("__stginit_") <> ftext (moduleFS mod)
 
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <>
@@ -676,15 +747,15 @@ ppIdFlavor x = pp_cSEP <>
                       Closure          -> ptext SLIT("closure")
                       SRT              -> ptext SLIT("srt")
                       SRTDesc          -> ptext SLIT("srtd")
-                      InfoTbl          -> ptext SLIT("info")
+                      InfoTable        -> ptext SLIT("info")
                       Entry            -> ptext SLIT("entry")
                       Slow             -> ptext SLIT("slow")
                       RednCounts       -> ptext SLIT("ct")
                       Bitmap           -> ptext SLIT("btm")
                       ConEntry         -> ptext SLIT("con_entry")
-                      ConInfoTbl       -> ptext SLIT("con_info")
+                      ConInfoTable     -> ptext SLIT("con_info")
                       StaticConEntry   -> ptext SLIT("static_entry")
-                      StaticInfoTbl    -> ptext SLIT("static_info")
+                      StaticInfoTable  -> ptext SLIT("static_info")
                       ClosureTable     -> ptext SLIT("closure_tbl")
                      )
 
index 7eb4bdb..4b25d45 100644 (file)
@@ -25,11 +25,11 @@ import CostCentre   ( dontCareCCS )
 
 import Cmm
 import PprCmm
-import CmmUtils                ( mkIntCLit, mkLblExpr )
+import CmmUtils                ( mkIntCLit )
 import CmmLex
 import CLabel
 import MachOp
-import SMRep           ( tablesNextToCode, fixedHdrSize, CgRep(..) )
+import SMRep           ( fixedHdrSize, CgRep(..) )
 import Lexer
 
 import ForeignCall     ( CCallConv(..) )
@@ -872,7 +872,7 @@ parseCmmFile dflags filename = do
   case unP cmmParse init_state of
     PFailed span err -> do printError span err; return Nothing
     POk _ code -> do
-       cmm <- initC no_module (getCmm (unEC code initEnv [] >> return ()))
+       cmm <- initC dflags no_module (getCmm (unEC code initEnv [] >> return ()))
        dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms [cmm])
        return (Just cmm)
   where
index 5a95350..2254ff7 100644 (file)
@@ -236,7 +236,12 @@ getCgIdInfo id
            Nothing   ->
 
                -- Should be imported; make up a CgIdInfo for it
-       if isExternalName name then
+       let 
+           name = idName id
+       in
+       if isExternalName name then do
+           dflags <- getDynFlags 
+           let ext_lbl = CmmLit (CmmLabel (mkClosureLabel dflags name))
            return (stableIdInfo id ext_lbl (mkLFImported id))
        else
        if isVoidArg (idCgRep id) then
@@ -246,9 +251,7 @@ getCgIdInfo id
        -- Bug  
        cgLookupPanic id
        }}}}
-  where
-    name    = idName id
-    ext_lbl = CmmLit (CmmLabel (mkClosureLabel name))
+    
                        
 cgLookupPanic :: Id -> FCode a
 cgLookupPanic id
index bdacd27..82bdec3 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.71 2004/09/30 10:35:36 simonpj Exp $
+% $Id: CgCase.lhs,v 1.72 2004/11/26 16:19:59 simonmar Exp $
 %
 %********************************************************
 %*                                                     *
@@ -336,9 +336,10 @@ cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
                -- Bind the default binder if necessary
                -- (avoiding it avoids the assignment)
                -- The deadness info is set by StgVarInfo
+       ; dflags <- getDynFlags
        ; whenC (not (isDeadBinder bndr))
                (do { tmp_reg <- bindNewToTemp bndr
-                   ; stmtC (CmmAssign tmp_reg (tagToClosure tycon tag_amode)) })
+                   ; stmtC (CmmAssign tmp_reg (tagToClosure dflags tycon tag_amode)) })
 
                -- Compile the alts
        ; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
index 0c6ca4b..0369b1b 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.64 2004/09/30 10:35:39 simonpj Exp $
+% $Id: CgClosure.lhs,v 1.65 2004/11/26 16:20:03 simonmar Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -40,8 +40,7 @@ import MachOp         ( MachHint(..) )
 import Cmm
 import CmmUtils                ( CmmStmts, mkStmts, oneStmt, plusStmts, noStmts,
                          mkLblExpr )
-import CLabel          ( mkRtsDataLabel, mkClosureLabel, mkRednCountsLabel,
-                         mkSlowEntryLabel, mkIndStaticInfoLabel )
+import CLabel
 import StgSyn
 import CmdLineOpts     ( opt_DoTickyProfiling )
 import CostCentre      
@@ -83,7 +82,7 @@ cgTopRhsClosure id ccs binder_info srt upd_flag args body = do
   ; mod_name <- moduleName
   ; let descr         = closureDescription mod_name name
        closure_info  = mkClosureInfo True id lf_info 0 0 srt_info descr
-       closure_label = mkClosureLabel name
+       closure_label = mkLocalClosureLabel name
        cg_id_info    = stableIdInfo id (mkLblExpr closure_label) lf_info
        closure_rep   = mkStaticClosureFields closure_info ccs True []
 
@@ -366,7 +365,7 @@ mkSlowEntryCode cl_info reg_args
 
      stk_adj_pop   = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
      stk_adj_push  = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
-     jump_to_entry = CmmJump (mkLblExpr (enterIdLabel name)) []
+     jump_to_entry = CmmJump (mkLblExpr (enterLocalIdLabel name)) []
 \end{code}
 
 
index 7dc5d75..9a9f11a 100644 (file)
@@ -35,7 +35,7 @@ import CgTailCall     ( performReturn, emitKnownConReturnCode, returnUnboxedTuple )
 import CgProf          ( mkCCostCentreStack, ldvEnter, curCCS )
 import CgTicky
 import CgInfoTbls      ( emitClosureCodeAndInfoTable, dataConTagZ )
-import CLabel          ( mkClosureLabel, mkRtsDataLabel, mkClosureTblLabel )
+import CLabel
 import ClosureInfo     ( mkConLFInfo, mkLFArgument )
 import CmmUtils                ( mkLblExpr )
 import Cmm
@@ -70,17 +70,20 @@ cgTopRhsCon :: Id           -- Name of thing bound to this RHS
            -> [StgArg]         -- Args
            -> FCode (Id, CgIdInfo)
 cgTopRhsCon id con args
-  = ASSERT( not (isDllConApp con args) )
-    ASSERT( args `lengthIs` dataConRepArity con )
-    do {       -- LAY IT OUT
+  = do { 
+       ; dflags <- getDynFlags
+       ; ASSERT( not (isDllConApp dflags con args) ) return ()
+       ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
+
+       -- LAY IT OUT
        ; amodes <- getArgAmodes args
 
        ; let
            name          = idName id
            lf_info       = mkConLFInfo con
-           closure_label = mkClosureLabel name
+           closure_label = mkClosureLabel dflags name
            caffy         = any stgArgHasCafRefs args
-           (closure_info, amodes_w_offsets) = layOutStaticConstr con amodes
+           (closure_info, amodes_w_offsets) = layOutStaticConstr dflags con amodes
            closure_rep = mkStaticClosureFields
                             closure_info
                             dontCareCCS                -- Because it's static data
@@ -137,8 +140,9 @@ at all.
 
 \begin{code}
 buildDynCon binder cc con []
-  = returnFC (stableIdInfo binder
-                          (mkLblExpr (mkClosureLabel (dataConName con)))
+  = do dflags <- getDynFlags
+       returnFC (stableIdInfo binder
+                          (mkLblExpr (mkClosureLabel dflags (dataConName con)))
                           (mkConLFInfo con))
 \end{code}
 
@@ -191,11 +195,15 @@ Now the general case.
 
 \begin{code}
 buildDynCon binder ccs con args
-  = do { hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
+  = do { 
+       ; dflags <- getDynFlags
+       ; let
+           (closure_info, amodes_w_offsets) = layOutDynConstr dflags con args
+
+       ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
        ; returnFC (heapIdInfo binder hp_off lf_info) }
   where
     lf_info = mkConLFInfo con
-    (closure_info, amodes_w_offsets) = layOutDynConstr con args
 
     use_cc     -- cost-centre to stick in the object
       | currentOrSubsumedCCS ccs = curCCS
@@ -220,11 +228,13 @@ found a $con$.
 \begin{code}
 bindConArgs :: DataCon -> [Id] -> Code
 bindConArgs con args
-  = ASSERT(not (isUnboxedTupleCon con))
-    mapCs bind_arg args_w_offsets
-   where
-     bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
-     (_, args_w_offsets)    = layOutDynConstr con (addIdReps args)
+  = do dflags <- getDynFlags
+       let
+         bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
+         (_, args_w_offsets)    = layOutDynConstr dflags con (addIdReps args)
+       --
+       ASSERT(not (isUnboxedTupleCon con)) return ()
+       mapCs bind_arg args_w_offsets
 \end{code}
 
 Unboxed tuples are handled slightly differently - the object is
@@ -385,9 +395,9 @@ cgTyCon tycon
            -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
        ; extra <- 
           if isEnumerationTyCon tycon then do
-               tbl <- getCmm (emitRODataLits (mkClosureTblLabel 
+               tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel 
                                                (tyConName tycon))
-                          [ CmmLabel (mkClosureLabel (dataConName con))
+                          [ CmmLabel (mkLocalClosureLabel (dataConName con))
                           | con <- tyConDataCons tycon])
                return [tbl]
           else
@@ -404,32 +414,41 @@ static closure, for a constructor.
 cgDataCon :: DataCon -> Code
 cgDataCon data_con
   = do {     -- Don't need any dynamic closure code for zero-arity constructors
-         whenC (not (isNullaryRepDataCon data_con))
+         dflags <- getDynFlags
+
+       ; let
+           -- To allow the debuggers, interpreters, etc to cope with
+           -- static data structures (ie those built at compile
+           -- time), we take care that info-table contains the
+           -- information we need.
+           (static_cl_info, _) = 
+               layOutStaticConstr dflags data_con arg_reps
+
+           (dyn_cl_info, arg_things) = 
+               layOutDynConstr    dflags data_con arg_reps
+
+           emit_info cl_info ticky_code
+               = do { code_blks <- getCgStmts the_code
+                    ; emitClosureCodeAndInfoTable cl_info [] code_blks }
+               where
+                 the_code = do { ticky_code
+                               ; ldvEnter (CmmReg nodeReg)
+                               ; body_code }
+
+           arg_reps :: [(CgRep, Type)]
+           arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
+
+           body_code = do {    
+                       -- NB: We don't set CC when entering data (WDP 94/06)
+                            tickyReturnOldCon (length arg_things)
+                          ; performReturn (emitKnownConReturnCode data_con) }
+                               -- noStmts: Ptr to thing already in Node
+
+       ; whenC (not (isNullaryRepDataCon data_con))
                (emit_info dyn_cl_info tickyEnterDynCon)
 
                -- Dynamic-Closure first, to reduce forward references
        ; emit_info static_cl_info tickyEnterStaticCon }
 
   where
-    emit_info cl_info ticky_code
-       = do { code_blks <- getCgStmts the_code
-            ; emitClosureCodeAndInfoTable cl_info [] code_blks }
-       where
-         the_code = do { ticky_code
-                       ; ldvEnter (CmmReg nodeReg)
-                       ; body_code }
-
-    arg_reps :: [(CgRep, Type)]
-    arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
-
-    -- To allow the debuggers, interpreters, etc to cope with static
-    -- data structures (ie those built at compile time), we take care that
-    -- info-table contains the information we need.
-    (static_cl_info, _)       = layOutStaticConstr data_con arg_reps
-    (dyn_cl_info, arg_things) = layOutDynConstr    data_con arg_reps
-
-    body_code = do {   -- NB: We don't set CC when entering data (WDP 94/06)
-                    tickyReturnOldCon (length arg_things)
-                  ; performReturn (emitKnownConReturnCode data_con) }
-                       -- noStmts: Ptr to thing already in Node
 \end{code}
index ff40531..459f2c0 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgExpr.lhs,v 1.60 2004/09/30 10:35:43 simonpj Exp $
+% $Id: CgExpr.lhs,v 1.61 2004/11/26 16:20:07 simonmar Exp $
 %
 %********************************************************
 %*                                                     *
@@ -152,7 +152,8 @@ cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty)
     do { (_,amode) <- getArgAmode arg
        ; amode' <- assignTemp amode    -- We're going to use it twice,
                                        -- so save in a temp if non-trivial
-       ; stmtC (CmmAssign nodeReg (tagToClosure tycon amode'))
+       ; dflags <- getDynFlags
+       ; stmtC (CmmAssign nodeReg (tagToClosure dflags tycon amode'))
        ; performReturn (emitAlgReturnCode tycon amode') }
    where
          -- If you're reading this code in the attempt to figure
@@ -184,8 +185,9 @@ cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
   | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
        -- c.f. cgExpr (...TagToEnumOp...)
        = do tag_reg <- newTemp wordRep
+            dflags <- getDynFlags
             cgPrimOp [tag_reg] primop args emptyVarSet
-            stmtC (CmmAssign nodeReg (tagToClosure tycon (CmmReg tag_reg)))
+            stmtC (CmmAssign nodeReg (tagToClosure dflags tycon (CmmReg tag_reg)))
             performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
   where
        result_info = getPrimOpResultInfo primop
@@ -280,7 +282,8 @@ cgRhs name (StgRhsCon maybe_cc con args)
        ; returnFC (name, idinfo) }
 
 cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = mkRhsClosure name cc bi srt fvs upd_flag args body
+  = do dflags <- getDynFlags
+       mkRhsClosure dflags name cc bi srt fvs upd_flag args body
 \end{code}
 
 mkRhsClosure looks for two special forms of the right-hand side:
@@ -303,7 +306,7 @@ form:
 
 
 \begin{code}
-mkRhsClosure   bndr cc bi srt
+mkRhsClosure   dflags bndr cc bi srt
                [the_fv]                -- Just one free var
                upd_flag                -- Updatable thunk
                []                      -- A thunk
@@ -323,9 +326,10 @@ mkRhsClosure       bndr cc bi srt
     -- will evaluate to.
     cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
   where
-    lf_info              = mkSelectorLFInfo bndr offset_into_int (isUpdatable upd_flag)
-    (_, params_w_offsets) = layOutDynConstr con (addIdReps params)
-                               -- Just want the layout
+    lf_info              = mkSelectorLFInfo bndr offset_into_int
+                                (isUpdatable upd_flag)
+    (_, params_w_offsets) = layOutDynConstr dflags con (addIdReps params)
+                       -- Just want the layout
     maybe_offset         = assocMaybe params_w_offsets selectee
     Just the_offset      = maybe_offset
     offset_into_int       = the_offset - fixedHdrSize
@@ -348,7 +352,7 @@ We only generate an Ap thunk if all the free variables are pointers,
 for semi-obvious reasons.
 
 \begin{code}
-mkRhsClosure   bndr cc bi srt
+mkRhsClosure   dflags bndr cc bi srt
                fvs
                upd_flag
                []                      -- No args; a thunk
@@ -373,7 +377,7 @@ mkRhsClosure        bndr cc bi srt
 The default case
 ~~~~~~~~~~~~~~~~
 \begin{code}
-mkRhsClosure bndr cc bi srt fvs upd_flag args body
+mkRhsClosure dflags bndr cc bi srt fvs upd_flag args body
   = cgRhsClosure bndr cc bi srt fvs upd_flag args body
 \end{code}
 
index 5e6c122..58fbe94 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgHeapery.lhs,v 1.41 2004/09/30 10:35:45 simonpj Exp $
+% $Id: CgHeapery.lhs,v 1.42 2004/11/26 16:20:09 simonmar Exp $
 %
 \section[CgHeapery]{Heap management functions}
 
@@ -54,6 +54,7 @@ import TyCon          ( tyConPrimRep )
 import CostCentre      ( CostCentreStack )
 import Util            ( mapAccumL, filterOut )
 import Constants       ( wORD_SIZE )
+import CmdLineOpts     ( DynFlags )
 import Outputable
 
 import GLAEXTS
@@ -125,7 +126,8 @@ getHpRelOffset virtual_offset
 
 \begin{code}
 layOutDynConstr, layOutStaticConstr
-       :: DataCon      
+       :: DynFlags
+       -> DataCon      
        -> [(CgRep,a)]
        -> (ClosureInfo,
            [(a,VirtualHpOffset)])
@@ -133,8 +135,8 @@ layOutDynConstr, layOutStaticConstr
 layOutDynConstr    = layOutConstr False
 layOutStaticConstr = layOutConstr True
 
-layOutConstr is_static data_con args
-   = (mkConInfo is_static data_con tot_wds ptr_wds,
+layOutConstr  is_static dflags data_con args
+   = (mkConInfo dflags is_static data_con tot_wds ptr_wds,
       things_w_offsets)
   where
     (tot_wds,           -- #ptr_wds + #nonptr_wds
index f6b2096..d9d0801 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgMonad.lhs,v 1.41 2004/09/10 14:53:47 simonmar Exp $
+% $Id: CgMonad.lhs,v 1.42 2004/11/26 16:20:10 simonmar Exp $
 %
 \section[CgMonad]{The code generation monad}
 
@@ -47,7 +47,7 @@ module CgMonad (
        Sequel(..), -- ToDo: unabstract?
 
        -- ideally we wouldn't export these, but some other modules access internal state
-       getState, setState, getInfoDown,
+       getState, setState, getInfoDown, getDynFlags,
 
        -- more localised access to monad state 
        getStkUsage, setStkUsage,
@@ -61,6 +61,7 @@ module CgMonad (
 
 import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
 
+import CmdLineOpts     ( DynFlags )
 import Cmm
 import CmmUtils                ( CmmStmts, isNopStmt )
 import CLabel
@@ -75,6 +76,8 @@ import UniqSupply     ( UniqSupply, mkSplitUniqSupply, splitUniqSupply, uniqFromSupp
 import FastString
 import Outputable
 
+import Control.Monad   ( liftM )
+
 infixr 9 `thenC`       -- Right-associative!
 infixr 9 `thenFC`
 \end{code}
@@ -92,6 +95,7 @@ along.
 \begin{code}
 data CgInfoDownwards   -- information only passed *downwards* by the monad
   = MkCgInfoDown {
+       cgd_dflags  :: DynFlags,
        cgd_mod     :: Module,          -- Module being compiled
        cgd_statics :: CgBindings,      -- [Id -> info] : static environment
        cgd_srt     :: CLabel,          -- label of the current SRT
@@ -99,9 +103,10 @@ data CgInfoDownwards        -- information only passed *downwards* by the monad
        cgd_eob     :: EndOfBlockInfo   -- Info for stuff to do at end of basic block:
   }
 
-initCgInfoDown :: Module -> CgInfoDownwards
-initCgInfoDown mod
-  = MkCgInfoDown {     cgd_mod    = mod,
+initCgInfoDown :: DynFlags -> Module -> CgInfoDownwards
+initCgInfoDown dflags mod
+  = MkCgInfoDown {     cgd_dflags  = dflags,
+                       cgd_mod     = mod,
                        cgd_statics = emptyVarEnv,
                        cgd_srt     = error "initC: srt",
                        cgd_ticky   = mkTopTickyCtrLabel,
@@ -370,11 +375,11 @@ instance Monad FCode where
 The Abstract~C is not in the environment so as to improve strictness.
 
 \begin{code}
-initC :: Module -> FCode a -> IO a
+initC :: DynFlags -> Module -> FCode a -> IO a
 
-initC mod (FCode code)
+initC dflags mod (FCode code)
   = do { uniqs <- mkSplitUniqSupply 'c'
-       ; case code (initCgInfoDown mod) (initCgState uniqs) of
+       ; case code (initCgInfoDown dflags mod) (initCgState uniqs) of
              (res, _) -> return res
        }
 
@@ -499,6 +504,9 @@ newUnique = do
 getInfoDown :: FCode CgInfoDownwards
 getInfoDown = FCode $ \info_down state -> (info_down,state)
 
+getDynFlags :: FCode DynFlags
+getDynFlags = liftM cgd_dflags getInfoDown
+
 withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
 withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state 
 
@@ -646,7 +654,7 @@ forkEvalHelp :: EndOfBlockInfo  -- For the body
                       a)               -- Result of the FCode
        -- A disturbingly complicated function
 forkEvalHelp body_eob_info env_code body_code
-  = do { info_down@(MkCgInfoDown cg_info statics srt ticky _) <- getInfoDown
+  = do { info_down <- getInfoDown
        ; us   <- newUniqSupply
        ; state <- getState
        ; let { info_down_for_body = info_down {cgd_eob = body_eob_info}
index 84061e4..d54718f 100644 (file)
@@ -43,7 +43,7 @@ import MachOp
 import CmmUtils                ( zeroCLit, mkIntCLit, mkLblExpr )
 import CLabel          ( mkCCLabel, mkCCSLabel, mkRtsDataLabel )
 
-import Module          ( moduleNameUserString )
+import Module          ( moduleUserString )
 import Id              ( Id )
 import CostCentre
 import StgSyn          ( GenStgExpr(..), StgExpr )
@@ -291,7 +291,7 @@ emitCostCentreDecl
    -> Code
 emitCostCentreDecl cc = do 
   { label <- mkStringCLit (costCentreUserName cc)
-  ; modl  <- mkStringCLit (moduleNameUserString (cc_mod cc))
+  ; modl  <- mkStringCLit (moduleUserString (cc_mod cc))
   ; let
      lits = [ zero,    -- StgInt ccID,
              label,    -- char *label,
index 98c075d..0b77823 100644 (file)
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgTailCall.lhs,v 1.40 2004/09/30 10:35:50 simonpj Exp $
+% $Id: CgTailCall.lhs,v 1.41 2004/11/26 16:20:12 simonmar Exp $
 %
 %********************************************************
 %*                                                     *
@@ -118,8 +118,9 @@ performTailCall fun_info arg_amodes pending_assts
              opt_node_asst | nodeMustPointToIt lf_info = node_asst
                            | otherwise                 = noStmts
        ; EndOfBlockInfo sp _ <- getEndOfBlockInfo
+       ; dflags <- getDynFlags
 
-       ; case (getCallMethod fun_name lf_info (length arg_amodes)) of
+       ; case (getCallMethod dflags fun_name lf_info (length arg_amodes)) of
 
            -- Node must always point to things we enter
            EnterIt -> do
index 9727fec..a8e9c39 100644 (file)
@@ -52,10 +52,11 @@ import CLabel               ( CLabel, mkStringLitLabel )
 import Digraph         ( SCC(..), stronglyConnComp )
 import ListSetOps      ( assocDefault )
 import Util            ( filterOut, sortLe )
-import Char            ( ord )
+import CmdLineOpts     ( DynFlags )
 import FastString      ( LitString, FastString, unpackFS )
 import Outputable
 
+import Char            ( ord )
 import DATA_BITS
 import Maybe           ( isNothing )
 
@@ -211,10 +212,11 @@ addToMemE rep ptr n
 --
 -------------------------------------------------------------------------
 
-tagToClosure :: TyCon -> CmmExpr -> CmmExpr
-tagToClosure tycon tag
+tagToClosure :: DynFlags -> TyCon -> CmmExpr -> CmmExpr
+tagToClosure dflags tycon tag
   = CmmLoad (cmmOffsetExprW closure_tbl tag) wordRep
-  where closure_tbl = CmmLit (CmmLabel (mkClosureTblLabel (tyConName tycon)))
+  where closure_tbl = CmmLit (CmmLabel lbl)
+       lbl = mkClosureTableLabel dflags (tyConName tycon)
 
 -------------------------------------------------------------------------
 --
index 147039b..f1b2540 100644 (file)
@@ -33,7 +33,7 @@ module ClosureInfo (
        closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
        closureFunInfo, isStandardFormThunk, isKnownFun,
 
-       enterIdLabel, enterReturnPtLabel,
+       enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
 
        nodeMustPointToIt, 
        CallMethod(..), getCallMethod,
@@ -61,7 +61,8 @@ import SMRep          -- all of it
 import CLabel
 
 import Constants       ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
-import CmdLineOpts     ( opt_SccProfilingOn, opt_OmitBlackHoling,
+import Packages                ( isDllName )
+import CmdLineOpts     ( DynFlags, opt_SccProfilingOn, opt_OmitBlackHoling,
                          opt_Parallel, opt_DoTickyProfiling,
                          opt_SMP )
 import Id              ( Id, idType, idArity, idName )
@@ -114,7 +115,8 @@ data ClosureInfo
   -- the constructor's info table), and they don't have an SRT.
   | ConInfo {
        closureCon       :: !DataCon,
-       closureSMRep     :: !SMRep
+       closureSMRep     :: !SMRep,
+       closureDllCon    :: !Bool       -- is in a separate DLL
     }
 
 -- C_SRT is what StgSyn.SRT gets translated to... 
@@ -318,13 +320,15 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
     name   = idName id
     sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
 
-mkConInfo :: Bool      -- Is static
+mkConInfo :: DynFlags
+         -> Bool       -- Is static
          -> DataCon    
          -> Int -> Int -- Total and pointer words
          -> ClosureInfo
-mkConInfo is_static data_con tot_wds ptr_wds
+mkConInfo dflags is_static data_con tot_wds ptr_wds
    = ConInfo { closureSMRep = sm_rep,
-               closureCon = data_con }
+               closureCon = data_con,
+               closureDllCon = isDllName dflags (dataConName data_con) }
   where
     sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
 \end{code}
@@ -557,29 +561,30 @@ data CallMethod
        CLabel                          --   The code label
        Int                             --   Its arity
 
-getCallMethod :: Name          -- Function being applied
+getCallMethod :: DynFlags
+             -> Name           -- Function being applied
              -> LambdaFormInfo -- Its info
              -> Int            -- Number of available arguments
              -> CallMethod
 
-getCallMethod name lf_info n_args
+getCallMethod dflags name lf_info n_args
   | nodeMustPointToIt lf_info && opt_Parallel
   =    -- If we're parallel, then we must always enter via node.  
        -- The reason is that the closure may have been         
        -- fetched since we allocated it.
     EnterIt
 
-getCallMethod name (LFReEntrant _ arity _ _) n_args
+getCallMethod dflags name (LFReEntrant _ arity _ _) n_args
   | n_args == 0    = ASSERT( arity /= 0 )
                     ReturnIt   -- No args at all
   | n_args < arity = SlowCall  -- Not enough args
-  | otherwise      = DirectEntry (enterIdLabel name) arity
+  | otherwise      = DirectEntry (enterIdLabel dflags name) arity
 
-getCallMethod name (LFCon con) n_args
+getCallMethod dflags name (LFCon con) n_args
   = ASSERT( n_args == 0 )
     ReturnCon con
 
-getCallMethod name (LFThunk _ _ updatable std_form_info is_fun) n_args
+getCallMethod dflags name (LFThunk _ _ updatable std_form_info is_fun) n_args
   | is_fun     -- Must always "call" a function-typed 
   = SlowCall   -- thing, cannot just enter it [in eval/apply, the entry code
                -- is the fast-entry code]
@@ -592,24 +597,24 @@ getCallMethod name (LFThunk _ _ updatable std_form_info is_fun) n_args
 
   | otherwise  -- Jump direct to code for single-entry thunks
   = ASSERT( n_args == 0 )
-    JumpToIt (thunkEntryLabel name std_form_info updatable)
+    JumpToIt (thunkEntryLabel dflags name std_form_info updatable)
 
-getCallMethod name (LFUnknown True) n_args
+getCallMethod dflags name (LFUnknown True) n_args
   = SlowCall -- might be a function
 
-getCallMethod name (LFUnknown False) n_args
+getCallMethod dflags name (LFUnknown False) n_args
   = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args ) 
     EnterIt -- Not a function
 
-getCallMethod name (LFBlackHole _) n_args
+getCallMethod dflags name (LFBlackHole _) n_args
   = SlowCall   -- Presumably the black hole has by now
                -- been updated, but we don't know with
                -- what, so we slow call it
 
-getCallMethod name (LFLetNoEscape 0) n_args
+getCallMethod dflags name (LFLetNoEscape 0) n_args
   = JumpToIt (enterReturnPtLabel (nameUnique name))
 
-getCallMethod name (LFLetNoEscape arity) n_args
+getCallMethod dflags name (LFLetNoEscape arity) n_args
   | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
   | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
 
@@ -810,35 +815,33 @@ infoTableLabelFromCI (ClosureInfo { closureName = name,
        LFThunk _ _ upd_flag (ApThunk arity) _ -> 
                mkApInfoTableLabel upd_flag arity
 
-       LFThunk{}      -> mkInfoTableLabel name
+       LFThunk{}      -> mkLocalInfoTableLabel name
 
-       LFReEntrant _ _ _ _ -> mkInfoTableLabel name
+       LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name
 
        other -> panic "infoTableLabelFromCI"
 
-infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep })
-  =  mkConInfoPtr con rep
-
-
-mkConInfoPtr :: DataCon -> SMRep -> CLabel
-mkConInfoPtr con rep
-  | isStaticRep rep = mkStaticInfoTableLabel  name
-  | otherwise      = mkConInfoTableLabel     name
+infoTableLabelFromCI (ConInfo { closureCon = con, 
+                               closureSMRep = rep,
+                               closureDllCon = dll })
+  | isStaticRep rep = mkStaticInfoTableLabel  name dll
+  | otherwise      = mkConInfoTableLabel     name dll
   where
     name = dataConName con
 
-closureLabelFromCI (ClosureInfo { closureName = nm }) = mkClosureLabel nm
+-- ClosureInfo for a closure (as opposed to a constructor) is always local
+closureLabelFromCI (ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm
 closureLabelFromCI _ = panic "closureLabelFromCI"
 
 -- thunkEntryLabel is a local help function, not exported.  It's used from both
 -- entryLabelFromCI and getCallMethod.
 
-thunkEntryLabel thunk_id (ApThunk arity) is_updatable
+thunkEntryLabel dflags thunk_id (ApThunk arity) is_updatable
   = enterApLabel is_updatable arity
-thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
+thunkEntryLabel dflags thunk_id (SelectorThunk offset) upd_flag
   = enterSelectorLabel upd_flag offset
-thunkEntryLabel thunk_id _ is_updatable
-  = enterIdLabel thunk_id
+thunkEntryLabel dflags thunk_id _ is_updatable
+  = enterIdLabel dflags thunk_id
 
 enterApLabel is_updatable arity
   | tablesNextToCode = mkApInfoTableLabel is_updatable arity
@@ -848,9 +851,13 @@ enterSelectorLabel upd_flag offset
   | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
   | otherwise        = mkSelectorEntryLabel upd_flag offset
 
-enterIdLabel id
-  | tablesNextToCode = mkInfoTableLabel id
-  | otherwise        = mkEntryLabel id
+enterIdLabel dflags id
+  | tablesNextToCode = mkInfoTableLabel dflags id
+  | otherwise        = mkEntryLabel dflags id
+
+enterLocalIdLabel id
+  | tablesNextToCode = mkLocalInfoTableLabel id
+  | otherwise        = mkLocalEntryLabel id
 
 enterReturnPtLabel name
   | tablesNextToCode = mkReturnInfoLabel name
index 7ee581a..056fb1e 100644 (file)
@@ -33,15 +33,14 @@ import CgClosure    ( cgTopRhsClosure )
 import CgCon           ( cgTopRhsCon, cgTyCon )
 import CgUtils         ( cmmRegOffW, emitRODataLits, cmmNeWord, emitRtsCall )
 
-import CLabel          ( mkSRTLabel, mkClosureLabel, moduleRegdLabel,
-                         mkPlainModuleInitLabel, mkModuleInitLabel )
+import CLabel
 import Cmm
 import CmmUtils                ( zeroCLit, mkIntCLit, mkLblExpr )
 import PprCmm          ( pprCmms )
 import MachOp          ( wordRep, MachHint(..) )
 
 import StgSyn
-import PrelNames       ( gHC_PRIM, rOOT_MAIN, mAIN_Name, pREL_TOP_HANDLER )
+import PrelNames       ( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
 import CmdLineOpts     ( DynFlags, DynFlag(..), opt_EnsureSplittableC,
                          opt_SccProfilingOn )
 
@@ -51,10 +50,9 @@ import Id               ( Id, idName, setIdName )
 import Name            ( nameSrcLoc, nameOccName, nameUnique, isInternalName, mkExternalName )
 import OccName         ( mkLocalOcc )
 import TyCon            ( isDataTyCon )
-import Module          ( Module, mkModuleName )
+import Module          ( Module, mkModule )
 import ErrUtils                ( dumpIfSet_dyn, showPass )
 import Panic           ( assertPanic )
-import qualified Module ( moduleName )
 
 #ifdef DEBUG
 import Outputable
@@ -86,14 +84,14 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods
 -- Why?
 --   ; mapM_ (\x -> seq x (return ())) data_tycons
 
-  ; code_stuff <- initC this_mod $ do 
-                       { cmm_binds  <- mapM (getCmm . cgTopBinding) stg_binds
-                       ; cmm_tycons <- mapM cgTyCon data_tycons
-                       ; cmm_init   <- getCmm (mkModuleInit way cost_centre_info 
-                                                    this_mod mb_main_mod
-                                                    foreign_stubs imported_mods)
-                       ; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) 
-                       }
+  ; code_stuff <- initC dflags this_mod $ do 
+               { cmm_binds  <- mapM (getCmm . cgTopBinding dflags) stg_binds
+               ; cmm_tycons <- mapM cgTyCon data_tycons
+               ; cmm_init   <- getCmm (mkModuleInit dflags way cost_centre_info 
+                                            this_mod mb_main_mod
+                                            foreign_stubs imported_mods)
+               ; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) 
+               }
                -- Put datatype_stuff after code_stuff, because the
                -- datatype closure table (for enumeration types) to
                -- (say) PrelBase_True_closure, which is defined in
@@ -149,14 +147,15 @@ We initialise the module tree by keeping a work-stack,
 
 \begin{code}
 mkModuleInit 
-       :: String               -- the "way"
+       :: DynFlags
+       -> String               -- the "way"
        -> CollectedCCs         -- cost centre info
        -> Module
        -> Maybe String         -- Just m ==> we have flag: -main-is Foo.baz 
        -> ForeignStubs
        -> [Module]
        -> Code
-mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
+mkModuleInit dflags way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mods
   = do {       
 
        -- Allocate the static boolean that records if this
@@ -184,31 +183,31 @@ mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mo
        ; emitSimpleProc plain_init_lbl jump_to_init
 
        -- When compiling the module in which the 'main' function lives,
-       -- (that is, Module.moduleName this_mod == main_mod_name)
+       -- (that is, this_mod == main_mod)
        -- we inject an extra stg_init procedure for stg_init_ZCMain, for the 
        -- RTS to invoke.  We must consult the -main-is flag in case the
        -- user specified a different function to Main.main
-       ; whenC (Module.moduleName this_mod == main_mod_name)
+       ; whenC (this_mod == main_mod)
                (emitSimpleProc plain_main_init_lbl jump_to_init)
     }
   where
-    plain_init_lbl = mkPlainModuleInitLabel this_mod
-    real_init_lbl  = mkModuleInitLabel this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel rOOT_MAIN
+    plain_init_lbl = mkPlainModuleInitLabel dflags this_mod
+    real_init_lbl  = mkModuleInitLabel dflags this_mod way
+    plain_main_init_lbl = mkPlainModuleInitLabel dflags rOOT_MAIN
 
     jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) [])
 
     mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) wordRep
 
-    main_mod_name = case mb_main_mod of
-                       Just mod_name -> mkModuleName mod_name
-                       Nothing       -> mAIN_Name
+    main_mod = case mb_main_mod of
+                       Just mod_name -> mkModule mod_name
+                       Nothing       -> mAIN
 
     -- Main refers to GHC.TopHandler.runIO, so make sure we call the
     -- init function for GHC.TopHandler.
     extra_imported_mods
-       | Module.moduleName this_mod == main_mod_name = [pREL_TOP_HANDLER]
-       | otherwise                                   = []
+       | this_mod == main_mod = [pREL_TOP_HANDLER]
+       | otherwise            = []
 
     mod_init_code = do
        {       -- Set mod_reg to 1 to record that we've been here
@@ -217,18 +216,19 @@ mkModuleInit way cost_centre_info this_mod mb_main_mod foreign_stubs imported_mo
                -- Now do local stuff
        ; registerForeignExports foreign_stubs
        ; initCostCentres cost_centre_info
-       ; mapCs (registerModuleImport way) (imported_mods++extra_imported_mods)
+       ; mapCs (registerModuleImport dflags way) 
+               (imported_mods++extra_imported_mods)
        } 
 
 
 -----------------------
-registerModuleImport :: String -> Module -> Code
-registerModuleImport way mod 
+registerModuleImport :: DynFlags -> String -> Module -> Code
+registerModuleImport dflags way mod 
   | mod == gHC_PRIM
   = nopC 
   | otherwise  -- Push the init procedure onto the work stack
   = stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
-          , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel mod way)) ]
+          , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel dflags mod way)) ]
 
 -----------------------
 registerForeignExports :: ForeignStubs -> Code
@@ -239,7 +239,8 @@ registerForeignExports (ForeignStubs _ _ _ fe_bndrs)
   where
        mk_export_register bndr
          = emitRtsCall SLIT("getStablePtr") 
-               [ (CmmLit (CmmLabel (mkClosureLabel (idName bndr))), PtrHint) ]
+               [ (CmmLit (CmmLabel (mkLocalClosureLabel (idName bndr))), 
+                  PtrHint) ]
 \end{code}
 
 
@@ -280,32 +281,32 @@ style, with the increasing static environment being plumbed as a state
 variable.
 
 \begin{code}
-cgTopBinding :: (StgBinding,[(Id,[Id])]) -> Code
-cgTopBinding (StgNonRec id rhs, srts)
+cgTopBinding :: DynFlags -> (StgBinding,[(Id,[Id])]) -> Code
+cgTopBinding dflags (StgNonRec id rhs, srts)
   = do { id' <- maybeExternaliseId id
-       ; mapM_ (mkSRT [id']) srts
+       ; mapM_ (mkSRT dflags [id']) srts
        ; (id,info) <- cgTopRhs id' rhs
        ; addBindC id info      -- Add the *un-externalised* Id to the envt,
                                -- so we find it when we look up occurrences
        }
 
-cgTopBinding (StgRec pairs, srts)
+cgTopBinding dflags (StgRec pairs, srts)
   = do { let (bndrs, rhss) = unzip pairs
        ; bndrs' <- mapFCs maybeExternaliseId bndrs
        ; let pairs' = zip bndrs' rhss
-       ; mapM_ (mkSRT bndrs')  srts
+       ; mapM_ (mkSRT dflags bndrs')  srts
        ; new_binds <- fixC (\ new_binds -> do 
                { addBindsC new_binds
                ; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
        ; nopC }
 
-mkSRT :: [Id] -> (Id,[Id]) -> Code
-mkSRT these (id,[])  = nopC
-mkSRT these (id,ids)
+mkSRT :: DynFlags -> [Id] -> (Id,[Id]) -> Code
+mkSRT dflags these (id,[])  = nopC
+mkSRT dflags these (id,ids)
   = do { ids <- mapFCs remap ids
        ; id  <- remap id
        ; emitRODataLits (mkSRTLabel (idName id)) 
-                      (map (CmmLabel . mkClosureLabel . idName) ids)
+                      (map (CmmLabel . mkClosureLabel dflags . idName) ids)
        }
   where
        -- Sigh, better map all the ids against the environment in 
index 289bd07..12825fe 100644 (file)
@@ -41,6 +41,8 @@ module CompManager (
     cmGetModInfo,      -- :: CmState -> (ModuleGraph, HomePackageTable)
 
     cmSetDFlags,
+    cmGetDFlags,
+
     cmGetBindings,     -- :: CmState -> [TyThing]
     cmGetPrintUnqual,  -- :: CmState -> PrintUnqualified
 #endif
@@ -49,19 +51,21 @@ where
 
 #include "HsVersions.h"
 
+import Packages                ( isHomeModule )
 import DriverPipeline  ( CompResult(..), preprocess, compile, link )
 import HscMain         ( newHscEnv )
 import DriverState     ( v_Output_file, v_NoHsMain, v_MainModIs )
 import DriverPhases
 import Finder
 import HscTypes
-import PrelNames        ( gHC_PRIM_Name )
-import Module          ( Module, ModuleName, moduleName, mkModuleName, isHomeModule,
-                         ModuleEnv, lookupModuleEnvByName, mkModuleEnv, moduleEnvElts,
-                         extendModuleEnvList, extendModuleEnv,
-                         moduleNameUserString,
+import PrelNames        ( gHC_PRIM )
+import Module          ( Module, mkModule,
+                         ModuleEnv, lookupModuleEnv, mkModuleEnv,
+                         moduleEnvElts, extendModuleEnvList, extendModuleEnv,
+                         moduleUserString,
                          ModLocation(..) )
 import GetImports
+import LoadIface       ( noIfaceErr )
 import UniqFM
 import Digraph         ( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs )
 import ErrUtils                ( showPass )
@@ -70,7 +74,7 @@ import BasicTypes     ( SuccessFlag(..), succeeded, failed )
 import Util
 import Outputable
 import Panic
-import CmdLineOpts     ( DynFlags(..), getDynFlags )
+import CmdLineOpts     ( DynFlags(..), DynFlag(..), dopt_unset )
 import Maybes          ( expectJust, orElse, mapCatMaybes )
 
 import DATA_IOREF      ( readIORef )
@@ -78,7 +82,7 @@ import DATA_IOREF     ( readIORef )
 #ifdef GHCI
 import HscMain         ( hscGetInfo, GetInfoResult, hscStmt, hscTcExpr, hscKcType )
 import TcRnDriver      ( mkExportEnv, getModuleContents )
-import IfaceSyn                ( IfaceDecl, IfaceInst )
+import IfaceSyn                ( IfaceDecl )
 import RdrName         ( GlobalRdrEnv, plusGlobalRdrEnv )
 import Name            ( Name )
 import NameEnv
@@ -145,7 +149,7 @@ discardCMInfo cm_state
 
 type UnlinkedImage = [Linkable]        -- the unlinked images (should be a set, really)
 
-findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
+findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
 findModuleLinkable_maybe lis mod
    = case [LM time nm us | LM time nm us <- lis, nm == mod] of
         []   -> Nothing
@@ -177,7 +181,7 @@ cmSetContext cmstate toplevs exports = do
       hsc_env = cm_hsc cmstate
       hpt     = hsc_HPT hsc_env
 
-  export_env  <- mkExportEnv hsc_env (map mkModuleName exports)
+  export_env  <- mkExportEnv hsc_env (map mkModule exports)
   toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
 
   let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
@@ -187,7 +191,7 @@ cmSetContext cmstate toplevs exports = do
 
 mkTopLevEnv :: HomePackageTable -> String -> IO GlobalRdrEnv
 mkTopLevEnv hpt mod
- = case lookupModuleEnvByName hpt (mkModuleName mod) of
+ = case lookupModuleEnv hpt (mkModule mod) of
       Nothing      -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++ mod))
       Just details -> case hm_globals details of
                        Nothing  -> throwDyn (ProgramError ("mkTopLevEnv: not interpreted " ++ mod))
@@ -199,15 +203,19 @@ cmGetContext CmState{cm_ic=ic} =
 
 cmModuleIsInterpreted :: CmState -> String -> IO Bool
 cmModuleIsInterpreted cmstate str 
- = case lookupModuleEnvByName (cmHPT cmstate) (mkModuleName str) of
+ = case lookupModuleEnv (cmHPT cmstate) (mkModule str) of
       Just details       -> return (isJust (hm_globals details))
       _not_a_home_module -> return False
 
 -----------------------------------------------------------------------------
+
 cmSetDFlags :: CmState -> DynFlags -> CmState
 cmSetDFlags cm_state dflags 
   = cm_state { cm_hsc = (cm_hsc cm_state) { hsc_dflags = dflags } }
 
+cmGetDFlags :: CmState -> DynFlags
+cmGetDFlags cm_state = hsc_dflags (cm_hsc cm_state)
+
 -----------------------------------------------------------------------------
 -- cmInfoThing: convert a String to a TyThing
 
@@ -223,7 +231,7 @@ cmGetInfo cmstate id = hscGetInfo (cm_hsc cmstate) (cm_ic cmstate) id
 cmBrowseModule :: CmState -> String -> Bool -> IO [IfaceDecl]
 cmBrowseModule cmstate str exports_only
   = do { mb_decls <- getModuleContents (cm_hsc cmstate) (cm_ic cmstate) 
-                                      (mkModuleName str) exports_only
+                                      (mkModule str) exports_only
        ; case mb_decls of
           Nothing -> return []         -- An error of some kind
           Just ds -> return ds
@@ -241,7 +249,12 @@ data CmRunResult
 cmRunStmt :: CmState -> String -> IO (CmState, CmRunResult)            
 cmRunStmt cmstate@CmState{ cm_hsc=hsc_env, cm_ic=icontext } expr
    = do 
-        maybe_stuff <- hscStmt hsc_env icontext expr
+       -- Turn off -fwarn-unused-bindings when running a statement, to hide
+       -- warnings about the implicit bindings we introduce.
+       let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
+           hsc_env' = hsc_env{ hsc_dflags = dflags' }
+
+        maybe_stuff <- hscStmt hsc_env' icontext expr
 
         case maybe_stuff of
           Nothing -> return (cmstate, CmRunFailed)
@@ -423,7 +436,7 @@ cmDepAnal cmstate rootnames
            hPutStrLn stderr (showSDoc (hcat [
             text "Chasing modules from: ",
             hcat (punctuate comma (map text rootnames))]))
-       downsweep rootnames (cm_mg cmstate)
+       downsweep dflags rootnames (cm_mg cmstate)
   where
     hsc_env = cm_hsc cmstate
     dflags  = hsc_dflags hsc_env
@@ -455,13 +468,13 @@ cmLoadModules cmstate1 mg2unsorted
         let 
            main_mod = mb_main_mod `orElse` "Main"
            a_root_is_Main 
-               = any ((==main_mod).moduleNameUserString.modSummaryName
+               = any ((==main_mod).moduleUserString.ms_mod
                      mg2unsorted
 
-        let mg2unsorted_names = map modSummaryName mg2unsorted
+        let mg2unsorted_names = map ms_mod mg2unsorted
 
         -- reachable_from follows source as well as normal imports
-        let reachable_from :: ModuleName -> [ModuleName]
+        let reachable_from :: Module -> [Module]
             reachable_from = downwards_closure_of_module mg2unsorted
  
         -- should be cycle free; ignores 'import source's
@@ -480,8 +493,7 @@ cmLoadModules cmstate1 mg2unsorted
 
        -- putStrLn (showSDoc (vcat [ppr valid_old_linkables, ppr new_linkables]))
 
-               -- Uniq of ModuleName is the same as Module, fortunately...
-       let hpt2 = delListFromUFM hpt1 (map linkableModName new_linkables)
+       let hpt2 = delListFromUFM hpt1 (map linkableModule new_linkables)
             hsc_env2 = hsc_env { hsc_HPT = hpt2 }
 
        -- When (verb >= 2) $
@@ -505,12 +517,12 @@ cmLoadModules cmstate1 mg2unsorted
                = concatMap (findInSummaries mg2unsorted) stable_mods
 
            stable_linkables
-              = filter (\m -> linkableModName m `elem` stable_mods) 
+              = filter (\m -> linkableModule m `elem` stable_mods) 
                    valid_old_linkables
 
         when (verb >= 2) $
            hPutStrLn stderr (showSDoc (text "Stable modules:" 
-                               <+> sep (map (text.moduleNameUserString) stable_mods)))
+                               <+> sep (map (text.moduleUserString) stable_mods)))
 
        -- Unload any modules which are going to be re-linked this
        -- time around.
@@ -525,7 +537,7 @@ cmLoadModules cmstate1 mg2unsorted
         -- done before the upsweep is abandoned.
         let upsweep_these
                = filter (\scc -> any (`notElem` stable_mods) 
-                                     (map modSummaryName (flattenSCC scc)))
+                                     (map ms_mod (flattenSCC scc)))
                         mg2
 
         --hPutStrLn stderr "after tsort:\n"
@@ -540,7 +552,7 @@ cmLoadModules cmstate1 mg2unsorted
         -- turn.  Final result is version 3 of everything.
 
        -- clean up between compilations
-       let cleanup = cleanTempFilesExcept verb 
+       let cleanup = cleanTempFilesExcept dflags
                          (ppFilesFromSummaries (flattenSCCs mg2))
 
         (upsweep_ok, hsc_env3, modsUpswept)
@@ -570,7 +582,7 @@ cmLoadModules cmstate1 mg2unsorted
                 hPutStrLn stderr "Upsweep completely successful."
 
              -- clean up after ourselves
-             cleanTempFilesExcept verb (ppFilesFromSummaries modsDone)
+             cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
 
              ofile <- readIORef v_Output_file
              no_hs_main <- readIORef v_NoHsMain
@@ -600,19 +612,19 @@ cmLoadModules cmstate1 mg2unsorted
                hPutStrLn stderr "Upsweep partially successful."
 
               let modsDone_names
-                     = map modSummaryName modsDone
+                     = map ms_mod modsDone
               let mods_to_zap_names 
                      = findPartiallyCompletedCycles modsDone_names 
                          mg2_with_srcimps
               let mods_to_keep
-                     = filter ((`notElem` mods_to_zap_names).modSummaryName
+                     = filter ((`notElem` mods_to_zap_names).ms_mod
                          modsDone
 
-              let hpt4 = retainInTopLevelEnvs (map modSummaryName mods_to_keep) 
+              let hpt4 = retainInTopLevelEnvs (map ms_mod mods_to_keep) 
                                              (hsc_HPT hsc_env3)
 
              -- Clean up after ourselves
-             cleanTempFilesExcept verb (ppFilesFromSummaries mods_to_keep)
+             cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
 
              -- Link everything together
               linkresult <- link ghci_mode dflags False hpt4
@@ -633,7 +645,7 @@ cmLoadFinish ok Failed cmstate
 -- newly loaded module, or the Prelude if none were loaded.
 cmLoadFinish ok Succeeded cmstate
   = do let new_cmstate = cmstate { cm_ic = emptyInteractiveContext }
-           mods_loaded = map (moduleNameUserString.modSummaryName
+           mods_loaded = map (moduleUserString.ms_mod
                             (cm_mg cmstate)
 
        return (new_cmstate, ok, mods_loaded)
@@ -669,7 +681,7 @@ ppFilesFromSummaries summaries
 getValidLinkables
        :: GhciMode
        -> [Linkable]           -- old linkables
-       -> [ModuleName]         -- all home modules
+       -> [Module]             -- all home modules
        -> [SCC ModSummary]     -- all modules in the program, dependency order
        -> IO ( [Linkable],     -- still-valid linkables 
                [Linkable]      -- new linkables we just found
@@ -689,7 +701,7 @@ getValidLinkables mode old_linkables all_home_mods module_graph = do
 getValidLinkablesSCC mode old_linkables all_home_mods new_linkables scc0
    = let 
          scc             = flattenSCC scc0
-          scc_names       = map modSummaryName scc
+          scc_names       = map ms_mod scc
          home_module m   = m `elem` all_home_mods && m `notElem` scc_names
           scc_allhomeimps = nub (filter home_module (concatMap ms_imps scc))
                -- NB. ms_imps, not ms_allimps above.  We don't want to
@@ -729,7 +741,7 @@ getValidLinkable old_linkables objects_allowed new_linkables summary
        -- have a .o-file linkable.  We only permit it if all the
        -- modules it depends on also have .o files; a .o file can't
        -- link to a bytecode module
-   = do let mod_name = modSummaryName summary
+   = do let mod_name = ms_mod summary
 
        maybe_disk_linkable
           <- if (not objects_allowed)
@@ -795,21 +807,21 @@ hptLinkables hpt = map hm_linkable (moduleEnvElts hpt)
 --     * has an interface in the HPT (interactive mode only)
 
 preUpsweep :: [Linkable]       -- new valid linkables
-           -> [ModuleName]     -- names of all mods encountered in downsweep
-           -> [ModuleName]     -- accumulating stable modules
+           -> [Module]         -- names of all mods encountered in downsweep
+           -> [Module]         -- accumulating stable modules
            -> [SCC ModSummary]  -- scc-ified mod graph, including src imps
-           -> IO [ModuleName]  -- stable modules
+           -> IO [Module]      -- stable modules
 
 preUpsweep valid_lis all_home_mods stable []  = return stable
 preUpsweep valid_lis all_home_mods stable (scc0:sccs)
    = do let scc = flattenSCC scc0
-            scc_allhomeimps :: [ModuleName]
+            scc_allhomeimps :: [Module]
             scc_allhomeimps 
                = nub (filter (`elem` all_home_mods) (concatMap ms_allimps scc))
             all_imports_in_scc_or_stable
                = all in_stable_or_scc scc_allhomeimps
             scc_names
-               = map modSummaryName scc
+               = map ms_mod scc
             in_stable_or_scc m
                = m `elem` scc_names || m `elem` stable
 
@@ -817,7 +829,7 @@ preUpsweep valid_lis all_home_mods stable (scc0:sccs)
            -- have a valid linkable (see getValidLinkables above).
            has_valid_linkable new_summary
              = isJust (findModuleLinkable_maybe valid_lis modname)
-              where modname = modSummaryName new_summary
+              where modname = ms_mod new_summary
 
            scc_is_stable = all_imports_in_scc_or_stable
                          && all has_valid_linkable scc
@@ -830,9 +842,9 @@ preUpsweep valid_lis all_home_mods stable (scc0:sccs)
 -- Helper for preUpsweep.  Assuming that new_summary's imports are all
 -- stable (in the sense of preUpsweep), determine if new_summary is itself
 -- stable, and, if so, in batch mode, return its linkable.
-findInSummaries :: [ModSummary] -> ModuleName -> [ModSummary]
+findInSummaries :: [ModSummary] -> Module -> [ModSummary]
 findInSummaries old_summaries mod_name
-   = [s | s <- old_summaries, modSummaryName s == mod_name]
+   = [s | s <- old_summaries, ms_mod s == mod_name]
 
 findModInSummaries :: [ModSummary] -> Module -> Maybe ModSummary
 findModInSummaries old_summaries mod
@@ -842,14 +854,14 @@ findModInSummaries old_summaries mod
 
 -- Return (names of) all those in modsDone who are part of a cycle
 -- as defined by theGraph.
-findPartiallyCompletedCycles :: [ModuleName] -> [SCC ModSummary] -> [ModuleName]
+findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
 findPartiallyCompletedCycles modsDone theGraph
    = chew theGraph
      where
         chew [] = []
         chew ((AcyclicSCC v):rest) = chew rest    -- acyclic?  not interesting.
         chew ((CyclicSCC vs):rest)
-           = let names_in_this_cycle = nub (map modSummaryName vs)
+           = let names_in_this_cycle = nub (map ms_mod vs)
                  mods_in_this_cycle  
                     = nub ([done | done <- modsDone, 
                                    done `elem` names_in_this_cycle])
@@ -865,7 +877,7 @@ findPartiallyCompletedCycles modsDone theGraph
 -- There better had not be any cyclic groups here -- we check for them.
 upsweep_mods :: HscEnv                 -- Includes up-to-date HPT
              -> [Linkable]             -- Valid linkables
-             -> (ModuleName -> [ModuleName])  -- to construct downward closures
+             -> (Module -> [Module])  -- to construct downward closures
             -> IO ()                 -- how to clean up unwanted tmp files
              -> [SCC ModSummary]      -- mods to do (the worklist)
                                       -- ...... RETURNING ......
@@ -880,16 +892,16 @@ upsweep_mods hsc_env oldUI reachable_from cleanup
 upsweep_mods hsc_env oldUI reachable_from cleanup
      ((CyclicSCC ms):_)
    = do hPutStrLn stderr ("Module imports form a cycle for modules:\n\t" ++
-                          unwords (map (moduleNameUserString.modSummaryName) ms))
+                          unwords (map (moduleUserString.ms_mod) ms))
         return (Failed, hsc_env, [])
 
 upsweep_mods hsc_env oldUI reachable_from cleanup
      ((AcyclicSCC mod):mods)
    = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++ 
-       --           show (map (moduleNameUserString.moduleName.mi_module.hm_iface) (eltsUFM (hsc_HPT hsc_env)))
+       --           show (map (moduleUserString.moduleName.mi_module.hm_iface) (eltsUFM (hsc_HPT hsc_env)))
 
         (ok_flag, hsc_env1) <- upsweep_mod hsc_env oldUI mod 
-                                           (reachable_from (modSummaryName mod))
+                                           (reachable_from (ms_mod mod))
 
        cleanup         -- Remove unwanted tmp files between compilations
 
@@ -906,7 +918,7 @@ upsweep_mods hsc_env oldUI reachable_from cleanup
 upsweep_mod :: HscEnv
             -> UnlinkedImage
             -> ModSummary
-            -> [ModuleName]
+            -> [Module]
             -> IO (SuccessFlag, 
                   HscEnv)              -- With updated HPT
 
@@ -914,17 +926,16 @@ upsweep_mod hsc_env oldUI summary1 reachable_inc_me
    = do 
         let this_mod = ms_mod summary1
            location = ms_location summary1
-           mod_name = moduleName this_mod
            hpt1     = hsc_HPT hsc_env
 
-        let mb_old_iface = case lookupModuleEnvByName hpt1 mod_name of
+        let mb_old_iface = case lookupModuleEnv hpt1 this_mod of
                             Just mod_info -> Just (hm_iface mod_info)
                             Nothing       -> Nothing
 
-        let maybe_old_linkable = findModuleLinkable_maybe oldUI mod_name
+        let maybe_old_linkable = findModuleLinkable_maybe oldUI this_mod
             source_unchanged   = isJust maybe_old_linkable
 
-           reachable_only = filter (/= mod_name) reachable_inc_me
+           reachable_only = filter (/= this_mod) reachable_inc_me
 
           -- In interactive mode, all home modules below us *must* have an
           -- interface in the HPT.  We never demand-load home interfaces in
@@ -964,7 +975,7 @@ upsweep_mod hsc_env oldUI summary1 reachable_inc_me
            CompErrs -> return (Failed, hsc_env)
 
 -- Filter modules in the HPT
-retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
+retainInTopLevelEnvs :: [Module] -> HomePackageTable -> HomePackageTable
 retainInTopLevelEnvs keep_these hpt
    = listToUFM (concatMap (maybeLookupUFM hpt) keep_these)
    where
@@ -973,13 +984,13 @@ retainInTopLevelEnvs keep_these hpt
                                Just val -> [(u, val)] 
 
 -- Needed to clean up HPT so that we don't get duplicates in inst env
-downwards_closure_of_module :: [ModSummary] -> ModuleName -> [ModuleName]
+downwards_closure_of_module :: [ModSummary] -> Module -> [Module]
 downwards_closure_of_module summaries root
-   = let toEdge :: ModSummary -> (ModuleName,[ModuleName])
-         toEdge summ = (modSummaryName summ, 
+   = let toEdge :: ModSummary -> (Module,[Module])
+         toEdge summ = (ms_mod summ, 
                        filter (`elem` all_mods) (ms_allimps summ))
 
-        all_mods = map modSummaryName summaries
+        all_mods = map ms_mod summaries
 
          res = simple_transitive_closure (map toEdge summaries) [root]
      in
@@ -1003,13 +1014,13 @@ simple_transitive_closure graph set
 topological_sort :: Bool -> [ModSummary] -> [SCC ModSummary]
 topological_sort include_source_imports summaries
    = let 
-         toEdge :: ModSummary -> (ModSummary,ModuleName,[ModuleName])
+         toEdge :: ModSummary -> (ModSummary,Module,[Module])
          toEdge summ
-             = (summ, modSummaryName summ, 
+             = (summ, ms_mod summ, 
                       (if include_source_imports 
                        then ms_srcimps summ else []) ++ ms_imps summ)
         
-         mash_edge :: (ModSummary,ModuleName,[ModuleName]) -> (ModSummary,Int,[Int])
+         mash_edge :: (ModSummary,Module,[Module]) -> (ModSummary,Int,[Int])
          mash_edge (summ, m, m_imports)
             = case lookup m key_map of
                  Nothing -> panic "reverse_topological_sort"
@@ -1018,7 +1029,7 @@ topological_sort include_source_imports summaries
                              mapCatMaybes (flip lookup key_map) m_imports)
 
          edges     = map toEdge summaries
-         key_map   = zip [nm | (s,nm,imps) <- edges] [1 ..] :: [(ModuleName,Int)]
+         key_map   = zip [nm | (s,nm,imps) <- edges] [1 ..] :: [(Module,Int)]
          scc_input = map mash_edge edges
          sccs      = stronglyConnComp scc_input
      in
@@ -1036,15 +1047,16 @@ topological_sort include_source_imports summaries
 -- cache to avoid recalculating a module summary if the source is
 -- unchanged.
 
-downsweep :: [FilePath] -> [ModSummary] -> IO [ModSummary]
-downsweep roots old_summaries
+downsweep :: DynFlags -> [FilePath] -> [ModSummary] -> IO [ModSummary]
+downsweep dflags roots old_summaries
    = do rootSummaries <- mapM getRootSummary roots
        checkDuplicates rootSummaries
         all_summaries
            <- loop (concat (map (\ m -> zip (repeat (fromMaybe "<unknown>" (ml_hs_file (ms_location m))))
                                            (ms_imps m)) rootSummaries))
                (mkModuleEnv [ (mod, s) | s <- rootSummaries, 
-                                         let mod = ms_mod s, isHomeModule mod 
+                                         let mod = ms_mod s, 
+                                         isHomeModule dflags mod 
                             ])
         return all_summaries
      where
@@ -1052,14 +1064,14 @@ downsweep roots old_summaries
        getRootSummary file
           | isHaskellSrcFilename file
           = do exists <- doesFileExist file
-               if exists then summariseFile file else do
+               if exists then summariseFile dflags file else do
                throwDyn (CmdLineError ("can't find file `" ++ file ++ "'"))    
           | otherwise
           = do exists <- doesFileExist hs_file
-               if exists then summariseFile hs_file else do
+               if exists then summariseFile dflags hs_file else do
                exists <- doesFileExist lhs_file
-               if exists then summariseFile lhs_file else do
-               let mod_name = mkModuleName file
+               if exists then summariseFile dflags lhs_file else do
+               let mod_name = mkModule file
                maybe_summary <- getSummary (file, mod_name)
                case maybe_summary of
                   Nothing -> packageModErr mod_name
@@ -1084,20 +1096,18 @@ downsweep roots old_summaries
                           [ fromJust (ml_hs_file (ms_location summ'))
                           | summ' <- summaries, ms_mod summ' == modl ]
 
-        getSummary :: (FilePath,ModuleName) -> IO (Maybe ModSummary)
-        getSummary (currentMod,nm)
-           = do found <- findModule nm
+        getSummary :: (FilePath,Module) -> IO (Maybe ModSummary)
+        getSummary (currentMod,mod)
+           = do found <- findModule dflags mod True{-explicit-}
                case found of
-                  Right (mod, location) -> do
+                  Found location pkg -> do
                        let old_summary = findModInSummaries old_summaries mod
-                       summarise mod location old_summary
+                       summarise dflags mod location old_summary
 
-                  Left files -> do
-                       dflags <- getDynFlags
-                       throwDyn (noModError dflags currentMod nm files)
+                  err -> throwDyn (noModError dflags currentMod mod err)
 
         -- loop invariant: env doesn't contain package modules
-        loop :: [(FilePath,ModuleName)] -> ModuleEnv ModSummary -> IO [ModSummary]
+        loop :: [(FilePath,Module)] -> ModuleEnv ModSummary -> IO [ModSummary]
        loop [] env = return (moduleEnvElts env)
         loop imps env
            = do -- imports for modules we don't already have
@@ -1116,16 +1126,8 @@ downsweep roots old_summaries
                                [ (ms_mod s, s) | s <- new_home_summaries ])
 
 -- ToDo: we don't have a proper line number for this error
-noModError dflags loc mod_nm files = ProgramError (showSDoc (
-  hang (text loc <> colon) 4 $
-    (text "Can't find module" <+> quotes (ppr mod_nm) $$ extra)
-  ))
-  where
-   extra
-    | verbosity dflags < 3 =
-        text "(use -v to see a list of the files searched for)"
-    | otherwise =
-        hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
+noModError dflags loc mod_nm err
+  = ProgramError (showSDoc (noIfaceErr dflags mod_nm err))
 
 -----------------------------------------------------------------------------
 -- Summarising modules
@@ -1140,19 +1142,19 @@ noModError dflags loc mod_nm files = ProgramError (showSDoc (
 --     a summary.  The finder is used to locate the file in which the module
 --     resides.
 
-summariseFile :: FilePath -> IO ModSummary
-summariseFile file
-   = do hspp_fn <- preprocess file
-        (srcimps,imps,mod_name) <- getImportsFromFile hspp_fn
+summariseFile :: DynFlags -> FilePath -> IO ModSummary
+summariseFile dflags file
+   = do hspp_fn <- preprocess dflags file
+        (srcimps,imps,mod) <- getImportsFromFile hspp_fn
 
         let -- GHC.Prim doesn't exist physically, so don't go looking for it.
-            the_imps = filter (/= gHC_PRIM_Name) imps
+            the_imps = filter (/= gHC_PRIM) imps
 
-       (mod, location) <- mkHomeModLocation mod_name file
+       location <- mkHomeModLocation mod file
 
         src_timestamp
            <- case ml_hs_file location of 
-                 Nothing     -> noHsFileErr mod_name
+                 Nothing     -> noHsFileErr mod
                  Just src_fn -> getModificationTime src_fn
 
         return (ModSummary { ms_mod = mod, 
@@ -1161,10 +1163,10 @@ summariseFile file
                             ms_hs_date = src_timestamp })
 
 -- Summarise a module, and pick up source and timestamp.
-summarise :: Module -> ModLocation -> Maybe ModSummary
+summarise :: DynFlags -> Module -> ModLocation -> Maybe ModSummary
         -> IO (Maybe ModSummary)
-summarise mod location old_summary
-   | not (isHomeModule mod) = return Nothing
+summarise dflags mod location old_summary
+   | not (isHomeModule dflags mod) = return Nothing
    | otherwise
    = do let hs_fn = expectJust "summarise" (ml_hs_file location)
 
@@ -1179,17 +1181,17 @@ summarise mod location old_summary
           Just s | ms_hs_date s == src_timestamp -> return (Just s);
           _ -> do
 
-        hspp_fn <- preprocess hs_fn
+        hspp_fn <- preprocess dflags hs_fn
         (srcimps,imps,mod_name) <- getImportsFromFile hspp_fn
        let
             -- GHC.Prim doesn't exist physically, so don't go looking for it.
-           the_imps = filter (/= gHC_PRIM_Name) imps
+           the_imps = filter (/= gHC_PRIM) imps
 
-       when (mod_name /= moduleName mod) $
+       when (mod_name /= mod) $
                throwDyn (ProgramError 
                   (showSDoc (text hs_fn
                              <>  text ": file name does not match module name"
-                             <+> quotes (ppr (moduleName mod)))))
+                             <+> quotes (ppr mod))))
 
         return (Just (ModSummary mod location{ml_hspp_file=Just hspp_fn} 
                                  srcimps the_imps src_timestamp))
@@ -1237,8 +1239,8 @@ data ModSummary
    = ModSummary {
         ms_mod      :: Module,                 -- name, package
         ms_location :: ModLocation,            -- location
-        ms_srcimps  :: [ModuleName],           -- source imports
-        ms_imps     :: [ModuleName],           -- non-source imports
+        ms_srcimps  :: [Module],               -- source imports
+        ms_imps     :: [Module],               -- non-source imports
         ms_hs_date  :: ClockTime               -- timestamp of summarised file
      }
 
@@ -1253,7 +1255,4 @@ instance Outputable ModSummary where
             ]
 
 ms_allimps ms = ms_srcimps ms ++ ms_imps ms
-
-modSummaryName :: ModSummary -> ModuleName
-modSummaryName = moduleName . ms_mod
 \end{code}
index 440365d..270d44d 100644 (file)
@@ -43,7 +43,9 @@ import CoreSyn
 import PprCore         ( pprCoreExpr )
 import Var             ( Var, isId, isTyVar )
 import VarEnv
-import Name            ( hashName, isDllName )
+import Name            ( hashName )
+import Packages                ( isDllName )
+import CmdLineOpts     ( DynFlags )
 import Literal         ( hashLiteral, literalType, litIsDupable, 
                          litIsTrivial, isZeroLit, Literal( MachLabel ) )
 import DataCon         ( DataCon, dataConRepArity, dataConArgTys,
@@ -1171,7 +1173,7 @@ If this happens we simply make the RHS into an updatable thunk,
 and 'exectute' it rather than allocating it statically.
 
 \begin{code}
-rhsIsStatic :: CoreExpr -> Bool
+rhsIsStatic :: DynFlags -> CoreExpr -> Bool
 -- This function is called only on *top-level* right-hand sides
 -- Returns True if the RHS can be allocated statically, with
 -- no thunks involved at all.
@@ -1230,33 +1232,33 @@ rhsIsStatic :: CoreExpr -> Bool
 -- When opt_RuntimeTypes is on, we keep type lambdas and treat
 -- them as making the RHS re-entrant (non-updatable).
 
-rhsIsStatic rhs = is_static False rhs
-
-is_static :: Bool      -- True <=> in a constructor argument; must be atomic
-         -> CoreExpr -> Bool
-
-is_static False (Lam b e) = isRuntimeVar b || is_static False e
-
-is_static in_arg (Note (SCC _) e) = False
-is_static in_arg (Note _ e)       = is_static in_arg e
-
-is_static in_arg (Lit lit)
-  = case lit of
-       MachLabel _ _ -> False
-       other         -> True
-       -- A MachLabel (foreign import "&foo") in an argument
-       -- prevents a constructor application from being static.  The
-       -- reason is that it might give rise to unresolvable symbols
-       -- in the object file: under Linux, references to "weak"
-       -- symbols from the data segment give rise to "unresolvable
-       -- relocation" errors at link time This might be due to a bug
-       -- in the linker, but we'll work around it here anyway. 
-       -- SDM 24/2/2004
-
-is_static in_arg other_expr = go other_expr 0
+rhsIsStatic dflags rhs = is_static False rhs
   where
+  is_static :: Bool    -- True <=> in a constructor argument; must be atomic
+         -> CoreExpr -> Bool
+  
+  is_static False (Lam b e) = isRuntimeVar b || is_static False e
+  
+  is_static in_arg (Note (SCC _) e) = False
+  is_static in_arg (Note _ e)       = is_static in_arg e
+  
+  is_static in_arg (Lit lit)
+    = case lit of
+       MachLabel _ _ -> False
+       other         -> True
+       -- A MachLabel (foreign import "&foo") in an argument
+       -- prevents a constructor application from being static.  The
+       -- reason is that it might give rise to unresolvable symbols
+       -- in the object file: under Linux, references to "weak"
+       -- symbols from the data segment give rise to "unresolvable
+       -- relocation" errors at link time This might be due to a bug
+       -- in the linker, but we'll work around it here anyway. 
+       -- SDM 24/2/2004
+  
+  is_static in_arg other_expr = go other_expr 0
+   where
     go (Var f) n_val_args
-       | not (isDllName (idName f))
+       | not (isDllName dflags (idName f))
        =  saturated_data_con f n_val_args
        || (in_arg && n_val_args == 0)  
                -- A naked un-applied variable is *not* deemed a static RHS
index da88848..d148b2b 100644 (file)
@@ -232,7 +232,7 @@ make_var_id :: Name -> C.Id
 make_var_id = make_id True
 
 make_mid :: Module -> C.Id
-make_mid = moduleNameString . moduleName
+make_mid = moduleString
 
 make_qid :: Bool -> Name -> C.Qual C.Id
 make_qid is_var n = (mname,make_id is_var n)
index e7ae7ee..39f3978 100644 (file)
@@ -8,7 +8,7 @@ module Desugar ( deSugar, deSugarExpr ) where
 
 #include "HsVersions.h"
 
-import CmdLineOpts     ( DynFlag(..), dopt, opt_SccProfilingOn )
+import CmdLineOpts     ( DynFlag(..), DynFlags(..), dopt, opt_SccProfilingOn )
 import HscTypes                ( ModGuts(..), ModGuts, HscEnv(..), GhciMode(..),
                          Dependencies(..), TypeEnv, IsBootInterface, unQualInScope )
 import HsSyn           ( RuleDecl(..), RuleBndr(..), HsExpr(..), LHsExpr,
@@ -26,7 +26,7 @@ import DsBinds                ( dsHsBinds, AutoScc(..) )
 import DsForeign       ( dsForeigns )
 import DsExpr          ()      -- Forces DsExpr to be compiled; DsBinds only
                                -- depends on DsExpr.hi-boot.
-import Module          ( Module, ModuleName, moduleEnvElts, delModuleEnv, moduleNameFS )
+import Module          ( Module, moduleEnvElts, delModuleEnv, moduleFS )
 import Id              ( Id )
 import RdrName         ( GlobalRdrEnv )
 import NameSet
@@ -35,7 +35,7 @@ import VarSet
 import Bag             ( Bag, isEmptyBag, mapBag, emptyBag, bagToList )
 import CoreLint                ( showPass, endPass )
 import CoreFVs         ( ruleRhsFreeVars )
-import Packages                ( thPackage )
+import Packages                ( PackageState(thPackageId) )
 import ErrUtils                ( doIfSet, dumpIfSet_dyn, pprBagOfWarnings, 
                          mkWarnMsg, errorsFound, WarnMsg )
 import ListSetOps      ( insertList )
@@ -113,8 +113,11 @@ deSugar hsc_env
        ; dfun_uses <- readIORef dfun_uses_var          -- What dfuns are used
        ; th_used   <- readIORef th_var                 -- Whether TH is used
        ; let used_names = allUses dus `unionNameSets` dfun_uses
-             pkgs | th_used   = insertList thPackage (imp_dep_pkgs imports)
-                  | otherwise = imp_dep_pkgs imports
+             thPackage = thPackageId (pkgState dflags)
+             pkgs | Just th_id <- thPackage, th_used
+                  = insertList th_id  (imp_dep_pkgs imports)
+                  | otherwise
+                  = imp_dep_pkgs imports
 
              dep_mods = moduleEnvElts (delModuleEnv (imp_dep_mods imports) mod)
                -- M.hi-boot can be in the imp_dep_mods, but we must remove
@@ -129,11 +132,11 @@ deSugar hsc_env
        ; usages <- mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
 
        ; let 
-               -- ModuleNames don't compare lexicographically usually, 
+               -- Modules don't compare lexicographically usually, 
                -- but we want them to do so here.
-            le_mod :: ModuleName -> ModuleName -> Bool  
-            le_mod m1 m2 = moduleNameFS m1 <= moduleNameFS m2
-            le_dep_mod :: (ModuleName, IsBootInterface) -> (ModuleName, IsBootInterface) -> Bool        
+            le_mod :: Module -> Module -> Bool  
+            le_mod m1 m2 = moduleFS m1 <= moduleFS m2
+            le_dep_mod :: (Module, IsBootInterface) -> (Module, IsBootInterface) -> Bool        
             le_dep_mod (m1,_) (m2,_) = m1 `le_mod` m2
 
             deps = Deps { dep_mods  = sortLe le_dep_mod dep_mods,
index 92918a2..34eb1ae 100644 (file)
@@ -37,7 +37,7 @@ import OccName          ( isDataOcc, isTvOcc, occNameUserString )
 -- ws previously used in this file.
 import qualified OccName
 
-import Module    ( Module, mkModule, mkModuleName, moduleUserString )
+import Module    ( Module, mkModule, moduleUserString )
 import Id         ( Id, mkLocalId )
 import OccName   ( mkOccFS )
 import Name       ( Name, mkExternalName, localiseName, nameOccName, nameModule, 
@@ -53,7 +53,6 @@ import SrcLoc   ( noSrcLoc, unLoc, Located(..), SrcSpan, srcLocSpan )
 import Maybe     ( catMaybes )
 import Unique    ( mkPreludeTyConUnique, mkPreludeMiscIdUnique, getKey, Uniquable(..) )
 import BasicTypes ( isBoxed ) 
-import Packages          ( thPackage )
 import Outputable
 import Bag       ( bagToList )
 import FastString ( unpackFS )
@@ -1388,13 +1387,9 @@ templateHaskellNames = [
     typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
     fieldPatQTyConName, fieldExpQTyConName, funDepTyConName]
 
-tH_SYN_Name = mkModuleName "Language.Haskell.TH.Syntax"
-tH_LIB_Name = mkModuleName "Language.Haskell.TH.Lib"
-
 thSyn :: Module
--- NB: the TH.Syntax module comes from the "template-haskell" package
-thSyn = mkModule thPackage  tH_SYN_Name
-thLib = mkModule thPackage  tH_LIB_Name
+thSyn = mkModule "Language.Haskell.TH.Syntax"
+thLib = mkModule "Language.Haskell.TH.Lib"
 
 mk_known_key_name mod space str uniq 
   = mkExternalName uniq mod (mkOccFS space str) 
index 5660d66..719714e 100644 (file)
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.179 2004/11/12 15:51:37 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.180 2004/11/26 16:20:36 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -16,9 +16,9 @@ module InteractiveUI (
 #include "HsVersions.h"
 
 import CompManager
-import HscTypes                ( TyThing(..), HomeModInfo(hm_linkable), HomePackageTable,
+import HscTypes                ( HomeModInfo(hm_linkable), HomePackageTable,
                          isObjectLinkable, GhciMode(..) )
-import IfaceSyn                ( IfaceType, IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..), IfaceConDecl(..), 
+import IfaceSyn                ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..), IfaceConDecl(..), 
                          IfaceInst(..), pprIfaceDeclHead, pprParendIfaceType, pprIfaceForAllPart )
 import FunDeps         ( pprFundeps )
 import DriverFlags
@@ -27,14 +27,11 @@ import DriverUtil   ( remove_spaces )
 import Linker          ( showLinkerState, linkPackages )
 import Util
 import Module          ( showModMsg, lookupModuleEnv )
-import Name            ( Name, isHomePackageName, nameSrcLoc, nameOccName,
-                         NamedThing(..) )
+import Name            ( Name, NamedThing(..) )
 import OccName         ( OccName, isSymOcc, occNameUserString )
-import BasicTypes      ( StrictnessMark(..), Fixity, defaultFixity, SuccessFlag(..) )
-import Packages
+import BasicTypes      ( StrictnessMark(..), defaultFixity, SuccessFlag(..) )
 import Outputable
-import CmdLineOpts     ( DynFlag(..), DynFlags(..), getDynFlags, saveDynFlags,
-                         restoreDynFlags, dopt_unset )
+import CmdLineOpts     ( DynFlag(..), DynFlags(..), dopt_unset )
 import Panic           hiding ( showException )
 import Config
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )
@@ -154,9 +151,8 @@ helpText =
  "                         (eg. -v2, -fglasgow-exts, etc.)\n"
 
 
-interactiveUI :: [FilePath] -> Maybe String -> IO ()
-interactiveUI srcs maybe_expr = do
-   dflags <- getDynFlags
+interactiveUI :: DynFlags -> [FilePath] -> Maybe String -> IO ()
+interactiveUI dflags srcs maybe_expr = do
 
    cmstate <- cmInit Interactive dflags;
 
@@ -391,12 +387,10 @@ runStmt stmt
  | null (filter (not.isSpace) stmt) = return []
  | otherwise
  = do st <- getGHCiState
-      dflags <- io getDynFlags
-      let cm_state' = cmSetDFlags (cmstate st)
-                                 (dopt_unset dflags Opt_WarnUnusedBinds)
+      cmstate <- getCmState
       (new_cmstate, result) <- 
        io $ withProgName (progname st) $ withArgs (args st) $
-            cmRunStmt cm_state' stmt
+            cmRunStmt cmstate stmt
       setGHCiState st{cmstate = new_cmstate}
       case result of
        CmRunFailed      -> return []
@@ -617,7 +611,7 @@ addModule files = do
   (cmstate1, ok, mods) <- io (cmLoadModules (cmstate state) graph)
   setGHCiState state{ cmstate = cmstate1, targets = new_targets }
   setContextAfterLoad mods
-  dflags <- io getDynFlags
+  dflags <- getDynFlags
   modulesLoadedMsg ok mods dflags
 
 changeDirectory :: String -> GHCi ()
@@ -697,7 +691,7 @@ loadModule' files = do
   setGHCiState state{ cmstate = cmstate2, targets = files }
 
   setContextAfterLoad mods
-  dflags <- io (getDynFlags)
+  dflags <- getDynFlags
   modulesLoadedMsg ok mods dflags
 
 
@@ -716,7 +710,7 @@ reloadModule "" = do
                <- io (cmLoadModules (cmstate state) graph)
         setGHCiState state{ cmstate=cmstate1 }
        setContextAfterLoad mods
-       dflags <- io getDynFlags
+       dflags <- getDynFlags
        modulesLoadedMsg ok mods dflags
 
 reloadModule _ = noArgs ":reload"
@@ -894,26 +888,21 @@ setOptions wds =
       mapM_ setOpt plus_opts
 
       -- now, the GHC flags
-      pkgs_before <- io (readIORef v_ExplicitPackages)
-      leftovers   <- io (processArgs static_flags minus_opts [])
-      pkgs_after  <- io (readIORef v_ExplicitPackages)
-
-      -- update things if the users wants more packages
-      let new_packages = pkgs_after \\ pkgs_before
-      when (not (null new_packages)) $
-        newPackages new_packages
-
-      -- don't forget about the extra command-line flags from the 
-      -- extra_ghc_opts fields in the new packages
-      new_package_details <- io (getPackageDetails new_packages)
+      leftovers <- io $ processStaticFlags minus_opts
 
       -- then, dynamic flags
-      io $ do 
-       restoreDynFlags
-        leftovers <- processArgs dynamic_flags leftovers []
-       saveDynFlags
-
-        if (not (null leftovers))
+      dflags <- getDynFlags
+      (dflags',leftovers) <- io $ processDynamicFlags leftovers dflags
+      setDynFlags dflags'
+
+        -- update things if the users wants more packages
+{- TODO:
+        let new_packages = pkgs_after \\ pkgs_before
+        when (not (null new_packages)) $
+          newPackages new_packages
+-}
+
+      if (not (null leftovers))
                then throwDyn (CmdLineError ("unrecognised flags: " ++ 
                                                unwords leftovers))
                else return ()
@@ -968,7 +957,7 @@ newPackages new_pkgs = do   -- The new packages are already in v_Packages
   state    <- getGHCiState
   cmstate1 <- io (cmUnload (cmstate state))
   setGHCiState state{ cmstate = cmstate1, targets = [] }
-  dflags   <- io getDynFlags
+  dflags   <- getDynFlags
   io (linkPackages dflags new_pkgs)
   setContextAfterLoad []
 
@@ -1048,6 +1037,10 @@ setGHCiState s = GHCi $ \r -> writeIORef r s
 getCmState = getGHCiState >>= return . cmstate
 setCmState cms = do s <- getGHCiState; setGHCiState s{cmstate=cms}
 
+getDynFlags = getCmState >>= return . cmGetDFlags
+
+setDynFlags dflags = do s <- getCmState; setCmState (cmSetDFlags s dflags)
+
 isOptionSet :: GHCiOption -> GHCi Bool
 isOptionSet opt
  = do st <- getGHCiState
index 1ac21e3..5b59b9d 100644 (file)
@@ -29,20 +29,20 @@ import ByteCodeItbls        ( ItblEnv )
 import ByteCodeAsm     ( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
 
 import Packages
-import DriverState     ( v_Library_paths, v_Opt_l, v_Ld_inputs, getStaticOpts, v_ExplicitPackages )
+import DriverState     ( v_Library_paths, v_Opt_l, v_Ld_inputs, getStaticOpts )
 import DriverPhases    ( isObjectFilename, isDynLibFilename )
 import DriverUtil      ( getFileSuffix )
 #ifdef darwin_TARGET_OS
 import DriverState     ( v_Cmdline_frameworks, v_Framework_paths )
 #endif
-import Finder          ( findModule, findLinkable )
+import Finder          ( findModule, findLinkable, FindResult(..) )
 import HscTypes
-import Name            ( Name, nameModule, nameModuleName, isExternalName, isWiredInName )
+import Name            ( Name, nameModule, isExternalName, isWiredInName )
 import NameEnv
 import NameSet         ( nameSetToList )
 import Module
 import ListSetOps      ( minusList )
-import CmdLineOpts     ( DynFlags(verbosity), getDynFlags )
+import CmdLineOpts     ( DynFlags(..) )
 import BasicTypes      ( SuccessFlag(..), succeeded, failed )
 import Outputable
 import Panic            ( GhcException(..) )
@@ -106,22 +106,25 @@ data PersistentLinkerState
        -- The currently-loaded packages; always object code
        -- Held, as usual, in dependency order; though I am not sure if
        -- that is really important
-       pkgs_loaded :: [PackageName]
+       pkgs_loaded :: [PackageId]
      }
 
-emptyPLS :: PersistentLinkerState
-emptyPLS = PersistentLinkerState { closure_env = emptyNameEnv,
-                                   itbl_env    = emptyNameEnv,
-                                  pkgs_loaded = init_pkgs_loaded,
-                                  bcos_loaded = [],
-                                  objs_loaded = [] }
+emptyPLS :: DynFlags -> PersistentLinkerState
+emptyPLS dflags = PersistentLinkerState { 
+                       closure_env = emptyNameEnv,
+                       itbl_env    = emptyNameEnv,
+                       pkgs_loaded = init_pkgs,
+                       bcos_loaded = [],
+                       objs_loaded = [] }
+  -- Packages that don't need loading, because the compiler 
+  -- shares them with the interpreted program.
+  --
+  -- The linker's symbol table is populated with RTS symbols using an
+  -- explicit list.  See rts/Linker.c for details.
+  where init_pkgs
+         | Just rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
+         | otherwise = []
 
--- Packages that don't need loading, because the compiler 
--- shares them with the interpreted program.
---
--- The linker's symbol table is populated with RTS symbols using an
--- explicit list.  See rts/Linker.c for details.
-init_pkgs_loaded = [ FSLIT("rts") ]
 \end{code}
 
 \begin{code}
@@ -139,12 +142,12 @@ extendLinkEnv new_bindings
 --     (these are the temporary bindings from the command line).
 -- Used to filter both the ClosureEnv and ItblEnv
 
-filterNameMap :: [ModuleName] -> NameEnv (Name, a) -> NameEnv (Name, a)
+filterNameMap :: [Module] -> NameEnv (Name, a) -> NameEnv (Name, a)
 filterNameMap mods env 
    = filterNameEnv keep_elt env
    where
      keep_elt (n,_) = isExternalName n 
-                     && (nameModuleName n `elem` mods)
+                     && (nameModule n `elem` mods)
 \end{code}
 
 
@@ -184,28 +187,25 @@ d) Loading any .o/.dll files specified on the command line,
 e) Loading any MacOS frameworks
 
 \begin{code}
-initDynLinker :: IO ()
+initDynLinker :: DynFlags -> IO ()
 -- This function is idempotent; if called more than once, it does nothing
 -- This is useful in Template Haskell, where we call it before trying to link
-initDynLinker 
+initDynLinker dflags
   = do { done <- readIORef v_InitLinkerDone
        ; if done then return () 
                  else do { writeIORef v_InitLinkerDone True
-                         ; reallyInitDynLinker }
+                         ; reallyInitDynLinker dflags }
        }
 
-reallyInitDynLinker
-  = do  { dflags <- getDynFlags
-
-               -- Initialise the linker state
-       ; writeIORef v_PersistentLinkerState emptyPLS
+reallyInitDynLinker dflags
+  = do  {  -- Initialise the linker state
+       ; writeIORef v_PersistentLinkerState (emptyPLS dflags)
 
                -- (a) initialise the C dynamic linker
        ; initObjLinker 
 
                -- (b) Load packages from the command-line
-       ; expl <- readIORef v_ExplicitPackages
-       ; linkPackages dflags expl
+       ; linkPackages dflags (explicitPackages (pkgState dflags))
 
                -- (c) Link libraries from the command-line
        ; opt_l  <- getStaticOpts v_Opt_l
@@ -315,11 +315,12 @@ linkExpr :: HscEnv -> UnlinkedBCO -> IO HValue
 linkExpr hsc_env root_ul_bco
   = do {  
        -- Initialise the linker (if it's not been done already)
-     initDynLinker
+     let dflags = hsc_dflags hsc_env
+   ; initDynLinker dflags
 
        -- Find what packages and linkables are required
    ; eps <- readIORef (hsc_EPS hsc_env)
-   ; (lnks, pkgs) <- getLinkDeps hpt (eps_PIT eps) needed_mods
+   ; (lnks, pkgs) <- getLinkDeps dflags hpt (eps_PIT eps) needed_mods
 
        -- Link the packages and modules required
    ; linkPackages dflags pkgs
@@ -354,12 +355,12 @@ linkExpr hsc_env root_ul_bco
  
 dieWith msg = throwDyn (ProgramError (showSDoc msg))
 
-getLinkDeps :: HomePackageTable -> PackageIfaceTable
+getLinkDeps :: DynFlags -> HomePackageTable -> PackageIfaceTable
            -> [Module]                         -- If you need these
-           -> IO ([Linkable], [PackageName])   -- ... then link these first
+           -> IO ([Linkable], [PackageId])     -- ... then link these first
 -- Fails with an IO exception if it can't find enough files
 
-getLinkDeps hpt pit mods
+getLinkDeps dflags hpt pit mods
 -- Find all the packages and linkables that a set of modules depends on
  = do {        pls <- readIORef v_PersistentLinkerState ;
        let {
@@ -371,7 +372,7 @@ getLinkDeps hpt pit mods
            mods_needed = nub (concat mods_s) `minusList` linked_mods     ;
            pkgs_needed = nub (concat pkgs_s) `minusList` pkgs_loaded pls ;
 
-           linked_mods = map linkableModName (objs_loaded pls ++ bcos_loaded pls)
+           linked_mods = map linkableModule (objs_loaded pls ++ bcos_loaded pls)
        } ;
        
        -- 3.  For each dependent module, find its linkable
@@ -381,14 +382,14 @@ getLinkDeps hpt pit mods
 
        return (lnks_needed, pkgs_needed) }
   where
-    get_deps :: Module -> ([ModuleName],[PackageName])
+    get_deps :: Module -> ([Module],[PackageId])
        -- Get the things needed for the specified module
        -- This is rather similar to the code in RnNames.importsFromImportDecl
     get_deps mod
-       | isHomeModule (mi_module iface) 
-       = (moduleName mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
+       | ExternalPackage p <- mi_package iface
+       = ([], p : dep_pkgs deps)
        | otherwise
-       = ([], mi_package iface : dep_pkgs deps)
+       = (mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
        where
          iface = get_iface mod
          deps  = mi_deps iface
@@ -403,22 +404,24 @@ getLinkDeps hpt pit mods
        -- This one is a build-system bug
 
     get_linkable mod_name      -- A home-package module
-       | Just mod_info <- lookupModuleEnvByName hpt mod_name 
+       | Just mod_info <- lookupModuleEnv hpt mod_name 
        = return (hm_linkable mod_info)
        | otherwise     
        =       -- It's not in the HPT because we are in one shot mode, 
                -- so use the Finder to get a ModLocation...
-         do { mb_stuff <- findModule mod_name ;
+         do { mb_stuff <- findModule dflags mod_name False ;
               case mb_stuff of {
-                 Left _ -> no_obj mod_name ;
-                 Right (_, loc) -> do {
+                 Found loc _ -> found loc mod_name ;
+                 _ -> no_obj mod_name
+            }}
 
+    found loc mod_name = do {
                -- ...and then find the linkable for it
               mb_lnk <- findLinkable mod_name loc ;
               case mb_lnk of {
                  Nothing -> no_obj mod_name ;
                  Just lnk -> return lnk
-         }}}} 
+             }}
 \end{code}
 
 
@@ -461,7 +464,7 @@ partitionLinkable li
             other
                -> [li]
 
-findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
+findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
 findModuleLinkable_maybe lis mod
    = case [LM time nm us | LM time nm us <- lis, nm == mod] of
         []   -> Nothing
@@ -470,7 +473,7 @@ findModuleLinkable_maybe lis mod
 
 linkableInSet :: Linkable -> [Linkable] -> Bool
 linkableInSet l objs_loaded =
-  case findModuleLinkable_maybe objs_loaded (linkableModName l) of
+  case findModuleLinkable_maybe objs_loaded (linkableModule l) of
        Nothing -> False
        Just m  -> linkableTime l == linkableTime m
 \end{code}
@@ -642,7 +645,7 @@ unload_wkr dflags linkables pls
        objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
         bcos_loaded' <- filterM (maybeUnload bcos_to_keep) (bcos_loaded pls)
 
-               let bcos_retained = map linkableModName bcos_loaded'
+               let bcos_retained = map linkableModule bcos_loaded'
            itbl_env'     = filterNameMap bcos_retained (itbl_env pls)
             closure_env'  = filterNameMap bcos_retained (closure_env pls)
            new_pls = pls { itbl_env = itbl_env',
@@ -713,7 +716,7 @@ showLS (DLL nm)       = "(dynamic) " ++ nm
 showLS (DLLPath nm)   = "(dynamic) " ++ nm
 showLS (Framework nm) = "(framework) " ++ nm
 
-linkPackages :: DynFlags -> [PackageName] -> IO ()
+linkPackages :: DynFlags -> [PackageId] -> IO ()
 -- Link exactly the specified packages, and their dependents
 -- (unless of course they are already linked)
 -- The dependents are linked automatically, and it doesn't matter
@@ -728,14 +731,14 @@ linkPackages :: DynFlags -> [PackageName] -> IO ()
 
 linkPackages dflags new_pkgs
    = do        { pls     <- readIORef v_PersistentLinkerState
-       ; pkg_map <- getPackageConfigMap
+       ; let pkg_map = pkgIdMap (pkgState dflags)
 
        ; pkgs' <- link pkg_map (pkgs_loaded pls) new_pkgs
 
        ; writeIORef v_PersistentLinkerState (pls { pkgs_loaded = pkgs' })
        }
    where
-     link :: PackageConfigMap -> [PackageName] -> [PackageName] -> IO [PackageName]
+     link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
      link pkg_map pkgs new_pkgs 
        = foldM (link_one pkg_map) pkgs new_pkgs
 
@@ -743,15 +746,15 @@ linkPackages dflags new_pkgs
        | new_pkg `elem` pkgs   -- Already linked
        = return pkgs
 
-       | Just pkg_cfg <- lookupPkg pkg_map new_pkg
+       | Just pkg_cfg <- lookupPackage pkg_map new_pkg
        = do {  -- Link dependents first
-              pkgs' <- link pkg_map pkgs (packageDependents pkg_cfg)
+              pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
                -- Now link the package itself
             ; linkPackage dflags pkg_cfg
             ; return (new_pkg : pkgs') }
 
        | otherwise
-       = throwDyn (CmdLineError ("unknown package name: " ++ packageNameString new_pkg))
+       = throwDyn (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
 
 
 linkPackage :: DynFlags -> PackageConfig -> IO ()
index 7343a8b..a57fd76 100644 (file)
@@ -16,7 +16,7 @@ import Language.Haskell.TH.Syntax as TH
 import HsSyn as Hs
 import qualified Class (FunDep)
 import RdrName ( RdrName, mkRdrUnqual, mkRdrQual, mkOrig, nameRdrName, getRdrName )
-import Module   ( ModuleName, mkModuleName )
+import Module   ( Module, mkModule )
 import RdrHsSyn        ( mkHsIntegral, mkHsFractional, mkClassDecl, mkTyData )
 import Name    ( mkInternalName )
 import qualified OccName
@@ -422,8 +422,8 @@ mk_uniq u = mkUniqueGrimily (I# u)
 mk_occ :: OccName.NameSpace -> TH.OccName -> OccName.OccName
 mk_occ ns occ = OccName.mkOccFS ns (mkFastString (TH.occString occ))
 
-mk_mod :: TH.ModName -> ModuleName
-mk_mod mod = mkModuleName (TH.modString mod)
+mk_mod :: TH.ModName -> Module
+mk_mod mod = mkModule (TH.modString mod)
 
 mkDynName :: OccName.NameSpace -> TH.OccName -> RdrName
 -- Parse the string to see if it has a "." in it
@@ -440,6 +440,6 @@ mkDynName ns th_occ
     split occ (c:rev)   = split (c:occ) rev
 
     mk_occ occ = OccName.mkOccFS ns (mkFastString occ)
-    mk_mod mod = mkModuleName mod
+    mk_mod mod = mkModule mod
 \end{code}
 
index f63d86a..220afb7 100644 (file)
@@ -8,7 +8,7 @@ module HsImpExp where
 
 #include "HsVersions.h"
 
-import Module          ( ModuleName )
+import Module          ( Module )
 import Outputable
 import FastString
 import SrcLoc          ( Located(..) )
@@ -26,10 +26,10 @@ One per \tr{import} declaration in a module.
 type LImportDecl name = Located (ImportDecl name)
 
 data ImportDecl name
-  = ImportDecl   (Located ModuleName)          -- module name
+  = ImportDecl   (Located Module)              -- module name
                  Bool                          -- True <=> {-# SOURCE #-} import
                  Bool                          -- True => qualified
-                 (Maybe ModuleName)            -- as Module
+                 (Maybe Module)                -- as Module
                  (Maybe (Bool, [LIE name]))    -- (True => hiding, names)
 \end{code}
 
@@ -72,7 +72,7 @@ data IE name
   | IEThingAbs          name           -- Class/Type (can't tell)
   | IEThingAll          name           -- Class/Type plus all methods/constructors
   | IEThingWith                name [name]     -- Class/Type plus some methods/constructors
-  | IEModuleContents    ModuleName     -- (Export Only)
+  | IEModuleContents    Module         -- (Export Only)
 \end{code}
 
 \begin{code}
index 286c612..0d9f619 100644 (file)
@@ -16,7 +16,6 @@ import IfaceSyn
 import VarEnv
 import Class           ( DefMeth(..) )
 import CostCentre
-import Module          ( moduleName, mkModule )
 import DriverState     ( v_Build_tag )
 import CmdLineOpts     ( opt_HiVersion )
 import Kind            ( Kind(..) )
@@ -95,7 +94,7 @@ instance Binary ModIface where
    put_ bh (ModIface {
                 mi_module    = mod,
                 mi_mod_vers  = mod_vers,
-                mi_package   = pkg_name,
+                mi_package   = _, -- we ignore the package on output
                 mi_orphan    = orphan,
                 mi_deps      = deps,
                 mi_usages    = usages,
@@ -110,8 +109,7 @@ instance Binary ModIface where
        put_ bh (show opt_HiVersion)
        build_tag <- readIORef v_Build_tag
        put  bh build_tag
-       put_ bh pkg_name
-       put_ bh (moduleName mod)
+       put_ bh mod
        put_ bh mod_vers
        put_ bh orphan
        lazyPut bh deps
@@ -145,7 +143,6 @@ instance Binary ModIface where
                "mismatched interface file ways: expected "
                ++ build_tag ++ ", found " ++ check_way))
 
-       pkg_name  <- get bh
        mod_name  <- get bh
 
        mod_vers  <- get bh
@@ -161,12 +158,8 @@ instance Binary ModIface where
        rules     <- {-# SCC "bin_rules" #-} lazyGet bh
        rule_vers <- get bh
        return (ModIface {
-                mi_package   = pkg_name,
-                mi_module    = mkModule pkg_name mod_name,
-                       -- We write the module as a ModuleName, becuase whether
-                       -- or not it's a home-package module depends on the importer
-                       -- mkModule reconstructs the Module, by comparing the static 
-                       -- opt_InPackage flag with the package name in the interface file
+                mi_package   = ThisPackage, -- to be filled in properly later
+                mi_module    = mod_name,
                 mi_mod_vers  = mod_vers,
                 mi_boot      = False,          -- Binary interfaces are never .hi-boot files!
                 mi_orphan    = orphan,
index 6922ac9..d639e96 100644 (file)
@@ -29,9 +29,9 @@ import Name           ( Name, nameUnique, nameModule,
                          mkExternalName, mkInternalName )
 import OccName         ( OccName, isTupleOcc_maybe, tcName, dataName,
                          lookupOccEnv, unitOccEnv, extendOccEnv, extendOccEnvList )
-import PrelNames       ( gHC_PRIM_Name, pREL_TUP_Name )
-import Module          ( Module, ModuleName, moduleName, mkPackageModule
-                         emptyModuleEnv, lookupModuleEnvByName, extendModuleEnv_C )
+import PrelNames       ( gHC_PRIM, pREL_TUP )
+import Module          ( Module, mkModule, emptyModuleEnv
+                         lookupModuleEnv, extendModuleEnv_C )
 import UniqSupply      ( UniqSupply, splitUniqSupply, uniqFromSupply, uniqsFromSupply )
 import FiniteMap       ( emptyFM, lookupFM, addToFM )
 import BasicTypes      ( IPName(..), mapIPName )
@@ -71,7 +71,7 @@ allocateGlobalBinder
   -> Module -> OccName -> Maybe Name -> SrcLoc 
   -> (NameCache, Name)
 allocateGlobalBinder name_supply mod occ mb_parent loc
-  = case lookupOrigNameCache (nsNames name_supply) (moduleName mod) occ of
+  = case lookupOrigNameCache (nsNames name_supply) mod occ of
        -- A hit in the cache!  We are at the binding site of the name.
        -- This is the moment when we know the defining Module and SrcLoc
        -- of the Name, so we set these fields in the Name we return.
@@ -126,12 +126,8 @@ newImplicitBinder base_name mk_sys_occ
                    Just parent_name  -> parent_name
                    Nothing           -> base_name
 
-lookupOrig :: ModuleName -> OccName -> TcRnIf a b Name
--- This one starts with a ModuleName, not a Module, because 
--- we may be simply looking at an occurrence M.x in an interface file.
--- We may enounter this well before finding the binding site for M.x
---
--- So, even if we get a miss in the original-name cache, we 
+lookupOrig :: Module -> OccName -> TcRnIf a b Name
+-- Even if we get a miss in the original-name cache, we 
 -- make a new External Name. 
 -- We fake up 
 --     Module to AnotherPackage
@@ -139,8 +135,8 @@ lookupOrig :: ModuleName -> OccName -> TcRnIf a b Name
 --     Parent no Nothing
 -- They'll be overwritten, in due course, by LoadIface.loadDecl.
 
-lookupOrig mod_name occ 
-  = do         {       -- First ensure that mod_name and occ are evaluated
+lookupOrig mod occ 
+  = do         {       -- First ensure that mod and occ are evaluated
                -- If not, chaos can ensue:
                --      we read the name-cache
                --      then pull on mod (say)
@@ -149,20 +145,15 @@ lookupOrig mod_name occ
          mod `seq` occ `seq` return () 
     
        ; name_supply <- getNameCache
-       ; case lookupOrigNameCache (nsNames name_supply) mod_name occ of {
+       ; case lookupOrigNameCache (nsNames name_supply) mod occ of {
              Just name -> returnM name ;
              Nothing   -> do 
 
        { let { (us', us1)      = splitUniqSupply (nsUniqs name_supply)
              ; uniq            = uniqFromSupply us1
-             ; name            = mkExternalName uniq tmp_mod occ Nothing noSrcLoc
-             ; new_cache       = extend_name_cache (nsNames name_supply) tmp_mod occ name
+             ; name            = mkExternalName uniq mod occ Nothing noSrcLoc
+             ; new_cache       = extend_name_cache (nsNames name_supply) mod occ name
              ; new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
-             ; tmp_mod         = mkPackageModule mod_name 
-                       -- Guess at the package-ness for now, becuase we don't know whether
-                       -- this imported module is from the home package or not.
-                       -- If we ever need it, we'll open its interface, and update the cache
-                       -- with a better name (newGlobalBinder)
          }
        ; setNameCache new_name_supply
        ; return name }
@@ -191,10 +182,10 @@ newIPName occ_name_ip
        Local helper functions (not exported)
 
 \begin{code}
-lookupOrigNameCache :: OrigNameCache -> ModuleName -> OccName -> Maybe Name
-lookupOrigNameCache nc mod_name occ
-  | mod_name == pREL_TUP_Name || mod_name == gHC_PRIM_Name,    -- Boxed tuples from one, 
-    Just tup_info <- isTupleOcc_maybe occ                      -- unboxed from the other
+lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
+lookupOrigNameCache nc mod occ
+  | mod == pREL_TUP || mod == gHC_PRIM,                -- Boxed tuples from one, 
+    Just tup_info <- isTupleOcc_maybe occ      -- unboxed from the other
   =    -- Special case for tuples; there are too many
        -- of them to pre-populate the original-name cache
     Just (mk_tup_name tup_info)
@@ -204,8 +195,8 @@ lookupOrigNameCache nc mod_name occ
        | ns == dataName = dataConName (tupleCon boxity arity)
        | otherwise      = varName (dataConWorkId (tupleCon boxity arity))
 
-lookupOrigNameCache nc mod_name occ    -- The normal case
-  = case lookupModuleEnvByName nc mod_name of
+lookupOrigNameCache nc mod occ -- The normal case
+  = case lookupModuleEnv nc mod of
        Nothing      -> Nothing
        Just occ_env -> lookupOccEnv occ_env occ
 
index 2edcfc8..9fd2d3b 100644 (file)
@@ -60,9 +60,9 @@ import Class          ( FunDep, DefMeth, classExtraBigSig, classTyCon )
 import OccName         ( OccName, OccEnv, lookupOccEnv, emptyOccEnv, 
                          lookupOccEnv, extendOccEnv, emptyOccEnv,
                          OccSet, unionOccSets, unitOccSet )
-import Name            ( Name, NamedThing(..), getOccName, nameOccName, nameModuleName, isExternalName )
+import Name            ( Name, NamedThing(..), getOccName, nameOccName, nameModule, isExternalName )
 import NameSet         ( NameSet, elemNameSet )
-import Module          ( ModuleName )
+import Module          ( Module )
 import CostCentre      ( CostCentre, pprCostCentreCore )
 import Literal         ( Literal )
 import ForeignCall     ( ForeignCall )
@@ -558,7 +558,7 @@ dfunToIfaceInst dfun_id
                ifInstHead = toIfaceType (mkLhsNameFn mod) tidy_ty }
   where
     dfun_name = idName dfun_id
-    mod = nameModuleName dfun_name
+    mod = nameModule dfun_name
     (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
     head_ty = mkForAllTys tvs (mkPredTy (mkClassPred cls tys))
        -- No need to record the instance context; 
@@ -617,7 +617,7 @@ toIfaceIdInfo ext id_info
                  | otherwise   = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
 
 --------------------------
-coreRuleToIfaceRule :: ModuleName -> (Name -> IfaceExtName) -> IdCoreRule -> IfaceRule
+coreRuleToIfaceRule :: Module -> (Name -> IfaceExtName) -> IdCoreRule -> IfaceRule
 coreRuleToIfaceRule mod ext (IdCoreRule id _ (BuiltinRule _ _))
   = pprTrace "toHsRule: builtin" (ppr id) (bogusIfaceRule (mkIfaceExtName (getName id)))
 
@@ -701,12 +701,12 @@ toIfaceVar ext v
 -- mkLhsNameFn ignores versioning info altogether
 -- Used for the LHS of instance decls and rules, where we 
 -- there's no point in recording version info
-mkLhsNameFn :: ModuleName -> Name -> IfaceExtName
+mkLhsNameFn :: Module -> Name -> IfaceExtName
 mkLhsNameFn this_mod name      
   | mod == this_mod = LocalTop occ
   | otherwise      = ExtPkg mod occ
   where
-    mod = nameModuleName name
+    mod = nameModule name
     occ        = nameOccName name
 \end{code}
 
index c3a64a8..bb51778 100644 (file)
@@ -30,8 +30,8 @@ import TyCon          ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity )
 import Var             ( isId, tyVarKind, idType )
 import TysWiredIn      ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
 import OccName         ( OccName )
-import Name            ( Name, getName, getOccName, nameModuleName, nameOccName )
-import Module          ( ModuleName )
+import Name            ( Name, getName, getOccName, nameModule, nameOccName )
+import Module          ( Module )
 import BasicTypes      ( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
 import Outputable
 import FastString
@@ -46,11 +46,11 @@ import FastString
 
 \begin{code}
 data IfaceExtName
-  = ExtPkg ModuleName OccName          -- From an external package; no version #
+  = ExtPkg Module OccName              -- From an external package; no version #
                                        -- Also used for wired-in things regardless
                                        -- of whether they are home-pkg or not
 
-  | HomePkg ModuleName OccName Version -- From another module in home package;
+  | HomePkg Module OccName Version     -- From another module in home package;
                                        -- has version #
 
   | LocalTop OccName                   -- Top-level from the same module as 
@@ -62,7 +62,7 @@ data IfaceExtName
        -- LocalTopSub is written into iface files as LocalTop; the parent 
        -- info is only used when computing version information in MkIface
 
-mkIfaceExtName name = ExtPkg (nameModuleName name) (nameOccName name)
+mkIfaceExtName name = ExtPkg (nameModule name) (nameOccName name)
        -- Local helper for wired-in names
 \end{code}
 
@@ -182,7 +182,7 @@ instance Outputable IfaceExtName where
     ppr (LocalTop occ)        = ppr occ        -- Do we want to distinguish these 
     ppr (LocalTopSub occ _)    = ppr occ       -- from an ordinary occurrence?
 
-pprExt :: ModuleName -> OccName -> SDoc
+pprExt :: Module -> OccName -> SDoc
 pprExt mod occ
   = getPprStyle $ \ sty ->
     if unqualStyle sty mod occ then
index 316aa0a..69896be 100644 (file)
@@ -9,49 +9,53 @@ module LoadIface (
        loadSrcInterface, loadOrphanModules, loadHiBootInterface,
        readIface,      -- Used when reading the module's old interface
        predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
-       initExternalPackageState
+       initExternalPackageState,
+       noIfaceErr,   -- used by CompManager too
    ) where
 
 #include "HsVersions.h"
 
 import {-# SOURCE #-}  TcIface( tcIfaceDecl )
 
+import Packages                ( PackageState(..), isHomeModule  )
 import DriverState     ( v_GhcMode, isCompManagerMode )
 import DriverUtil      ( replaceFilenameSuffix )
-import CmdLineOpts     ( DynFlags( verbosity ), DynFlag( Opt_IgnoreInterfacePragmas ), 
-                         opt_InPackage )
+import CmdLineOpts     ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ) )
 import Parser          ( parseIface )
 
-import IfaceSyn                ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..), IfaceConDecls(..),
-                         IfaceInst(..), IfaceRule(..), IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..), 
-                         IfaceType(..), IfacePredType(..), IfaceExtName, mkIfaceExtName )
-import IfaceEnv                ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc, lookupOrig )
-import HscTypes                ( ModIface(..), TyThing, emptyModIface, EpsStats(..), addEpsInStats,
-                         ExternalPackageState(..), PackageTypeEnv, emptyTypeEnv, 
-                         lookupIfaceByModName, emptyPackageIfaceTable,
-                         IsBootInterface, mkIfaceFixCache, Gated, implicitTyThings,
-                         addRulesToPool, addInstsToPool, availNames
+import IfaceSyn                ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
+                         IfaceConDecls(..), IfaceInst(..), IfaceRule(..),
+                         IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..), 
+                         IfaceType(..), IfacePredType(..), IfaceExtName,
+                         mkIfaceExtName )
+import IfaceEnv                ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc,
+                         lookupOrig )
+import HscTypes                ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
+                         addEpsInStats, ExternalPackageState(..),
+                         PackageTypeEnv, emptyTypeEnv,  IfacePackage(..),
+                         lookupIfaceByModule, emptyPackageIfaceTable,
+                         IsBootInterface, mkIfaceFixCache, Gated,
+                         implicitTyThings, addRulesToPool, addInstsToPool,
+                         availNames
                         )
 
-import BasicTypes      ( Version, Fixity(..), FixityDirection(..), isMarkedStrict )
+import BasicTypes      ( Version, Fixity(..), FixityDirection(..),
+                         isMarkedStrict )
 import TcType          ( Type, tcSplitTyConApp_maybe )
 import Type            ( funTyCon )
 import TcRnMonad
 
-import PrelNames       ( gHC_PRIM_Name )
+import PrelNames       ( gHC_PRIM )
 import PrelInfo                ( ghcPrimExports )
 import PrelRules       ( builtinRules )
 import Rules           ( emptyRuleBase )
 import InstEnv         ( emptyInstEnv )
 import Name            ( Name {-instance NamedThing-}, getOccName,
-                         nameModuleName, isInternalName )
+                         nameModule, isInternalName )
 import NameEnv
 import MkId            ( seqId )
-import Packages                ( basePackage )
-import Module          ( Module, ModuleName, ModLocation(ml_hi_file),
-                         moduleName, isHomeModule, emptyModuleEnv, 
-                         extendModuleEnv, lookupModuleEnvByName, lookupModuleEnv,
-                         moduleUserString
+import Module          ( Module, ModLocation(ml_hi_file), emptyModuleEnv, 
+                         extendModuleEnv, lookupModuleEnv, moduleUserString
                        )
 import OccName         ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc,
                          mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc )
@@ -62,7 +66,7 @@ import Maybes         ( isJust, mapCatMaybes )
 import StringBuffer     ( hGetStringBuffer )
 import FastString      ( mkFastString )
 import ErrUtils         ( Message, mkLocMessage )
-import Finder          ( findModule, findPackageModule, 
+import Finder          ( findModule, findPackageModule,  FindResult(..),
                          hiBootExt, hiBootVerExt )
 import Lexer
 import Outputable
@@ -85,7 +89,7 @@ import Directory
 %************************************************************************
 
 \begin{code}
-loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface
+loadSrcInterface :: SDoc -> Module -> IsBootInterface -> RnM ModIface
 -- This is called for each 'import' declaration in the source code
 -- On a failure, fail in the monad with an error message
 
@@ -135,7 +139,7 @@ loadHiBootInterface
     moduleLoop mod = ptext SLIT("Circular imports: module") <+> quotes (ppr mod) 
                     <+> ptext SLIT("depends on itself")
 
-loadOrphanModules :: [ModuleName] -> TcM ()
+loadOrphanModules :: [Module] -> TcM ()
 loadOrphanModules mods
   | null mods = returnM ()
   | otherwise = initIfaceTcRn $
@@ -159,9 +163,9 @@ loadOrphanModules mods
 loadHomeInterface :: SDoc -> Name -> IfM lcl ModIface
 loadHomeInterface doc name
   = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
-    loadSysInterface doc (nameModuleName name)
+    loadSysInterface doc (nameModule name)
 
-loadSysInterface :: SDoc -> ModuleName -> IfM lcl ModIface
+loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
 -- A wrapper for loadInterface that Throws an exception if it fails
 loadSysInterface doc mod_name
   = do { mb_iface <- loadInterface doc mod_name ImportBySystem
@@ -182,7 +186,7 @@ loadSysInterface doc mod_name
 %*********************************************************
 
 \begin{code}
-loadInterface :: SDoc -> ModuleName -> WhereFrom 
+loadInterface :: SDoc -> Module -> WhereFrom 
              -> IfM lcl (Either Message ModIface)
 -- If it can't find a suitable interface file, we
 --     a) modify the PackageIfaceTable to have an empty entry
@@ -201,7 +205,7 @@ loadInterface doc_str mod_name from
        ; traceIf (text "Considering whether to load" <+> ppr mod_name <+> ppr from)
 
                -- Check whether we have the interface already
-       ; case lookupIfaceByModName hpt (eps_PIT eps) mod_name of {
+       ; case lookupIfaceByModule hpt (eps_PIT eps) mod_name of {
            Just iface 
                -> returnM (Right iface) ;      -- Already loaded
                        -- The (src_imp == mi_boot iface) test checks that the already-loaded
@@ -213,7 +217,7 @@ loadInterface doc_str mod_name from
                                ImportByUser usr_boot -> usr_boot
                                ImportBySystem        -> sys_boot
 
-             ; mb_dep   = lookupModuleEnvByName (eps_is_boot eps) mod_name
+             ; mb_dep   = lookupModuleEnv (eps_is_boot eps) mod_name
              ; sys_boot = case mb_dep of
                                Just (_, is_boot) -> is_boot
                                Nothing           -> False
@@ -221,10 +225,13 @@ loadInterface doc_str mod_name from
              }         -- based on the dependencies in directly-imported modules
 
        -- READ THE MODULE IN
-       ; read_result <- findAndReadIface doc_str mod_name hi_boot_file
+       ; let explicit | ImportByUser _ <- from = True
+                      | otherwise              = False
+       ; read_result <- findAndReadIface explicit doc_str mod_name hi_boot_file
+       ; dflags <- getDOpts
        ; case read_result of {
            Left err -> do
-               { let fake_iface = emptyModIface opt_InPackage mod_name
+               { let fake_iface = emptyModIface ThisPackage mod_name
 
                ; updateEps_ $ \eps ->
                        eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
@@ -236,14 +243,13 @@ loadInterface doc_str mod_name from
        -- Found and parsed!
            Right iface -> 
 
-       let { mod      = mi_module iface
-           ; mod_name = moduleName mod } in
+       let { mod = mi_module iface } in
 
        -- Sanity check.  If we're system-importing a module we know nothing at all
        -- about, it should be from a different package to this one
        WARN(   case from of { ImportBySystem -> True; other -> False } &&
                not (isJust mb_dep) && 
-               isHomeModule mod,
+               isHomeModule dflags mod,
                ppr mod $$ ppr mb_dep $$ ppr (eps_is_boot eps) )
 
        initIfaceLcl mod_name $ do
@@ -394,7 +400,7 @@ ifaceDeclSubBndrs _other                  = []
 --     Loading instance decls
 -----------------------------------------------------
 
-loadInsts :: ModuleName -> [IfaceInst] -> IfL [(Name, Gated IfaceInst)]
+loadInsts :: Module -> [IfaceInst] -> IfL [(Name, Gated IfaceInst)]
 loadInsts mod decls = mapM (loadInstDecl mod) decls
 
 loadInstDecl mod decl@(IfaceInst {ifInstHead = inst_ty})
@@ -435,13 +441,13 @@ loadInstDecl mod decl@(IfaceInst {ifInstHead = inst_ty})
 -----------------------------------------------------
 
 loadRules :: Bool      -- Don't load pragmas into the decl pool
-         -> ModuleName
+         -> Module
          -> [IfaceRule] -> IfL [Gated IfaceRule]
 loadRules ignore_prags mod rules
   | ignore_prags = returnM []
   | otherwise    = mapM (loadRule mod) rules
 
-loadRule :: ModuleName -> IfaceRule -> IfL (Gated IfaceRule)
+loadRule :: Module -> IfaceRule -> IfL (Gated IfaceRule)
 -- "Gate" the rule simply by a crude notion of the free vars of
 -- the LHS.  It can be crude, because having too few free vars is safe.
 loadRule mod decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
@@ -531,7 +537,8 @@ predInstGates cls tys
 %*********************************************************
 
 \begin{code}
-findAndReadIface :: SDoc -> ModuleName 
+findAndReadIface :: Bool               -- True <=> explicit user import
+                -> SDoc -> Module 
                 -> IsBootInterface     -- True  <=> Look for a .hi-boot file
                                        -- False <=> Look for .hi file
                 -> IfM lcl (Either Message ModIface)
@@ -541,7 +548,7 @@ findAndReadIface :: SDoc -> ModuleName
        -- It *doesn't* add an error to the monad, because 
        -- sometimes it's ok to fail... see notes with loadInterface
 
-findAndReadIface doc_str mod_name hi_boot_file
+findAndReadIface explicit doc_str mod_name hi_boot_file
   = do { traceIf (sep [hsep [ptext SLIT("Reading"), 
                              if hi_boot_file 
                                then ptext SLIT("[boot]") 
@@ -551,19 +558,26 @@ findAndReadIface doc_str mod_name hi_boot_file
                        nest 4 (ptext SLIT("reason:") <+> doc_str)])
 
        -- Check for GHC.Prim, and return its static interface
-       ; if mod_name == gHC_PRIM_Name
-         then returnM (Right ghcPrimIface)
+       ; dflags <- getDOpts
+       ; let base_id = basePackageId (pkgState dflags)
+             base_pkg 
+               | Just id <- base_id = ExternalPackage id
+               | otherwise          = ThisPackage
+               -- if basePackageId is Nothing, it means we must be
+               -- compiling the base package.
+       ; if mod_name == gHC_PRIM
+         then returnM (Right (ghcPrimIface{ mi_package = base_pkg }))
          else do
 
        -- Look for the file
-       ; mb_found <- ioToIOEnv (findHiFile mod_name hi_boot_file)
+       ; mb_found <- ioToIOEnv (findHiFile dflags explicit mod_name hi_boot_file)
        ; case mb_found of {
-             Left files -> do
+             Left err -> do
                { traceIf (ptext SLIT("...not found"))
                ; dflags <- getDOpts
-               ; returnM (Left (noIfaceErr dflags mod_name hi_boot_file files)) } ;
+               ; returnM (Left (noIfaceErr dflags mod_name err)) } ;
 
-             Right file_path -> do
+             Right (file_path,pkg) -> do 
 
        -- Found file, so read it
        { traceIf (ptext SLIT("readIFace") <+> text file_path)
@@ -571,15 +585,16 @@ findAndReadIface doc_str mod_name hi_boot_file
        ; case read_result of
            Left err    -> returnM (Left (badIfaceFile file_path err))
            Right iface 
-               | moduleName (mi_module iface) /= mod_name ->
+               | mi_module iface /= mod_name ->
                  return (Left (wrongIfaceModErr iface mod_name file_path))
                | otherwise ->
-                 returnM (Right iface)
+                 returnM (Right iface{mi_package=pkg})
+                       -- don't forget to fill in the package name...
        }}}
 
-findHiFile :: ModuleName -> IsBootInterface
-          -> IO (Either [FilePath] FilePath)
-findHiFile mod_name hi_boot_file
+findHiFile :: DynFlags -> Bool -> Module -> IsBootInterface
+          -> IO (Either FindResult (FilePath, IfacePackage))
+findHiFile dflags explicit mod_name hi_boot_file
  = do { 
        -- In interactive or --make mode, we are *not allowed* to demand-load
        -- a home package .hi file.  So don't even look for them.
@@ -590,13 +605,15 @@ findHiFile mod_name hi_boot_file
        let { home_allowed = hi_boot_file || 
                             not (isCompManagerMode ghci_mode) } ;
        maybe_found <-  if home_allowed 
-                       then findModule mod_name
-                       else findPackageModule mod_name ;
+                       then findModule dflags mod_name explicit
+                       else findPackageModule dflags mod_name explicit;
 
        case maybe_found of {
-         Left files -> return (Left files) ;
-
-         Right (_, loc) -> do {        -- Don't need module returned by finder
+         Found loc pkg -> foundOk loc hi_boot_file pkg;
+         err           -> return (Left err) ;
+       }}
+   where
+    foundOk loc hi_boot_file pkg = do {        -- Don't need module returned by finder
 
        -- Return the path to M.hi, M.hi-boot, or M.hi-boot-n as appropriate
        let { hi_path            = ml_hi_file loc ;
@@ -605,18 +622,18 @@ findHiFile mod_name hi_boot_file
            };
 
        if not hi_boot_file then
-          return (Right hi_path)
+          return (Right (hi_path,pkg))
        else do {
                hi_ver_exists <- doesFileExist hi_boot_ver_path ;
-               if hi_ver_exists then return (Right hi_boot_ver_path)
-                                else return (Right hi_boot_path)
-       }}}}
+               if hi_ver_exists then return (Right (hi_boot_ver_path,pkg))
+                                else return (Right (hi_boot_path,pkg))
+       }}
 \end{code}
 
 @readIface@ tries just the one file.
 
 \begin{code}
-readIface :: ModuleName -> String -> IsBootInterface 
+readIface :: Module -> String -> IsBootInterface 
          -> IfM lcl (Either Message ModIface)
        -- Left err    <=> file not found, or unreadable, or illegible
        -- Right iface <=> successfully found and parsed 
@@ -637,7 +654,7 @@ read_iface dflags wanted_mod file_path is_hi_boot_file
             | wanted_mod == actual_mod -> return (Right iface)
             | otherwise                -> return (Left err) 
             where
-               actual_mod = moduleName (mi_module iface)
+               actual_mod = mi_module iface
                err = hiModuleNameMismatchWarn wanted_mod actual_mod
      }}
 
@@ -675,7 +692,7 @@ initExternalPackageState
     }
   where
     mk_gated_rule (fn_name, core_rule)
-       = ([fn_name], (nameModuleName fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
+       = ([fn_name], (nameModule fn_name, IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
 \end{code}
 
 
@@ -688,8 +705,8 @@ initExternalPackageState
 \begin{code}
 ghcPrimIface :: ModIface
 ghcPrimIface
-  = (emptyModIface basePackage gHC_PRIM_Name) {
-       mi_exports  = [(gHC_PRIM_Name, ghcPrimExports)],
+  = (emptyModIface ThisPackage gHC_PRIM) {
+       mi_exports  = [(gHC_PRIM, ghcPrimExports)],
        mi_decls    = [],
        mi_fixities = fixities,
        mi_fix_fn  = mkIfaceFixCache fixities
@@ -734,7 +751,7 @@ badIfaceFile file err
   = vcat [ptext SLIT("Bad interface file:") <+> text file, 
          nest 4 err]
 
-hiModuleNameMismatchWarn :: ModuleName -> ModuleName -> Message
+hiModuleNameMismatchWarn :: Module -> Module -> Message
 hiModuleNameMismatchWarn requested_mod read_mod = 
     hsep [ ptext SLIT("Something is amiss; requested module name")
         , ppr requested_mod
@@ -742,11 +759,21 @@ hiModuleNameMismatchWarn requested_mod read_mod =
         , ppr read_mod
         ]
 
-noIfaceErr dflags mod_name boot_file files
+noIfaceErr dflags mod_name (PackageHidden pkg)
+  = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
+    $$ ptext SLIT("it is a member of package") <+> quotes (ppr pkg) <> comma
+        <+> ptext SLIT("which is hidden")
+
+noIfaceErr dflags mod_name (ModuleHidden pkg)
+  = ptext SLIT("Could not import") <+> quotes (ppr mod_name) <> colon
+    $$ ptext SLIT("it is hidden") 
+       <+> parens (ptext SLIT("in package") <+> quotes (ppr pkg))
+
+noIfaceErr dflags mod_name (NotFound files)
   = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
-    $$ extra
+    $$ extra files
   where 
-   extra
+  extra files
     | verbosity dflags < 3 = 
         text "(use -v to see a list of the files searched for)"
     | otherwise =
index abfc67d..ebbca13 100644 (file)
@@ -174,6 +174,7 @@ compiled with -O.  I think this is the case.]
 #include "HsVersions.h"
 
 import HsSyn
+import Packages                ( isHomeModule )
 import IfaceSyn                ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
                          IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..),
                          eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool, 
@@ -184,10 +185,9 @@ import BasicTypes  ( Version, initialVersion, bumpVersion )
 import TcRnMonad
 import TcRnTypes       ( ImportAvails(..), mkModDeps )
 import TcType          ( isFFITy )
-import HscTypes                ( ModIface(..), TyThing(..),
+import HscTypes                ( ModIface(..), TyThing(..), IfacePackage(..),
                          ModGuts(..), ModGuts, IfaceExport,
-                         GhciMode(..), isOneShot,
-                         HscEnv(..), hscEPS,
+                         GhciMode(..), HscEnv(..), hscEPS,
                          Dependencies(..), FixItem(..), 
                          mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
                          typeEnvElts, 
@@ -195,16 +195,18 @@ import HscTypes           ( ModIface(..), TyThing(..),
                          ExternalPackageState(..),
                          Usage(..), IsBootInterface,
                          Deprecs(..), IfaceDeprecs, Deprecations,
-                         lookupIfaceByModName
+                         lookupIfaceByModule
                        )
 
 
 import CmdLineOpts
-import Name            ( Name, nameModule, nameOccName, nameParent, isExternalName,
-                         nameParent_maybe, isWiredInName, NamedThing(..), nameModuleName )
+import Name            ( Name, nameModule, nameOccName, nameParent,
+                         isExternalName, nameParent_maybe, isWiredInName,
+                         NamedThing(..) )
 import NameEnv
 import NameSet
-import OccName         ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv_C,
+import OccName         ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
+                         extendOccEnv_C,
                          OccSet, emptyOccSet, elemOccSet, occSetElts, 
                          extendOccSet, extendOccSetList,
                          isEmptyOccSet, intersectOccSet, intersectsOccSet,
@@ -212,10 +214,10 @@ import OccName            ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, extendOc
 import TyCon           ( tyConDataCons, isNewTyCon, newTyConRep )
 import Class           ( classSelIds )
 import DataCon         ( dataConName, dataConFieldLabels )
-import Module          ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule,
-                         ModLocation(..), mkSysModuleNameFS, moduleUserString,
+import Module          ( Module, moduleFS,
+                         ModLocation(..), mkSysModuleFS, moduleUserString,
                          ModuleEnv, emptyModuleEnv, lookupModuleEnv,
-                         extendModuleEnv_C, moduleEnvElts
+                         extendModuleEnv_C
                        )
 import Outputable
 import DriverUtil      ( createDirectoryHierarchy, directoryOf )
@@ -264,8 +266,7 @@ mkIface hsc_env location maybe_old_iface
                      mg_rules = rules,
                      mg_types = type_env }
   = do { eps <- hscEPS hsc_env
-       ; let   { this_mod_name = moduleName this_mod
-               ; ext_nm = mkExtNameFn hsc_env eps this_mod_name
+       ; let   { ext_nm = mkExtNameFn hsc_env eps this_mod
                ; local_things = [thing | thing <- typeEnvElts type_env,
                                          not (isWiredInName (getName thing)) ]
                        -- Do not export anything about wired-in things
@@ -287,12 +288,12 @@ mkIface hsc_env location maybe_old_iface
                ; iface_rules 
                     | omit_prags = []
                     | otherwise  = sortLe le_rule $
-                                   map (coreRuleToIfaceRule this_mod_name ext_nm) rules
+                                   map (coreRuleToIfaceRule this_mod ext_nm) rules
                ; iface_insts = sortLe le_inst (map dfunToIfaceInst insts)
 
                ; intermediate_iface = ModIface { 
                        mi_module   = this_mod,
-                       mi_package  = opt_InPackage,
+                       mi_package  = ThisPackage,
                        mi_boot     = False,
                        mi_deps     = deps,
                        mi_usages   = usages,
@@ -383,36 +384,36 @@ wantDeclFor exports abstracts thing
 deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
 
 -----------------------------
-mkExtNameFn :: HscEnv -> ExternalPackageState -> ModuleName -> Name -> IfaceExtName
+mkExtNameFn :: HscEnv -> ExternalPackageState -> Module -> Name -> IfaceExtName
 mkExtNameFn hsc_env eps this_mod
   = ext_nm
   where
+    dflags = hsc_dflags hsc_env
     hpt = hsc_HPT hsc_env
     pit = eps_PIT eps
 
     ext_nm name 
-      | mod_nm == this_mod = case nameParent_maybe name of
+      | mod == this_mod = case nameParent_maybe name of
                                Nothing  -> LocalTop occ
                                Just par -> LocalTopSub occ (nameOccName par)
-      | isWiredInName name = ExtPkg  mod_nm occ
-      | isHomeModule mod   = HomePkg mod_nm occ vers
-      | otherwise         = ExtPkg  mod_nm occ
+      | isWiredInName name       = ExtPkg  mod occ
+      | isHomeModule dflags mod  = HomePkg mod occ vers
+      | otherwise               = ExtPkg  mod occ
       where
        mod      = nameModule name
-       mod_nm   = moduleName mod
        occ      = nameOccName name
        par_occ  = nameOccName (nameParent name)
                -- The version of the *parent* is the one want
-       vers     = lookupVersion mod_nm par_occ
+       vers     = lookupVersion mod par_occ
              
-    lookupVersion :: ModuleName -> OccName -> Version
+    lookupVersion :: Module -> OccName -> Version
        -- Even though we're looking up a home-package thing, in
        -- one-shot mode the imported interfaces may be in the PIT
     lookupVersion mod occ
       = mi_ver_fn iface occ `orElse` 
         pprPanic "lookupVers1" (ppr mod <+> ppr occ)
       where
-        iface = lookupIfaceByModName hpt pit mod `orElse` 
+        iface = lookupIfaceByModule hpt pit mod `orElse` 
                pprPanic "lookupVers2" (ppr mod <+> ppr occ)
 
 -----------------------------
@@ -666,21 +667,24 @@ bump_unless False v = bumpVersion v
 \begin{code}
 mkUsageInfo :: HscEnv 
            -> ModuleEnv (Module, Maybe Bool, SrcSpan)
-           -> [(ModuleName, IsBootInterface)]
+           -> [(Module, IsBootInterface)]
            -> NameSet -> IO [Usage]
 mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
   = do { eps <- hscEPS hsc_env
-       ; let usages = mk_usage_info (eps_PIT eps) (hsc_HPT hsc_env) 
+       ; let usages = mk_usage_info (eps_PIT eps) hsc_env
                                     dir_imp_mods dep_mods used_names
        ; usages `seqList`  return usages }
         -- seq the list of Usages returned: occasionally these
         -- don't get evaluated for a while and we can end up hanging on to
         -- the entire collection of Ifaces.
 
-mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names
+mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
   = mapCatMaybes mkUsage dep_mods
        -- ToDo: do we need to sort into canonical order?
   where
+    dflags = hsc_dflags hsc_env
+    hpt = hsc_HPT hsc_env
+
     used_names = mkNameSet $                   -- Eliminate duplicates
                 [ nameParent n                 -- Just record usage on the 'main' names
                 | n <- nameSetToList proto_used_names
@@ -708,23 +712,23 @@ mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names
     --         (need to recompile if its export list changes: export_vers)
     -- c) is a home-package orphan module (need to recompile if its
     --         instance decls change: rules_vers)
-    mkUsage :: (ModuleName, Bool) -> Maybe Usage
+    mkUsage :: (Module, Bool) -> Maybe Usage
     mkUsage (mod_name, _)
       |  isNothing maybe_iface -- We can't depend on it if we didn't
-      || not (isHomeModule mod)        -- even open the interface!
+      || not (isHomeModule dflags mod) -- even open the interface!
       || (null used_occs
          && not all_imported
          && not orphan_mod)
       = Nothing                        -- Record no usage info
     
       | otherwise      
-      = Just (Usage { usg_name     = moduleName mod,
+      = Just (Usage { usg_name     = mod,
                      usg_mod      = mod_vers,
                      usg_exports  = export_vers,
                      usg_entities = ent_vers,
                      usg_rules    = rules_vers })
       where
-       maybe_iface  = lookupIfaceByModName hpt pit mod_name
+       maybe_iface  = lookupIfaceByModule hpt pit mod_name
                -- In one-shot mode, the interfaces for home-package 
                -- modules accumulate in the PIT not HPT.  Sigh.
 
@@ -746,11 +750,11 @@ mk_usage_info pit hpt dir_imp_mods dep_mods proto_used_names
 \end{code}
 
 \begin{code}
-mkIfaceExports :: NameSet -> [(ModuleName, [GenAvailInfo OccName])]
+mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]
   -- Group by module and sort by occurrence
   -- This keeps the list in canonical order
 mkIfaceExports exports 
-  = [ (mkSysModuleNameFS fs, eltsFM avails)
+  = [ (mkSysModuleFS fs, eltsFM avails)
     | (fs, avails) <- fmToList groupFM
     ]
   where
@@ -763,7 +767,7 @@ mkIfaceExports exports
                             (unitFM avail_fs avail)
       where
        occ    = nameOccName name
-       mod_fs = moduleNameFS (nameModuleName name)
+       mod_fs = moduleFS (nameModule name)
        avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ]
              | isTcOcc occ                     = AvailTC occ [occ]
              | otherwise                       = Avail occ
@@ -821,7 +825,7 @@ check_old_iface this_mod iface_path source_unchanged maybe_iface
 
        -- Try and read the old interface for the current module
        -- from the .hi file left from the last time we compiled it
-    readIface (moduleName this_mod) iface_path False           `thenM` \ read_result ->
+    readIface this_mod iface_path False                `thenM` \ read_result ->
     case read_result of {
        Left err ->     -- Old interface file not found, or garbled; give up
                   traceIf (text "FYI: cannot read old interface file:"
@@ -872,7 +876,7 @@ checkVersions source_unchanged iface
     }
   where
        -- This is a bit of a hack really
-    mod_deps :: ModuleEnv (ModuleName, IsBootInterface)
+    mod_deps :: ModuleEnv (Module, IsBootInterface)
     mod_deps = mkModDeps (dep_mods (mi_deps iface))
 
 checkModUsage :: Usage -> IfG RecompileRequired
@@ -1001,7 +1005,7 @@ pprModIface :: ModIface -> SDoc
 -- Show a ModIface
 pprModIface iface
  = vcat [ ptext SLIT("interface")
-               <+> doubleQuotes (ftext (mi_package iface))
+               <+> ppr_package (mi_package iface)
                <+> ppr (mi_module iface) <+> ppr (mi_mod_vers iface)
                <+> pp_sub_vers
                <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
@@ -1017,6 +1021,9 @@ pprModIface iface
        , pprDeprecs (mi_deprecs iface)
        ]
   where
+    ppr_package ThisPackage = empty
+    ppr_package (ExternalPackage id) = doubleQuotes (ftext id)
+
     exp_vers  = mi_exp_vers iface
     rule_vers = mi_rule_vers iface
 
index 2a875e0..7f4e83e 100644 (file)
@@ -49,11 +49,11 @@ import TyCon                ( tyConDataCons, isTupleTyCon, mkForeignTyCon )
 import DataCon         ( DataCon, dataConWorkId, dataConTyVars, dataConArgTys, isVanillaDataCon )
 import TysWiredIn      ( tupleCon, tupleTyCon, listTyCon, intTyCon, boolTyCon, charTyCon, parrTyCon )
 import Var             ( TyVar, mkTyVar, tyVarKind )
-import Name            ( Name, nameModuleName, nameModule, nameIsLocalOrFrom, 
+import Name            ( Name, nameModule, nameIsLocalOrFrom, 
                          isWiredInName, wiredInNameTyThing_maybe, nameParent )
 import NameEnv
 import OccName         ( OccName )
-import Module          ( Module, ModuleName, moduleName )
+import Module          ( Module )
 import UniqSupply      ( initUs_ )
 import Outputable      
 import SrcLoc          ( noSrcLoc )
@@ -168,10 +168,10 @@ typecheckIface hsc_env iface
              ; rules | ignore_prags = []
                      | otherwise    = mi_rules iface
              ; dfuns    = mi_insts iface
-             ; mod_name = moduleName (mi_module iface)
+             ; mod      = mi_module iface
          }
                -- Typecheck the decls
-       ; names <- mappM (lookupOrig mod_name . ifName) decls
+       ; names <- mappM (lookupOrig mod . ifName) decls
        ; ty_things <- fixM (\ rec_ty_things -> do
                { writeMutVar tc_env_var (mkNameEnv (names `zipLazy` rec_ty_things))
                        -- This only makes available the "main" things,
@@ -449,7 +449,7 @@ tcIfaceInst :: IfaceInst -> IfL DFunId
 tcIfaceInst (IfaceInst { ifDFun = dfun_occ })
   = tcIfaceExtId (LocalTop dfun_occ)
 
-selectInsts :: Name -> [Name] -> ExternalPackageState -> (ExternalPackageState, [(ModuleName, IfaceInst)])
+selectInsts :: Name -> [Name] -> ExternalPackageState -> (ExternalPackageState, [(Module, IfaceInst)])
 selectInsts cls tycons eps
   = (eps { eps_insts = insts', eps_stats = stats' }, iface_insts)
   where
@@ -521,7 +521,7 @@ loadImportedRules hsc_env guts
     }
 
 
-selectRules :: ExternalPackageState -> (ExternalPackageState, [(ModuleName, IfaceRule)])
+selectRules :: ExternalPackageState -> (ExternalPackageState, [(Module, IfaceRule)])
 -- Not terribly efficient.  Look at each rule in the pool to see if
 -- all its gates are in the type env.  If so, take it out of the pool.
 -- If not, trim its gates for next time.
@@ -701,7 +701,7 @@ tcIfaceAlt _ (IfaceLitAlt lit, names, rhs)
 -- by the fact that we omit type annotations because we can
 -- work them out.  True enough, but its not that easy!
 tcIfaceAlt (tycon, inst_tys) (IfaceDataAlt data_occ, arg_occs, rhs)
-  = do { let tycon_mod = nameModuleName (tyConName tycon)
+  = do { let tycon_mod = nameModule (tyConName tycon)
        ; con <- tcIfaceDataCon (ExtPkg tycon_mod data_occ)
        ; ASSERT2( con `elem` tyConDataCons tycon,
                   ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) )
index 2cf2841..6942408 100644 (file)
@@ -13,6 +13,7 @@ module CmdLineOpts (
        HscLang(..),
        DynFlag(..),    -- needed non-abstractly by DriverFlags
        DynFlags(..),
+       PackageFlag(..),
 
        v_Static_hsc_opts,
 
@@ -27,18 +28,8 @@ module CmdLineOpts (
        dopt_HscLang,                   -- DynFlags -> HscLang
        dopt_OutName,                   -- DynFlags -> String
        getOpts,                        -- (DynFlags -> [a]) -> IO [a]
-       setLang,
        getVerbFlag,
-       setOptLevel,
-
-       -- Manipulating the DynFlags state
-       getDynFlags,                    -- IO DynFlags
-       setDynFlags,                    -- DynFlags -> IO ()
-       updDynFlags,                    -- (DynFlags -> DynFlags) -> IO ()
-       dynFlag,                        -- (DynFlags -> a) -> IO a
-       setDynFlag, unSetDynFlag,       -- DynFlag -> IO ()
-       saveDynFlags,                   -- IO ()
-       restoreDynFlags,                -- IO DynFlags
+       updOptLevel,
 
        -- sets of warning opts
        minusWOpts,
@@ -84,7 +75,6 @@ module CmdLineOpts (
 
        -- misc opts
        opt_ErrorSpans,
-       opt_InPackage,
        opt_EmitCExternDecls,
        opt_EnsureSplittableC,
        opt_GranMacros,
@@ -99,6 +89,7 @@ module CmdLineOpts (
 
 #include "HsVersions.h"
 
+import {-# SOURCE #-} Packages (PackageState)
 import Constants       -- Default values for some flags
 import Util
 import FastString      ( FastString, mkFastString )
@@ -107,7 +98,7 @@ import Maybes                ( firstJust )
 
 import Panic           ( ghcError, GhcException(UsageError) )
 import GLAEXTS
-import DATA_IOREF      ( IORef, readIORef, writeIORef )
+import DATA_IOREF      ( IORef, readIORef )
 import UNSAFE_IO       ( unsafePerformIO )
 \end{code}
 
@@ -314,6 +305,7 @@ data DynFlags = DynFlags {
   ppFlag                :: Bool,        -- preprocess with a Haskell Pp?
   stolen_x86_regs      :: Int,         
   cmdlineHcIncludes    :: [String],    -- -#includes
+  importPaths          :: [FilePath],
 
   -- options for particular phases
   opt_L                        :: [String],
@@ -327,10 +319,30 @@ data DynFlags = DynFlags {
   opt_i                        :: [String],
 #endif
 
+  -- ** Package flags
+  extraPkgConfs                :: [FilePath],
+       -- The -package-conf flags given on the command line, in the order
+       -- they appeared.
+
+  readUserPkgConf      :: Bool,
+       -- Whether or not to read the user package database
+       -- (-no-user-package-conf).
+
+  packageFlags         :: [PackageFlag],
+       -- The -package and -hide-package flags from the command-line
+
+  -- ** Package state
+  pkgState             :: PackageState,
+
   -- hsc dynamic flags
   flags                :: [DynFlag]
  }
 
+data PackageFlag
+  = ExposePackage  String
+  | HidePackage    String
+  | IgnorePackage  String
+
 data HscLang
   = HscC
   | HscAsm
@@ -361,6 +373,7 @@ defaultDynFlags = DynFlags {
   ppFlag                = False,
   stolen_x86_regs      = 4,
   cmdlineHcIncludes    = [],
+  importPaths          = ["."],
   opt_L                        = [],
   opt_P                        = [],
   opt_F                 = [],
@@ -371,6 +384,12 @@ defaultDynFlags = DynFlags {
   opt_I                 = [],
   opt_i                 = [],
 #endif
+
+  extraPkgConfs                = [],
+  readUserPkgConf      = True,
+  packageFlags         = [],
+  pkgState             = error "pkgState",
+
   flags = [ 
            Opt_Generics,
                        -- Generating the helper-functions for
@@ -426,33 +445,18 @@ dopt_set dfs f = dfs{ flags = f : flags dfs }
 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 
-getOpts :: (DynFlags -> [a]) -> IO [a]
+getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
        -- We add to the options from the front, so we need to reverse the list
-getOpts opts = dynFlag opts >>= return . reverse
-
--- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags 
--- (-fvia-C, -fasm, -filx respectively).
-setLang l = updDynFlags (\ dfs -> case hscLang dfs of
-                                       HscC   -> dfs{ hscLang = l }
-                                       HscAsm -> dfs{ hscLang = l }
-                                       HscILX -> dfs{ hscLang = l }
-                                       _      -> dfs)
+getOpts dflags opts = reverse (opts dflags)
 
-getVerbFlag = do
-   verb <- dynFlag verbosity
-   if verb >= 3  then return  "-v" else return ""
+getVerbFlag dflags 
+  | verbosity dflags >= 3  = "-v" 
+  | otherwise =  ""
 
 -----------------------------------------------------------------------------
 -- Setting the optimisation level
 
-setOptLevel :: Int -> IO ()
-setOptLevel n 
-  = do dflags <- getDynFlags
-       if hscLang dflags == HscInterpreted && n > 0
-         then putStr "warning: -O conflicts with --interactive; -O ignored.\n"
-         else updDynFlags (setOptLevel' n)
-
-setOptLevel' n dfs
+updOptLevel n dfs
   = if (n >= 1)
      then dfs2{ hscLang = HscC, optLevel = n } -- turn on -fvia-C with -O
      else dfs2{ optLevel = n }
@@ -611,51 +615,8 @@ buildCoreToDo dflags = core_todo
          MaxSimplifierIterations max_iter
        ]
      ]
-
--- --------------------------------------------------------------------------
--- Mess about with the mutable variables holding the dynamic arguments
-
--- v_InitDynFlags 
---     is the "baseline" dynamic flags, initialised from
---     the defaults and command line options, and updated by the
---     ':s' command in GHCi.
---
--- v_DynFlags
---     is the dynamic flags for the current compilation.  It is reset
---     to the value of v_InitDynFlags before each compilation, then
---     updated by reading any OPTIONS pragma in the current module.
-
-GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
-GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
-
-setDynFlags :: DynFlags -> IO ()
-setDynFlags dfs = writeIORef v_DynFlags dfs
-
-saveDynFlags :: IO ()
-saveDynFlags = do dfs <- readIORef v_DynFlags
-                 writeIORef v_InitDynFlags dfs
-
-restoreDynFlags :: IO DynFlags
-restoreDynFlags = do dfs <- readIORef v_InitDynFlags
-                    writeIORef v_DynFlags dfs
-                    return dfs
-
-getDynFlags :: IO DynFlags
-getDynFlags = readIORef v_DynFlags
-
-updDynFlags :: (DynFlags -> DynFlags) -> IO ()
-updDynFlags f = do dfs <- readIORef v_DynFlags
-                  writeIORef v_DynFlags (f dfs)
-
-dynFlag :: (DynFlags -> a) -> IO a
-dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
-
-setDynFlag, unSetDynFlag :: DynFlag -> IO ()
-setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
-unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 \end{code}
 
-
 %************************************************************************
 %*                                                                     *
 \subsection{Warnings}
@@ -701,7 +662,6 @@ minusWallOpts
 GLOBAL_VAR(v_Static_hsc_opts, [], [String])
 
 lookUp          :: FastString -> Bool
-lookup_int              :: String -> Maybe Int
 lookup_def_int   :: String -> Int -> Int
 lookup_def_float :: String -> Float -> Float
 lookup_str       :: String -> Maybe String
@@ -719,10 +679,6 @@ lookup_str sw
        Just str         -> Just str
        Nothing          -> Nothing     
 
-lookup_int sw = case (lookup_str sw) of
-                 Nothing -> Nothing
-                 Just xx -> Just (try_read sw xx)
-
 lookup_def_int sw def = case (lookup_str sw) of
                            Nothing -> def              -- Use default
                            Just xx -> try_read sw xx
@@ -796,15 +752,6 @@ opt_RulesOff                       = lookUp  FSLIT("-frules-off")
 opt_LiberateCaseThreshold      = lookup_def_int "-fliberate-case-threshold" (10::Int)
 opt_MaxWorkerArgs              = lookup_def_int "-fmax-worker-args" (10::Int)
 
-{-
-   The optional '-inpackage=P' flag tells what package
-   we are compiling this module for.
-   The Prelude, for example is compiled with '-inpackage std'
--}
-opt_InPackage                  = case lookup_str "-inpackage=" of
-                                   Just p  -> mkFastString p
-                                   Nothing -> FSLIT("Main")    -- The package name if none is specified
-
 opt_EmitCExternDecls           = lookUp  FSLIT("-femit-extern-decls")
 opt_EnsureSplittableC          = lookUp  FSLIT("-fglobalise-toplev-names")
 opt_GranMacros                 = lookUp  FSLIT("-fgransim")
index 695162c..3a3e4bb 100644 (file)
@@ -28,7 +28,6 @@ import Distribution.Package   ( showPackageId )
 import PprC            ( writeCs )
 import CmmLint         ( cmmLint )
 import Packages
-import DriverState     ( getExplicitPackagesAnd, getPackageCIncludes )
 import DriverUtil      ( filenameOf )
 import FastString      ( unpackFS )
 import Cmm             ( Cmm )
@@ -125,7 +124,7 @@ outputC dflags filenm flat_absC
        --   * the _stub.h file, if there is one.
        --
        let packages = dep_pkgs dependencies
-       pkg_configs <- getExplicitPackagesAnd packages
+       pkg_configs <- getExplicitPackagesAnd dflags packages
        let pkg_names = map (showPackageId.package) pkg_configs
 
        c_includes <- getPackageCIncludes pkg_configs
@@ -244,8 +243,12 @@ outputForeignStubs dflags (ForeignStubs h_code c_code _ _)
                       "Foreign export header file" stub_h_output_d
 
        -- we need the #includes from the rts package for the stub files
-       rts_pkgs <- getPackageDetails [rtsPackage]
-       let rts_includes = concatMap mk_include (concatMap includes rts_pkgs)
+       let rtsid = rtsPackageId (pkgState dflags)
+           rts_includes 
+               | Just pid <- rtsid = 
+                       let rts_pkg = getPackageDetails (pkgState dflags) pid in
+                       concatMap mk_include (includes rts_pkg)
+               | otherwise = []
            mk_include i = "#include \"" ++ i ++ "\"\n"
 
        stub_h_file_exists
index 0f91cb1..0aa9563 100644 (file)
@@ -7,10 +7,14 @@
 -----------------------------------------------------------------------------
 
 module DriverFlags ( 
-       processArgs, OptKind(..), static_flags, dynamic_flags, 
+       processDynamicFlags,
+       processStaticFlags,
+
        addCmdlineHCInclude,
        buildStaticHscOpts, 
-       machdepCCOpts
+       machdepCCOpts,
+
+       processArgs, OptKind(..), -- for DriverMkDepend only
   ) where
 
 #include "HsVersions.h"
@@ -25,9 +29,10 @@ import CmdLineOpts
 import Config
 import Util
 import Panic
+import FastString      ( mkFastString )
 
 import EXCEPTION
-import DATA_IOREF      ( readIORef, writeIORef )
+import DATA_IOREF      ( IORef, readIORef, writeIORef )
 
 import System          ( exitWith, ExitCode(..) )
 import IO
@@ -57,6 +62,9 @@ import Char
 -----------------------------------------------------------------------------
 -- Process command-line  
 
+processStaticFlags :: [String] -> IO [String]
+processStaticFlags opts = processArgs static_flags opts []
+
 data OptKind
        = NoArg (IO ())                     -- flag with no argument
        | HasArg (String -> IO ())          -- flag has an argument (maybe prefix)
@@ -258,7 +266,6 @@ static_flags =
                                ) )
 
        ------- Include/Import Paths ----------------------------------------
-  ,  ( "i"             , OptPrefix (addToOrDeleteDirList v_Import_paths) )
   ,  ( "I"             , Prefix    (addToDirList v_Include_paths) )
 
        ------- Libraries ---------------------------------------------------
@@ -271,13 +278,6 @@ static_flags =
   ,  ( "framework-path" , HasArg (addToDirList v_Framework_paths) )
   ,  ( "framework"     , HasArg (add v_Cmdline_frameworks) )
 #endif
-        ------- Packages ----------------------------------------------------
-  ,  ( "package-name"   , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
-
-  ,  ( "package-conf"   , HasArg (readPackageConf) )
-  ,  ( "package"        , HasArg (addPackage) )
-  ,  ( "syslib"         , HasArg (addPackage) )        -- for compatibility w/ old vsns
-
         ------- Specific phases  --------------------------------------------
   ,  ( "pgmL"           , HasArg setPgmL )
   ,  ( "pgmP"           , HasArg setPgmP )
@@ -340,10 +340,22 @@ dynamic_flags = [
   ,  ( "opti",         HasArg (addOpt_i) )
 #endif
 
+        ------- Packages ----------------------------------------------------
+  ,  ( "package-conf"   , HasArg extraPkgConf_ )
+  ,  ( "no-user-package-conf", NoArg noUserPkgConf_ )
+  ,  ( "package-name"   , HasArg ignorePackage ) -- for compatibility
+  ,  ( "package"        , HasArg exposePackage )
+  ,  ( "hide-package"   , HasArg hidePackage )
+  ,  ( "ignore-package" , HasArg ignorePackage )
+  ,  ( "syslib"         , HasArg exposePackage )  -- for compatibility
+
        ------ HsCpp opts ---------------------------------------------------
   ,  ( "D",            AnySuffix addOpt_P )
   ,  ( "U",            AnySuffix addOpt_P )
 
+        ------- Paths & stuff -----------------------------------------------
+  ,  ( "i"             , OptPrefix addImportPath )
+
        ------ Debugging ----------------------------------------------------
   ,  ( "dstg-stats",   NoArg (writeIORef v_StgStats True) )
 
@@ -480,6 +492,75 @@ glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams ]
 isFFlag f = f `elem` (map fst fFlags)
 getFFlag f = fromJust (lookup f fFlags)
 
+-- -----------------------------------------------------------------------------
+-- Parsing the dynamic flags.
+
+-- we use a temporary global variable, for convenience
+
+GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags)
+
+processDynamicFlags :: [String] -> DynFlags -> IO (DynFlags,[String])
+processDynamicFlags args dflags = do
+  writeIORef v_DynFlags dflags
+  spare <- processArgs dynamic_flags args []
+  dflags <- readIORef v_DynFlags
+  return (dflags,spare)
+
+updDynFlags :: (DynFlags -> DynFlags) -> IO ()
+updDynFlags f = do dfs <- readIORef v_DynFlags
+                  writeIORef v_DynFlags (f dfs)
+
+setDynFlag, unSetDynFlag :: DynFlag -> IO ()
+setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
+unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
+
+addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
+addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
+addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s})
+addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
+addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
+addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
+#ifdef ILX
+addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
+addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
+#endif
+
+setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
+setVerbosity n 
+  | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
+  | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
+
+addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
+
+extraPkgConf_  p = updDynFlags (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
+noUserPkgConf_   = updDynFlags (\s -> s{ readUserPkgConf = False })
+
+exposePackage p = 
+  updDynFlags (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
+hidePackage p = 
+  updDynFlags (\s -> s{ packageFlags = HidePackage p : packageFlags s })
+ignorePackage p = 
+  updDynFlags (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
+
+-- -i on its own deletes the import paths
+addImportPath "" = updDynFlags (\s -> s{importPaths = []})
+addImportPath p  = updDynFlags (\s -> s{importPaths = p : importPaths s})
+
+-- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags 
+-- (-fvia-C, -fasm, -filx respectively).
+setLang l = updDynFlags (\dfs -> case hscLang dfs of
+                                       HscC   -> dfs{ hscLang = l }
+                                       HscAsm -> dfs{ hscLang = l }
+                                       HscILX -> dfs{ hscLang = l }
+                                       _      -> dfs)
+
+setOptLevel :: Int -> IO ()
+setOptLevel n 
+   = do dflags <- readIORef v_DynFlags
+       if hscLang dflags == HscInterpreted && n > 0
+         then putStr "warning: -O conflicts with --interactive; -O ignored.\n"
+         else writeIORef v_DynFlags (updOptLevel n dflags)
+
 -----------------------------------------------------------------------------
 -- convert sizes like "3.5M" into integers
 
@@ -547,7 +628,7 @@ setMainIs arg
 --                    , registerised HC compilations
 --                    )
 
-machdepCCOpts 
+machdepCCOpts dflags
    | prefixMatch "alpha"   cTARGETPLATFORM  
        = return ( ["-w", "-mieee"
 #ifdef HAVE_THREADED_RTS_SUPPORT
@@ -580,7 +661,7 @@ machdepCCOpts
       --
       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
       --   the fp (%ebp) for our register maps.
-       = do n_regs <- dynFlag stolen_x86_regs
+       = do let n_regs = stolen_x86_regs dflags
             sta    <- readIORef v_Static
             return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
 --                    , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" 
@@ -642,24 +723,6 @@ machdepCCOpts
 -----------------------------------------------------------------------------
 -- local utils
 
-addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
-addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
-addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s})
-addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
-addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
-addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
-#ifdef ILX
-addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
-addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
-#endif
-
-setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
-setVerbosity n 
-  | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
-  | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
-
-addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
-
 -- -----------------------------------------------------------------------------
 -- Version and usage messages
 
index b376102..dda568f 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.33 2004/09/30 10:37:10 simonpj Exp $
+-- $Id: DriverMkDepend.hs,v 1.34 2004/11/26 16:20:52 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -13,16 +13,17 @@ module DriverMkDepend (
 
 #include "HsVersions.h"
 
+import HscTypes                ( IfacePackage(..) )
 import GetImports      ( getImports )
+import CmdLineOpts     ( DynFlags )
 import DriverState      
 import DriverUtil
 import DriverFlags
 import SysTools                ( newTempName )
 import qualified SysTools
-import Module          ( ModuleName, ModLocation(..),
-                         moduleNameUserString, isHomeModule )
+import Module          ( Module, ModLocation(..), moduleUserString)
 import Finder          ( findModule, hiBootExt, hiBootVerExt,
-                         mkHomeModLocation )
+                         mkHomeModLocation, FindResult(..) )
 import Util             ( global, maybePrefixMatch )
 import Panic
 
@@ -52,7 +53,6 @@ GLOBAL_VAR(v_Dep_warnings,            True, Bool);
 GLOBAL_VAR(v_Dep_makefile_hdl,  error "dep_makefile_hdl", Maybe Handle);
 GLOBAL_VAR(v_Dep_tmp_file,      error "dep_tmp_file", String);
 GLOBAL_VAR(v_Dep_tmp_hdl,       error "dep_tmp_hdl", Handle);
-GLOBAL_VAR(v_Dep_dir_contents,  error "dep_dir_contents", [(String,[String])]);
 
 depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
 depEndMarker   = "# DO NOT DELETE: End of Haskell dependencies"
@@ -119,32 +119,22 @@ beginMkDependHS = do
        -- write the magic marker into the tmp file
   hPutStrLn tmp_hdl depStartMarker
 
-       -- cache the contents of all the import directories, for future
-       -- reference.
-  import_dirs <- readIORef v_Import_paths
-  pkg_import_dirs <- getPackageImportPath
-  import_dir_contents <- mapM softGetDirectoryContents import_dirs
-  pkg_import_dir_contents <- mapM softGetDirectoryContents pkg_import_dirs
-  writeIORef v_Dep_dir_contents 
-       (zip import_dirs import_dir_contents ++
-        zip pkg_import_dirs pkg_import_dir_contents)
-
   return ()
 
 
-doMkDependHSPhase basename suff input_fn
+doMkDependHSPhase dflags basename suff input_fn
  = do src <- readFile input_fn
       let (import_sources, import_normals, mod_name) = getImports src
       let orig_fn = basename ++ '.':suff
-      (_, location') <- mkHomeModLocation mod_name orig_fn
+      location' <- mkHomeModLocation mod_name orig_fn
 
       -- take -ohi into account if present
       ohi <- readIORef v_Output_hi
       let location | Just fn <- ohi = location'{ ml_hi_file = fn }
                   | otherwise      = location'
 
-      deps_sources <- mapM (findDependency True  orig_fn) import_sources
-      deps_normals <- mapM (findDependency False orig_fn) import_normals
+      deps_sources <- mapM (findDependency dflags True  orig_fn) import_sources
+      deps_normals <- mapM (findDependency dflags False orig_fn) import_normals
       let deps = deps_sources ++ deps_normals
 
       osuf <- readIORef v_Object_suf
@@ -210,8 +200,8 @@ doMkDependHSPhase basename suff input_fn
    
 
 
-endMkDependHS :: IO ()
-endMkDependHS = do
+endMkDependHS :: DynFlags -> IO ()
+endMkDependHS dflags = do
   makefile     <- readIORef v_Dep_makefile
   makefile_hdl <- readIORef v_Dep_makefile_hdl
   tmp_file     <- readIORef v_Dep_tmp_file
@@ -239,25 +229,26 @@ endMkDependHS = do
 
        -- Create a backup of the original makefile
   when (isJust makefile_hdl)
-       (SysTools.copy ("Backing up " ++ makefile) makefile (makefile++".bak"))
+       (SysTools.copy dflags ("Backing up " ++ makefile) 
+               makefile (makefile++".bak"))
 
        -- Copy the new makefile in place
-  SysTools.copy "Installing new makefile" tmp_file makefile
+  SysTools.copy dflags "Installing new makefile" tmp_file makefile
 
 
-findDependency :: Bool -> FilePath -> ModuleName -> IO (Maybe (String, Bool))
-findDependency is_source src imp = do
+findDependency :: DynFlags -> Bool -> FilePath -> Module -> IO (Maybe (String, Bool))
+findDependency dflags is_source src imp = do
    excl_mods <- readIORef v_Dep_exclude_mods
    include_prelude <- readIORef v_Dep_include_prelude
-   let imp_mod = moduleNameUserString imp
+   let imp_mod = moduleUserString imp
    if imp_mod `elem` excl_mods 
       then return Nothing
       else do
-       r <- findModule imp
+       r <- findModule dflags imp True{-explicit-}
        case r of 
-          Right (mod,loc)
+          Found loc pkg
                -- not in this package: we don't need a dependency
-               | not (isHomeModule mod) && not include_prelude
+               | ExternalPackage _ <- pkg, not include_prelude
                -> return Nothing
 
                -- normal import: just depend on the .hi file
@@ -280,6 +271,6 @@ findDependency is_source src imp = do
                           then return (Just (boot_hi_file, not is_source))
                           else return (Just (hi_file, not is_source))
 
-          Left _ -> throwDyn (ProgramError 
+          _ -> throwDyn (ProgramError 
                (src ++ ": " ++ "can't locate import `" ++ imp_mod ++ "'" ++
                 if is_source then " (SOURCE import)" else ""))
index f4ec787..9d8de34 100644 (file)
@@ -66,11 +66,10 @@ import Maybe
 -- Just preprocess a file, put the result in a temp. file (used by the
 -- compilation manager during the summary phase).
 
-preprocess :: FilePath -> IO FilePath
-preprocess filename =
+preprocess :: DynFlags -> FilePath -> IO FilePath
+preprocess dflags filename =
   ASSERT(isHaskellSrcFilename filename) 
-  do restoreDynFlags   -- Restore to state of last save
-     runPipeline (StopBefore Hsc) ("preprocess") 
+  do runPipeline (StopBefore Hsc) dflags ("preprocess") 
        False{-temporary output file-}
        Nothing{-no specific output file-}
        filename
@@ -119,24 +118,24 @@ compile hsc_env this_mod location src_timestamp
        source_unchanged have_object 
        old_iface = do 
 
-   dyn_flags <- restoreDynFlags                -- Restore to the state of the last save
+   let dyn_flags = hsc_dflags hsc_env
 
-   showPass dyn_flags 
+   showPass dyn_flags
        (showSDoc (text "Compiling" <+> ppr this_mod))
 
    let verb      = verbosity dyn_flags
    let input_fn   = expectJust "compile:hs" (ml_hs_file location) 
    let input_fnpp = expectJust "compile:hspp" (ml_hspp_file location)
-   let mod_name   = moduleName this_mod
 
    when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
 
+   -- add in the OPTIONS from the source file
    opts <- getOptionsFromSource input_fnpp
-   processArgs dynamic_flags opts []
-   dyn_flags <- getDynFlags
+   (dyn_flags,unhandled_flags) <- processDynamicFlags opts dyn_flags
+   checkProcessArgsResult unhandled_flags input_fn
 
    let (basename, _) = splitFilename input_fn
-       
+
   -- We add the directory in which the .hs files resides) to the import path.
   -- This is needed when we try to compile the .hc file later, if it
   -- imports a _stub.h file that we created here.
@@ -204,14 +203,14 @@ compile hsc_env this_mod location src_timestamp
                _other -> do
                   let object_filename = ml_obj_file location
 
-                  runPipeline (StopBefore Ln) ""
+                  runPipeline (StopBefore Ln) dyn_flags ""
                        True Nothing output_fn (Just location)
                        -- the object filename comes from the ModLocation
 
                   o_time <- getModificationTime object_filename
                   return ([DotO object_filename], o_time)
 
-          let linkable = LM unlinked_time mod_name
+          let linkable = LM unlinked_time this_mod
                             (hs_unlinked ++ stub_unlinked)
 
           return (CompOK details rdr_env iface (Just linkable))
@@ -224,7 +223,7 @@ compileStub dflags stub_c_exists
   | stub_c_exists = do
        -- compile the _stub.c file w/ gcc
        let stub_c = hscStubCOutName dflags
-       stub_o <- runPipeline (StopBefore Ln) "stub-compile"
+       stub_o <- runPipeline (StopBefore Ln) dflags "stub-compile"
                        True{-persistent output-} 
                        Nothing{-no specific output file-}
                        stub_c
@@ -285,7 +284,7 @@ link Batch dflags batch_attempt_linking hpt
            obj_files = concatMap getOfiles linkables
 
        -- Don't showPass in Batch mode; doLink will do that for us.
-        staticLink obj_files pkg_deps
+        staticLink dflags obj_files pkg_deps
 
         when (verb >= 3) (hPutStrLn stderr "link: done")
 
@@ -303,8 +302,13 @@ link Batch dflags batch_attempt_linking hpt
 -- ---------------------------------------------------------------------------
 -- Run a compilation pipeline, consisting of multiple phases.
 
+-- The DynFlags can be modified by phases in the pipeline (eg. by
+-- OPTIONS pragmas), and the changes affect later phases in the
+-- pipeline, but we throw away the resulting DynFlags at the end.
+
 runPipeline
   :: GhcMode           -- when to stop
+  -> DynFlags          -- dynamic flags
   -> String            -- "stop after" flag
   -> Bool              -- final output is persistent?
   -> Maybe FilePath    -- where to put the output, optionally
@@ -312,7 +316,8 @@ runPipeline
   -> Maybe ModLocation  -- a ModLocation for this module, if we have one
   -> IO FilePath       -- output filename
 
-runPipeline todo stop_flag keep_output maybe_output_filename input_fn maybe_loc
+runPipeline todo dflags stop_flag keep_output 
+  maybe_output_filename input_fn maybe_loc
   = do
   split <- readIORef v_Split_object_files
   let (basename, suffix) = splitFilename input_fn
@@ -345,7 +350,7 @@ runPipeline todo stop_flag keep_output maybe_output_filename input_fn maybe_loc
 
   -- and execute the pipeline...
   (output_fn, maybe_loc) <- 
-       pipeLoop start_phase stop_phase input_fn basename suffix 
+       pipeLoop dflags start_phase stop_phase input_fn basename suffix 
                 get_output_fn maybe_loc
 
   -- sometimes, a compilation phase doesn't actually generate any output
@@ -355,18 +360,18 @@ runPipeline todo stop_flag keep_output maybe_output_filename input_fn maybe_loc
   if keep_output
        then do final_fn <- get_output_fn stop_phase maybe_loc
                when (final_fn /= output_fn) $
-                 copy ("Copying `" ++ output_fn ++ "' to `" ++ final_fn
+                 copy dflags ("Copying `" ++ output_fn ++ "' to `" ++ final_fn
                        ++ "'") output_fn final_fn
                return final_fn
        else
             return output_fn
 
 
-pipeLoop :: Phase -> Phase -> FilePath -> String -> Suffix
+pipeLoop :: DynFlags -> Phase -> Phase -> FilePath -> String -> Suffix
   -> (Phase -> Maybe ModLocation -> IO FilePath)
   -> Maybe ModLocation -> IO (FilePath, Maybe ModLocation)
 
-pipeLoop phase stop_phase input_fn orig_basename orig_suff 
+pipeLoop dflags phase stop_phase input_fn orig_basename orig_suff 
        get_output_fn maybe_loc
 
   | phase == stop_phase  =  return (input_fn, maybe_loc)  -- all done
@@ -380,16 +385,16 @@ pipeLoop phase stop_phase input_fn orig_basename orig_suff
                " but I wanted to stop at phase " ++ show stop_phase)
 
   | otherwise = do
-       maybe_next_phase <- runPhase phase orig_basename orig_suff input_fn
-                               get_output_fn maybe_loc
+       maybe_next_phase <- runPhase phase dflags orig_basename 
+                               orig_suff input_fn get_output_fn maybe_loc
        case maybe_next_phase of
-         (Nothing, maybe_loc, output_fn) -> do
+         (Nothing, dflags, maybe_loc, output_fn) -> do
                -- we stopped early, but return the *final* filename
                -- (it presumably already exists)
                final_fn <- get_output_fn stop_phase maybe_loc
                return (final_fn, maybe_loc)
-         (Just next_phase, maybe_loc, output_fn) ->
-               pipeLoop next_phase stop_phase output_fn
+         (Just next_phase, dflags', maybe_loc, output_fn) ->
+               pipeLoop dflags' next_phase stop_phase output_fn
                        orig_basename orig_suff get_output_fn maybe_loc
 
   
@@ -459,84 +464,86 @@ genOutputFilenameFunc keep_final_output maybe_output_filename
 -- taking the via-C route to using the native code generator.
 
 runPhase :: Phase
-         -> String     -- basename of original input source
-         -> String     -- its extension
-         -> FilePath   -- name of file which contains the input to this phase.
-         -> (Phase -> Maybe ModLocation -> IO FilePath)
+        -> DynFlags
+        -> String      -- basename of original input source
+        -> String      -- its extension
+        -> FilePath    -- name of file which contains the input to this phase.
+        -> (Phase -> Maybe ModLocation -> IO FilePath)
                        -- how to calculate the output filename
-         -> Maybe ModLocation          -- the ModLocation, if we have one
-         -> IO (Maybe Phase,           -- next phase
-                Maybe ModLocation,     -- the ModLocation, if we have one
-                FilePath)              -- output filename
+        -> Maybe ModLocation           -- the ModLocation, if we have one
+        -> IO (Maybe Phase,            -- next phase
+               DynFlags,               -- new dynamic flags
+               Maybe ModLocation,      -- the ModLocation, if we have one
+               FilePath)               -- output filename
 
 -------------------------------------------------------------------------------
 -- Unlit phase 
 
-runPhase Unlit _basename _suff input_fn get_output_fn maybe_loc
-  = do unlit_flags <- getOpts opt_L
+runPhase Unlit dflags _basename _suff input_fn get_output_fn maybe_loc
+  = do let unlit_flags = getOpts dflags opt_L
        -- The -h option passes the file name for unlit to put in a #line directive
        output_fn <- get_output_fn Cpp maybe_loc
 
-       SysTools.runUnlit (map SysTools.Option unlit_flags ++
+       SysTools.runUnlit dflags 
+               (map SysTools.Option unlit_flags ++
                                  [ SysTools.Option     "-h"
                          , SysTools.Option     input_fn
                          , SysTools.FileOption "" input_fn
                          , SysTools.FileOption "" output_fn
                          ])
 
-       return (Just Cpp, maybe_loc, output_fn)
+       return (Just Cpp, dflags, maybe_loc, output_fn)
 
 -------------------------------------------------------------------------------
 -- Cpp phase 
 
-runPhase Cpp basename suff input_fn get_output_fn maybe_loc
+runPhase Cpp dflags basename suff input_fn get_output_fn maybe_loc
   = do src_opts <- getOptionsFromSource input_fn
-       unhandled_flags <- processArgs dynamic_flags src_opts []
-       checkProcessArgsResult unhandled_flags basename suff
+       (dflags,unhandled_flags) <- processDynamicFlags src_opts dflags
+       checkProcessArgsResult unhandled_flags (basename++'.':suff)
 
-       do_cpp <- dynFlag cppFlag
-       if not do_cpp then
+       if not (cppFlag dflags) then
            -- no need to preprocess CPP, just pass input file along
           -- to the next phase of the pipeline.
-          return (Just HsPp, maybe_loc, input_fn)
+          return (Just HsPp, dflags, maybe_loc, input_fn)
        else do
            output_fn <- get_output_fn HsPp maybe_loc
-           doCpp True{-raw-} False{-no CC opts-} input_fn output_fn
-           return (Just HsPp, maybe_loc, output_fn)
+           doCpp dflags True{-raw-} False{-no CC opts-} input_fn output_fn
+           return (Just HsPp, dflags, maybe_loc, output_fn)
 
 -------------------------------------------------------------------------------
 -- HsPp phase 
 
-runPhase HsPp basename suff input_fn get_output_fn maybe_loc
-  = do do_pp   <- dynFlag ppFlag
-       if not do_pp then
+runPhase HsPp dflags basename suff input_fn get_output_fn maybe_loc
+  = do if not (ppFlag dflags) then
            -- no need to preprocess, just pass input file along
           -- to the next phase of the pipeline.
-          return (Just Hsc, maybe_loc, input_fn)
+          return (Just Hsc, dflags, maybe_loc, input_fn)
        else do
-           hspp_opts      <- getOpts opt_F
+           let hspp_opts = getOpts dflags opt_F
                    hs_src_pp_opts <- readIORef v_Hs_source_pp_opts
            let orig_fn = basename ++ '.':suff
            output_fn <- get_output_fn Hsc maybe_loc
-           SysTools.runPp ( [ SysTools.Option     orig_fn
+           SysTools.runPp dflags
+                          ( [ SysTools.Option     orig_fn
                             , SysTools.Option     input_fn
                             , SysTools.FileOption "" output_fn
                             ] ++
                             map SysTools.Option hs_src_pp_opts ++
                             map SysTools.Option hspp_opts
                           )
-           return (Just Hsc, maybe_loc, output_fn)
+           return (Just Hsc, dflags, maybe_loc, output_fn)
 
 -----------------------------------------------------------------------------
 -- Hsc phase
 
 -- Compilation of a single module, in "legacy" mode (_not_ under
 -- the direction of the compilation manager).
-runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = do
+runPhase Hsc dflags basename suff input_fn get_output_fn _maybe_loc = do
   todo <- readIORef v_GhcMode
   if todo == DoMkDependHS then do
-       locn <- doMkDependHSPhase basename suff input_fn
-       return (Nothing, Just locn, input_fn)  -- Ln is a dummy stop phase 
+       locn <- doMkDependHSPhase dflags basename suff input_fn
+       return (Nothing, dflags, Just locn, input_fn)  -- Ln is a dummy stop phase 
 
    else do
       -- normal Hsc mode, not mkdependHS
@@ -555,12 +562,12 @@ runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = do
             then do
                -- no explicit imports in ExtCore input.
               m <- getCoreModuleName input_fn
-              return ([], [], mkModuleName m)
+              return ([], [], mkModule m)
             else 
               getImportsFromFile input_fn
 
   -- build a ModLocation to pass to hscMain.
-       (mod, location') <- mkHomeModLocation mod_name (basename ++ '.':suff)
+       location' <- mkHomeModLocation mod_name (basename ++ '.':suff)
 
   -- take -ohi into account if present
        ohi <- readIORef v_Output_hi
@@ -598,20 +605,19 @@ runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = do
                                  else return False
 
   -- get the DynFlags
-        dyn_flags <- getDynFlags
-       hsc_lang <- hscMaybeAdjustLang (hscLang dyn_flags)
+       hsc_lang <- hscMaybeAdjustLang (hscLang dflags)
        next_phase <- hscNextPhase hsc_lang
        output_fn <- get_output_fn next_phase (Just location)
 
-        let dyn_flags' = dyn_flags { hscLang = hsc_lang,
-                                    hscOutName = output_fn,
-                                    hscStubCOutName = basename ++ "_stub.c",
-                                    hscStubHOutName = basename ++ "_stub.h",
-                                    extCoreName = basename ++ ".hcr" }
-       hsc_env <- newHscEnv OneShot dyn_flags'
+        let dflags' = dflags { hscLang = hsc_lang,
+                              hscOutName = output_fn,
+                              hscStubCOutName = basename ++ "_stub.c",
+                              hscStubHOutName = basename ++ "_stub.h",
+                              extCoreName = basename ++ ".hcr" }
+       hsc_env <- newHscEnv OneShot dflags'
 
   -- run the compiler!
-       result <- hscMain hsc_env printErrorsAndWarnings mod
+       result <- hscMain hsc_env printErrorsAndWarnings mod_name
                          location{ ml_hspp_file=Just input_fn }
                          source_unchanged
                          False
@@ -622,49 +628,48 @@ runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = do
            HscFail -> throwDyn (PhaseFailed "hsc" (ExitFailure 1))
 
             HscNoRecomp details iface -> do
-               SysTools.touch "Touching object file" o_file
-               return (Nothing, Just location, output_fn)
+               SysTools.touch dflags' "Touching object file" o_file
+               return (Nothing, dflags', Just location, output_fn)
 
            HscRecomp _details _rdr_env _iface 
                      stub_h_exists stub_c_exists
                      _maybe_interpreted_code -> do
 
                -- deal with stubs
-               maybe_stub_o <- compileStub dyn_flags' stub_c_exists
+               maybe_stub_o <- compileStub dflags' stub_c_exists
                case maybe_stub_o of
                      Nothing -> return ()
                      Just stub_o -> add v_Ld_inputs stub_o
-               case hscLang dyn_flags of
-                      HscNothing -> return (Nothing, Just location, output_fn)
-                     _ -> return (Just next_phase, Just location, output_fn)
+               case hscLang dflags' of
+                      HscNothing -> return (Nothing, dflags', Just location, output_fn)
+                     _ -> return (Just next_phase, dflags', Just location, output_fn)
 
 -----------------------------------------------------------------------------
 -- Cmm phase
 
-runPhase CmmCpp basename suff input_fn get_output_fn maybe_loc
+runPhase CmmCpp dflags basename suff input_fn get_output_fn maybe_loc
   = do
        output_fn <- get_output_fn Cmm maybe_loc
-       doCpp False{-not raw-} True{-include CC opts-} input_fn output_fn       
-       return (Just Cmm, maybe_loc, output_fn)
+       doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn        
+       return (Just Cmm, dflags, maybe_loc, output_fn)
 
-runPhase Cmm basename suff input_fn get_output_fn maybe_loc
+runPhase Cmm dflags basename suff input_fn get_output_fn maybe_loc
   = do
-        dyn_flags <- getDynFlags
-       hsc_lang <- hscMaybeAdjustLang (hscLang dyn_flags)
+       hsc_lang <- hscMaybeAdjustLang (hscLang dflags)
        next_phase <- hscNextPhase hsc_lang
        output_fn <- get_output_fn next_phase maybe_loc
 
-        let dyn_flags' = dyn_flags { hscLang = hsc_lang,
-                                    hscOutName = output_fn,
-                                    hscStubCOutName = basename ++ "_stub.c",
-                                    hscStubHOutName = basename ++ "_stub.h",
-                                    extCoreName = basename ++ ".hcr" }
+        let dflags' = dflags { hscLang = hsc_lang,
+                              hscOutName = output_fn,
+                              hscStubCOutName = basename ++ "_stub.c",
+                              hscStubHOutName = basename ++ "_stub.h",
+                              extCoreName = basename ++ ".hcr" }
 
-       ok <- hscCmmFile dyn_flags' input_fn
+       ok <- hscCmmFile dflags' input_fn
 
        when (not ok) $ throwDyn (PhaseFailed "cmm" (ExitFailure 1))
 
-       return (Just next_phase, maybe_loc, output_fn)
+       return (Just next_phase, dflags, maybe_loc, output_fn)
 
 -----------------------------------------------------------------------------
 -- Cc phase
@@ -672,9 +677,9 @@ runPhase Cmm basename suff input_fn get_output_fn maybe_loc
 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 -- way too many hacks, and I can't say I've ever used it anyway.
 
-runPhase cc_phase basename suff input_fn get_output_fn maybe_loc
+runPhase cc_phase dflags basename suff input_fn get_output_fn maybe_loc
    | cc_phase == Cc || cc_phase == HCc
-   = do        cc_opts <- getOpts opt_c
+   = do        let cc_opts = getOpts dflags opt_c
                cmdline_include_paths <- readIORef v_Include_paths
 
        split  <- readIORef v_Split_object_files
@@ -694,16 +699,16 @@ runPhase cc_phase basename suff input_fn get_output_fn maybe_loc
        -- add package include paths even if we're just compiling .c
        -- files; this is the Value Add(TM) that using ghc instead of
        -- gcc gives you :)
-        pkg_include_dirs <- getPackageIncludePath pkgs
+        pkg_include_dirs <- getPackageIncludePath dflags pkgs
         let include_paths = foldr (\ x xs -> "-I" : x : xs) []
                              (cmdline_include_paths ++ pkg_include_dirs)
 
        mangle <- readIORef v_Do_asm_mangling
-       (md_c_flags, md_regd_c_flags) <- machdepCCOpts
+       (md_c_flags, md_regd_c_flags) <- machdepCCOpts dflags
 
-        verb <- getVerbFlag
+        let verb = getVerbFlag dflags
 
-       pkg_extra_cc_opts <- getPackageExtraCcOpts pkgs
+       pkg_extra_cc_opts <- getPackageExtraCcOpts dflags pkgs
 
        split_objs <- readIORef v_Split_object_files
        let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
@@ -717,7 +722,7 @@ runPhase cc_phase basename suff input_fn get_output_fn maybe_loc
                | cc_phase == HCc = [ SysTools.Option "-x", SysTools.Option "c"]
                | otherwise       = [ ]
 
-       SysTools.runCc (langopt ++
+       SysTools.runCc dflags (langopt ++
                        [ SysTools.FileOption "" input_fn
                        , SysTools.Option "-o"
                        , SysTools.FileOption "" output_fn
@@ -736,17 +741,17 @@ runPhase cc_phase basename suff input_fn get_output_fn maybe_loc
                       ++ pkg_extra_cc_opts
                       ))
 
-       return (Just next_phase, maybe_loc, output_fn)
+       return (Just next_phase, dflags, maybe_loc, output_fn)
 
        -- ToDo: postprocess the output from gcc
 
 -----------------------------------------------------------------------------
 -- Mangle phase
 
-runPhase Mangle _basename _suff input_fn get_output_fn maybe_loc
-   = do mangler_opts <- getOpts opt_m
+runPhase Mangle dflags _basename _suff input_fn get_output_fn maybe_loc
+   = do let mangler_opts = getOpts dflags opt_m
         machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM)
-                         then do n_regs <- dynFlag stolen_x86_regs
+                         then do let n_regs = stolen_x86_regs dflags
                                  return [ show n_regs ]
                          else return []
 
@@ -756,24 +761,25 @@ runPhase Mangle _basename _suff input_fn get_output_fn maybe_loc
                | otherwise = As
        output_fn <- get_output_fn next_phase maybe_loc
 
-       SysTools.runMangle (map SysTools.Option mangler_opts
+       SysTools.runMangle dflags (map SysTools.Option mangler_opts
                          ++ [ SysTools.FileOption "" input_fn
                             , SysTools.FileOption "" output_fn
                             ]
                          ++ map SysTools.Option machdep_opts)
 
-       return (Just next_phase, maybe_loc, output_fn)
+       return (Just next_phase, dflags, maybe_loc, output_fn)
 
 -----------------------------------------------------------------------------
 -- Splitting phase
 
-runPhase SplitMangle _basename _suff input_fn get_output_fn maybe_loc
+runPhase SplitMangle dflags _basename _suff input_fn get_output_fn maybe_loc
   = do  -- tmp_pfx is the prefix used for the split .s files
        -- We also use it as the file to contain the no. of split .s files (sigh)
        split_s_prefix <- SysTools.newTempName "split"
        let n_files_fn = split_s_prefix
 
-       SysTools.runSplit [ SysTools.FileOption "" input_fn
+       SysTools.runSplit dflags
+                         [ SysTools.FileOption "" input_fn
                          , SysTools.FileOption "" split_s_prefix
                          , SysTools.FileOption "" n_files_fn
                          ]
@@ -787,14 +793,14 @@ runPhase SplitMangle _basename _suff input_fn get_output_fn maybe_loc
        addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
                        | n <- [1..n_files]]
 
-       return (Just SplitAs, maybe_loc, "**splitmangle**")
+       return (Just SplitAs, dflags, maybe_loc, "**splitmangle**")
          -- we don't use the filename
 
 -----------------------------------------------------------------------------
 -- As phase
 
-runPhase As _basename _suff input_fn get_output_fn maybe_loc
-  = do as_opts               <- getOpts opt_a
+runPhase As dflags _basename _suff input_fn get_output_fn maybe_loc
+  = do let as_opts =  getOpts dflags opt_a
         cmdline_include_paths <- readIORef v_Include_paths
 
        output_fn <- get_output_fn Ln maybe_loc
@@ -803,7 +809,8 @@ runPhase As _basename _suff input_fn get_output_fn maybe_loc
        -- might be a hierarchical module.
        createDirectoryHierarchy (directoryOf output_fn)
 
-       SysTools.runAs (map SysTools.Option as_opts
+       SysTools.runAs dflags   
+                      (map SysTools.Option as_opts
                       ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
                       ++ [ SysTools.Option "-c"
                          , SysTools.FileOption "" input_fn
@@ -811,11 +818,11 @@ runPhase As _basename _suff input_fn get_output_fn maybe_loc
                          , SysTools.FileOption "" output_fn
                          ])
 
-       return (Just Ln, maybe_loc, output_fn)
+       return (Just Ln, dflags, maybe_loc, output_fn)
 
 
-runPhase SplitAs basename _suff _input_fn get_output_fn maybe_loc
-  = do  as_opts <- getOpts opt_a
+runPhase SplitAs dflags basename _suff _input_fn get_output_fn maybe_loc
+  = do  let as_opts = getOpts dflags opt_a
 
        (split_s_prefix, n) <- readIORef v_Split_info
 
@@ -830,7 +837,8 @@ runPhase SplitAs basename _suff _input_fn get_output_fn maybe_loc
                                        (basename ++ "__" ++ show n ++ ".o")
                                         real_odir
                    real_o <- osuf_ify output_o
-                   SysTools.runAs (map SysTools.Option as_opts ++
+                   SysTools.runAs dflags
+                                (map SysTools.Option as_opts ++
                                    [ SysTools.Option "-c"
                                    , SysTools.Option "-o"
                                    , SysTools.FileOption "" real_o
@@ -840,15 +848,15 @@ runPhase SplitAs basename _suff _input_fn get_output_fn maybe_loc
        mapM_ assemble_file [1..n]
 
        output_fn <- get_output_fn Ln maybe_loc
-       return (Just Ln, maybe_loc, output_fn)
+       return (Just Ln, dflags, maybe_loc, output_fn)
 
 #ifdef ILX
 -----------------------------------------------------------------------------
 -- Ilx2Il phase
 -- Run ilx2il over the ILX output, getting an IL file
 
-runPhase Ilx2Il _basename _suff input_fn get_output_fn maybe_loc
-  = do ilx2il_opts <- getOpts opt_I
+runPhase Ilx2Il dflags _basename _suff input_fn get_output_fn maybe_loc
+  = do let ilx2il_opts = getOpts dflags opt_I
         SysTools.runIlx2il (map SysTools.Option ilx2il_opts
                            ++ [ SysTools.Option "--no-add-suffix-to-assembly",
                                SysTools.Option "mscorlib",
@@ -861,8 +869,8 @@ runPhase Ilx2Il _basename _suff input_fn get_output_fn maybe_loc
 -- Ilasm phase
 -- Run ilasm over the IL, getting a DLL
 
-runPhase Ilasm _basename _suff input_fn get_output_fn maybe_loc
-  = do ilasm_opts <- getOpts opt_i
+runPhase Ilasm dflags _basename _suff input_fn get_output_fn maybe_loc
+  = do let ilasm_opts = getOpts dflags opt_i
         SysTools.runIlasm (map SysTools.Option ilasm_opts
                           ++ [ SysTools.Option "/QUIET",
                                SysTools.Option "/DLL",
@@ -959,9 +967,9 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
 -----------------------------------------------------------------------------
 -- Complain about non-dynamic flags in OPTIONS pragmas
 
-checkProcessArgsResult flags basename suff
+checkProcessArgsResult flags filename
   = do when (notNull flags) (throwDyn (ProgramError (
-         showSDoc (hang (text basename <> text ('.':suff) <> char ':')
+         showSDoc (hang (text filename <> char ':')
                      4 (text "unknown flags in  {-# OPTIONS #-} pragma:" <+>
                          hsep (map text flags)))
        )))
@@ -969,13 +977,13 @@ checkProcessArgsResult flags basename suff
 -----------------------------------------------------------------------------
 -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
 
-getHCFilePackages :: FilePath -> IO [PackageName]
+getHCFilePackages :: FilePath -> IO [PackageId]
 getHCFilePackages filename =
   EXCEPTION.bracket (openFile filename ReadMode) hClose $ \h -> do
     l <- hGetLine h
     case l of
       '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
-         return (map mkPackageName (words rest))
+         return (map stringToPackageId (words rest))
       _other ->
          return []
 
@@ -992,9 +1000,9 @@ getHCFilePackages filename =
 -- read any interface files), so the user must explicitly specify all
 -- the packages.
 
-staticLink :: [FilePath] -> [PackageName] -> IO ()
-staticLink o_files dep_packages = do
-    verb       <- getVerbFlag
+staticLink :: DynFlags -> [FilePath] -> [PackageId] -> IO ()
+staticLink dflags o_files dep_packages = do
+    let verb = getVerbFlag dflags
     static     <- readIORef v_Static
     no_hs_main <- readIORef v_NoHsMain
 
@@ -1009,22 +1017,22 @@ staticLink o_files dep_packages = do
     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 #endif
 
-    pkg_lib_paths <- getPackageLibraryPath dep_packages
+    pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 
     lib_paths <- readIORef v_Library_paths
     let lib_path_opts = map ("-L"++) lib_paths
 
-    pkg_link_opts <- getPackageLinkOpts dep_packages
+    pkg_link_opts <- getPackageLinkOpts dflags dep_packages
 
 #ifdef darwin_TARGET_OS
-    pkg_framework_paths <- getPackageFrameworkPath dep_packages
+    pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
     let pkg_framework_path_opts = map ("-F"++) pkg_framework_paths
 
     framework_paths <- readIORef v_Framework_paths
     let framework_path_opts = map ("-F"++) framework_paths
 
-    pkg_frameworks <- getPackageFrameworks dep_packages
+    pkg_frameworks <- getPackageFrameworks dflags dep_packages
     let pkg_framework_opts = concat [ ["-framework", fw] | fw <- pkg_frameworks ]
 
     frameworks <- readIORef v_Cmdline_frameworks
@@ -1038,7 +1046,13 @@ staticLink o_files dep_packages = do
        -- opts from -optl-<blah> (including -l<blah> options)
     extra_ld_opts <- getStaticOpts v_Opt_l
 
-    [rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, basePackage]
+    let pstate = pkgState dflags
+       rts_id | Just id <- rtsPackageId pstate = id
+              | otherwise = panic "staticLink: rts package missing"
+       base_id | Just id <- basePackageId pstate = id
+               | otherwise = panic "staticLink: base package missing"
+       rts_pkg  = getPackageDetails pstate rts_id
+        base_pkg = getPackageDetails pstate base_id
 
     ways <- readIORef v_Ways
 
@@ -1067,10 +1081,11 @@ staticLink o_files dep_packages = do
     let extra_os = if static || no_hs_main
                    then []
                    else [ head (libraryDirs rts_pkg) ++ "/Main.dll_o",
-                          head (libraryDirs std_pkg) ++ "/PrelMain.dll_o" ]
+                          head (libraryDirs base_pkg) ++ "/PrelMain.dll_o" ]
 
-    (md_c_flags, _) <- machdepCCOpts
-    SysTools.runLink ( [ SysTools.Option verb
+    (md_c_flags, _) <- machdepCCOpts dflags
+    SysTools.runLink dflags ( 
+                      [ SysTools.Option verb
                       , SysTools.Option "-o"
                       , SysTools.FileOption "" output_fn
                       ]
@@ -1105,22 +1120,22 @@ staticLink o_files dep_packages = do
 -----------------------------------------------------------------------------
 -- Making a DLL (only for Win32)
 
-doMkDLL :: [String] -> [PackageName] -> IO ()
-doMkDLL o_files dep_packages = do
-    verb       <- getVerbFlag
+doMkDLL :: DynFlags -> [String] -> [PackageId] -> IO ()
+doMkDLL dflags o_files dep_packages = do
+    let verb = getVerbFlag dflags
     static     <- readIORef v_Static
     no_hs_main <- readIORef v_NoHsMain
 
     o_file <- readIORef v_Output_file
     let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
 
-    pkg_lib_paths <- getPackageLibraryPath dep_packages
+    pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
     let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
 
     lib_paths <- readIORef v_Library_paths
     let lib_path_opts = map ("-L"++) lib_paths
 
-    pkg_link_opts <- getPackageLinkOpts dep_packages
+    pkg_link_opts <- getPackageLinkOpts dflags dep_packages
 
        -- probably _stub.o files
     extra_ld_inputs <- readIORef v_Ld_inputs
@@ -1128,15 +1143,21 @@ doMkDLL o_files dep_packages = do
        -- opts from -optdll-<blah>
     extra_ld_opts <- getStaticOpts v_Opt_dll
 
-    [rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, basePackage]
+    let pstate = pkgState dflags
+       rts_id | Just id <- rtsPackageId pstate = id
+              | otherwise = panic "staticLink: rts package missing"
+       base_id | Just id <- basePackageId pstate = id
+               | otherwise = panic "staticLink: base package missing"
+       rts_pkg  = getPackageDetails pstate rts_id
+        base_pkg = getPackageDetails pstate base_id
 
     let extra_os = if static || no_hs_main
                    then []
                    else [ head (libraryDirs rts_pkg) ++ "/Main.dll_o",
-                          head (libraryDirs std_pkg) ++ "/PrelMain.dll_o" ]
+                          head (libraryDirs base_pkg) ++ "/PrelMain.dll_o" ]
 
-    (md_c_flags, _) <- machdepCCOpts
-    SysTools.runMkDLL
+    (md_c_flags, _) <- machdepCCOpts dflags
+    SysTools.runMkDLL dflags
         ([ SysTools.Option verb
          , SysTools.Option "-o"
          , SysTools.FileOption "" output_fn
@@ -1159,26 +1180,26 @@ doMkDLL o_files dep_packages = do
 -- -----------------------------------------------------------------------------
 -- Misc.
 
-doCpp :: Bool -> Bool -> FilePath -> FilePath -> IO ()
-doCpp raw include_cc_opts input_fn output_fn = do
-    hscpp_opts     <- getOpts opt_P
+doCpp :: DynFlags -> Bool -> Bool -> FilePath -> FilePath -> IO ()
+doCpp dflags raw include_cc_opts input_fn output_fn = do
+    let hscpp_opts = getOpts dflags opt_P
 
     cmdline_include_paths <- readIORef v_Include_paths
 
-    pkg_include_dirs <- getPackageIncludePath []
+    pkg_include_dirs <- getPackageIncludePath dflags []
     let include_paths = foldr (\ x xs -> "-I" : x : xs) []
                          (cmdline_include_paths ++ pkg_include_dirs)
 
-    verb <- getVerbFlag
+    let verb = getVerbFlag dflags
 
     cc_opts <- if not include_cc_opts 
                  then return []
-                 else do optc <- getOpts opt_c
-                         (md_c_flags, _) <- machdepCCOpts
+                 else do let optc = getOpts dflags opt_c
+                         (md_c_flags, _) <- machdepCCOpts dflags
                          return (optc ++ md_c_flags)
 
-    let cpp_prog args | raw       = SysTools.runCpp args
-                     | otherwise = SysTools.runCc (SysTools.Option "-E" : args)
+    let cpp_prog args | raw       = SysTools.runCpp dflags args
+                     | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
 
     let target_defs = 
          [ "-D" ++ cTARGETOS   ++ "_TARGET_OS=1",
index f92f295..23c7cbb 100644 (file)
@@ -11,13 +11,9 @@ module DriverState where
 #include "../includes/ghcconfig.h"
 #include "HsVersions.h"
 
-import ParsePkgConf    ( loadPackageConfig )
-import SysTools                ( getTopDir )
-import Packages
 import CmdLineOpts
 import DriverPhases
 import DriverUtil
-import UniqFM          ( eltsUFM )
 import Util
 import Config
 import Panic
@@ -200,8 +196,7 @@ buildStgToDo = do
 
 split_marker = ':'   -- not configurable (ToDo)
 
-v_Import_paths, v_Include_paths, v_Library_paths :: IORef [String]
-GLOBAL_VAR(v_Import_paths,  ["."], [String])
+v_Include_paths, v_Library_paths :: IORef [String]
 GLOBAL_VAR(v_Include_paths, [], [String])
 GLOBAL_VAR(v_Library_paths, [],         [String])
 
@@ -280,189 +275,6 @@ addToDirList ref path
     splitUp xs = return (split split_marker xs)
 #endif
 
--- ----------------------------------------------------------------------------
--- Loading the package config file
-
-readPackageConf :: String -> IO ()
-readPackageConf conf_file = do
-  proto_pkg_configs <- loadPackageConfig conf_file
-  top_dir          <- getTopDir
-  let pkg_configs = mungePackagePaths top_dir proto_pkg_configs
-  extendPackageConfigMap pkg_configs
-
-mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
--- Replace the string "$libdir" at the beginning of a path
--- with the current libdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where 
-  munge_pkg p = p{ importDirs  = munge_paths (importDirs p),
-                  includeDirs = munge_paths (includeDirs p),
-                  libraryDirs = munge_paths (libraryDirs p),
-                  frameworkDirs = munge_paths (frameworkDirs p) }
-
-  munge_paths = map munge_path
-
-  munge_path p 
-         | Just p' <- maybePrefixMatch "$libdir" p = top_dir ++ p'
-         | otherwise                               = p
-
-
--- -----------------------------------------------------------------------------
--- The list of packages requested on the command line
-
--- The package list reflects what packages were given as command-line options,
--- plus their dependent packages.  It is maintained in dependency order;
--- earlier packages may depend on later ones, but not vice versa
-GLOBAL_VAR(v_ExplicitPackages, initPackageList, [PackageName])
-
-initPackageList = [basePackage, rtsPackage]
-       -- basePackage is part of this list entirely because of 
-       -- wired-in names in GHCi.  See the notes on wired-in names in
-       -- Linker.linkExpr.  By putting the base backage in initPackageList
-       -- we make sure that it'll always by linked.
-
-
--- add a package requested from the command-line
-addPackage :: String -> IO ()
-addPackage package = do
-  pkg_details <- getPackageConfigMap
-  ps  <- readIORef v_ExplicitPackages
-  ps' <- add_package pkg_details ps (mkPackageName package)
-               -- Throws an exception if it fails
-  writeIORef v_ExplicitPackages ps'
-
--- internal helper
-add_package :: PackageConfigMap -> [PackageName]
-           -> PackageName -> IO [PackageName]
-add_package pkg_details ps p   
-  | p `elem` ps        -- Check if we've already added this package
-  = return ps
-  | Just details <- lookupPkg pkg_details p
-  -- Add the package's dependents also
-  = do ps' <- foldM (add_package pkg_details) ps (packageDependents details)
-       return (p : ps')
-  | otherwise
-  = throwDyn (CmdLineError ("unknown package name: " ++ packageNameString p))
-
-
--- -----------------------------------------------------------------------------
--- Extracting information from the packages in scope
-
--- Many of these functions take a list of packages: in those cases,
--- the list is expected to contain the "dependent packages",
--- i.e. those packages that were found to be depended on by the
--- current module/program.  These can be auto or non-auto packages, it
--- doesn't really matter.  The list is always combined with the list
--- of explicit (command-line) packages to determine which packages to
--- use.
-
-getPackageImportPath :: IO [String]
-getPackageImportPath = do
-  ps <- getExplicitAndAutoPackageConfigs
-                 -- import dirs are always derived from the 'auto' 
-                 -- packages as well as the explicit ones
-  return (nub (filter notNull (concatMap importDirs ps)))
-
-getPackageIncludePath :: [PackageName] -> IO [String]
-getPackageIncludePath pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap includeDirs ps)))
-
-       -- includes are in reverse dependency order (i.e. rts first)
-getPackageCIncludes :: [PackageConfig] -> IO [String]
-getPackageCIncludes pkg_configs = do
-  return (reverse (nub (filter notNull (concatMap includes pkg_configs))))
-
-getPackageLibraryPath :: [PackageName] -> IO [String]
-getPackageLibraryPath pkgs = do 
-  ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap libraryDirs ps)))
-
-getPackageLinkOpts :: [PackageName] -> IO [String]
-getPackageLinkOpts pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  tag <- readIORef v_Build_tag
-  rts_tag <- readIORef v_RTS_Build_tag
-  static <- readIORef v_Static
-  let 
-       imp        = if static then "" else "_imp"
-       libs p     = map addSuffix (hACK (hsLibraries p)) ++ extraLibraries p
-       imp_libs p = map (++imp) (libs p)
-       all_opts p = map ("-l" ++) (imp_libs p) ++ extraLdOpts p
-
-       suffix     = if null tag then "" else  '_':tag
-       rts_suffix = if null rts_tag then "" else  '_':rts_tag
-
-        addSuffix rts@"HSrts"    = rts       ++ rts_suffix
-        addSuffix other_lib      = other_lib ++ suffix
-
-  return (concat (map all_opts ps))
-  where
-
-     -- This is a totally horrible (temporary) hack, for Win32.  Problem is
-     -- that package.conf for Win32 says that the main prelude lib is 
-     -- split into HSbase1, HSbase2 and HSbase3, which is needed due to a bug
-     -- in the GNU linker (PEi386 backend). However, we still only
-     -- have HSbase.a for static linking, not HSbase{1,2,3}.a
-     -- getPackageLibraries is called to find the .a's to add to the static
-     -- link line.  On Win32, this hACK detects HSbase{1,2,3} and 
-     -- replaces them with HSbase, so static linking still works.
-     -- Libraries needed for dynamic (GHCi) linking are discovered via
-     -- different route (in InteractiveUI.linkPackage).
-     -- See driver/PackageSrc.hs for the HSbase1/HSbase2 split definition.
-     -- THIS IS A STRICTLY TEMPORARY HACK (famous last words ...)
-     -- JRS 04 Sept 01: Same appalling hack for HSwin32[1,2]
-     -- KAA 29 Mar  02: Same appalling hack for HSobjectio[1,2,3,4]
-     hACK libs
-#      if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
-       = libs
-#      else
-       = if   "HSbase1" `elem` libs && "HSbase2" `elem` libs && "HSbase3" `elem` libs
-         then "HSbase" : filter (not.(isPrefixOf "HSbase")) libs
-         else
-         if   "HSwin321" `elem` libs && "HSwin322" `elem` libs
-         then "HSwin32" : filter (not.(isPrefixOf "HSwin32")) libs
-         else 
-         if   "HSobjectio1" `elem` libs && "HSobjectio2" `elem` libs && "HSobjectio3" `elem` libs && "HSobjectio4" `elem` libs
-        then "HSobjectio" : filter (not.(isPrefixOf "HSobjectio")) libs
-         else 
-         libs
-#      endif
-
-getPackageExtraCcOpts :: [PackageName] -> IO [String]
-getPackageExtraCcOpts pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  return (concatMap extraCcOpts ps)
-
-#ifdef darwin_TARGET_OS
-getPackageFrameworkPath  :: [PackageName] -> IO [String]
-getPackageFrameworkPath pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap frameworkDirs ps)))
-
-getPackageFrameworks  :: [PackageName] -> IO [String]
-getPackageFrameworks pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  return (concatMap extraFrameworks ps)
-#endif
-
--- -----------------------------------------------------------------------------
--- Package Utils
-
-getExplicitPackagesAnd :: [PackageName] -> IO [PackageConfig]
-getExplicitPackagesAnd pkg_names = do
-  pkg_map <- getPackageConfigMap
-  expl <- readIORef v_ExplicitPackages
-  all_pkgs <- foldM (add_package pkg_map) expl pkg_names
-  getPackageDetails all_pkgs
-
--- return all packages, including both the auto packages and the explicit ones
-getExplicitAndAutoPackageConfigs :: IO [PackageConfig]
-getExplicitAndAutoPackageConfigs = do
-  pkg_map <- getPackageConfigMap
-  let auto_packages = [ packageConfigName p | p <- eltsUFM pkg_map, exposed p ]
-  getExplicitPackagesAnd auto_packages
-
 -----------------------------------------------------------------------------
 -- Ways
 
index 24936ec..c255408 100644 (file)
@@ -6,15 +6,10 @@
 \begin{code}
 module Finder (
     flushFinderCache,  -- :: IO ()
-
-    findModule,                -- :: ModuleName 
-                       --   -> IO (Either [FilePath] (Module, ModLocation))
-
-    findPackageModule,  -- :: ModuleName
-                       --   -> IO (Either [FilePath] (Module, ModLocation))
-
+    FindResult(..),
+    findModule,                -- :: ModuleName -> Bool -> IO FindResult
+    findPackageModule,  -- :: ModuleName -> Bool -> IO FindResult
     mkHomeModLocation, -- :: ModuleName -> FilePath -> IO ModLocation
-
     findLinkable,      -- :: ModuleName -> ModLocation -> IO (Maybe Linkable)
 
     hiBootExt,         -- :: String
@@ -26,53 +21,56 @@ module Finder (
 
 import Module
 import UniqFM          ( filterUFM )
-import HscTypes                ( Linkable(..), Unlinked(..) )
+import HscTypes                ( Linkable(..), Unlinked(..), IfacePackage(..) )
+import Packages
 import DriverState
 import DriverUtil
 import FastString
 import Config
 import Util
+import CmdLineOpts     ( DynFlags(..) )
 
 import DATA_IOREF      ( IORef, writeIORef, readIORef )
 
-import List
-import Directory
-import IO
-import Monad
+import Data.List
+import System.Directory
+import System.IO
+import Control.Monad
+import Data.Maybe      ( isNothing )
 
 -- -----------------------------------------------------------------------------
 -- The Finder
 
--- The Finder provides a thin filesystem abstraction to the rest of the
--- compiler.  For a given module, it knows (a) whether the module lives
--- in the home package or in another package, so it can make a Module
--- from a ModuleName, and (b) where the source, interface, and object
--- files for a module live.
+-- The Finder provides a thin filesystem abstraction to the rest of
+-- the compiler.  For a given module, it can tell you where the
+-- source, interface, and object files for that module live.
 -- 
--- It does *not* know which particular package a module lives in, because
--- that information is only contained in the interface file.
+-- It does *not* know which particular package a module lives in.  Use
+-- Packages.moduleToPackageConfig for that.
 
 -- -----------------------------------------------------------------------------
 -- The finder's cache
 
-GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv (Module,ModLocation))
+GLOBAL_VAR(finder_cache, emptyModuleEnv, ModuleEnv FinderCacheEntry)
+
+type FinderCacheEntry = (ModLocation,Maybe (PackageConfig,Bool))
 
 -- remove all the home modules from the cache; package modules are
 -- assumed to not move around during a session.
 flushFinderCache :: IO ()
 flushFinderCache = do
   fm <- readIORef finder_cache
-  writeIORef finder_cache (filterUFM (not . isHomeModule . fst) fm)
+  writeIORef finder_cache (filterUFM (\(loc,m) -> isNothing m) fm)
 
-addToFinderCache :: ModuleName -> (Module,ModLocation) -> IO ()
-addToFinderCache mod_name stuff = do
+addToFinderCache :: Module -> FinderCacheEntry -> IO ()
+addToFinderCache mod_name entry = do
   fm <- readIORef finder_cache
-  writeIORef finder_cache (extendModuleEnvByName fm mod_name stuff)
+  writeIORef finder_cache (extendModuleEnv fm mod_name entry)
 
-lookupFinderCache :: ModuleName -> IO (Maybe (Module,ModLocation))
+lookupFinderCache :: Module -> IO (Maybe FinderCacheEntry)
 lookupFinderCache mod_name = do
   fm <- readIORef finder_cache
-  return $! lookupModuleEnvByName fm mod_name
+  return $! lookupModuleEnv fm mod_name
 
 -- -----------------------------------------------------------------------------
 -- Locating modules
@@ -87,52 +85,81 @@ lookupFinderCache mod_name = do
 -- The ModLocation contains the names of all the files associated with
 -- that module: its source file, .hi file, object file, etc.
 
--- Returns: 
---     Right (Module, ModLocation)   if the module was found
---     Left [FilePath]               if the module was not found, and here
---                                     is a list of all the places we looked
-findModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
-findModule name = do
-  r <- lookupFinderCache name
-  case r of
-   Just result -> return (Right result)
-   Nothing -> do  
-       j <- maybeHomeModule name
-       case j of
-        Right home_module -> return (Right home_module)
-        Left home_files   -> do
-           r <- findPackageMod name
+data FindResult
+  = Found ModLocation IfacePackage
+       -- the module was found
+  | PackageHidden PackageId
+       -- for an explicit source import: the package containing the module is
+       -- not exposed.
+  | ModuleHidden  PackageId
+       -- for an explicit source import: the package containing the module is
+       -- exposed, but the module itself is hidden.
+  | NotFound [FilePath]
+       -- the module was not found, the specified places were searched.
+
+findModule :: DynFlags -> Module -> Bool -> IO FindResult
+findModule = cached findModule'
+  
+findModule' :: DynFlags -> Module -> Bool -> IO FindResult
+findModule' dflags name explicit = do
+   j <- maybeHomeModule dflags name
+   case j of
+       NotFound home_files -> do
+           r <- findPackageModule' dflags name explicit
            case r of
-               Right pkg_module -> return (Right pkg_module)
-               Left pkg_files   -> return (Left (home_files ++ pkg_files))
-
-findPackageModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
-findPackageModule name = do
-  r <- lookupFinderCache name
-  case r of
-   Just result -> return (Right result)
-   Nothing     -> findPackageMod name
+               NotFound pkg_files 
+                       -> return (NotFound (home_files ++ pkg_files))
+               other_result
+                       -> return other_result
+       other_result -> return other_result
+
+cached fn dflags name explicit = do
+  m <- lookupFinderCache name
+  case m of
+    Nothing -> fn dflags name explicit
+    Just (loc,maybe_pkg)
+       | Just err <- visible explicit maybe_pkg  ->  return err
+       | otherwise -> return (Found loc (pkgInfoToId maybe_pkg))
+  
+pkgInfoToId :: Maybe (PackageConfig,Bool) -> IfacePackage
+pkgInfoToId (Just (pkg,_)) = ExternalPackage (mkPackageId (package pkg))
+pkgInfoToId Nothing = ThisPackage
+
+-- Is a module visible or not?  Returns Nothing if the import is ok,
+-- or Just err if there's a visibility error.
+visible :: Bool -> Maybe (PackageConfig,Bool) -> Maybe FindResult
+visible explicit maybe_pkg
+   | Nothing <- maybe_pkg  =  Nothing  -- home module ==> YES
+   | not explicit          =  Nothing  -- implicit import ==> YES
+   | Just (pkg, exposed_module) <- maybe_pkg 
+    = case () of
+       _ | not exposed_module -> Just (ModuleHidden pkgname)
+         | not (exposed pkg)  -> Just (PackageHidden pkgname)
+         | otherwise          -> Nothing
+         where 
+               pkgname = packageConfigId pkg
+     
 
 hiBootExt = "hi-boot"
 hiBootVerExt = "hi-boot-" ++ cHscIfaceFileVersion
 
-maybeHomeModule :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
-maybeHomeModule mod_name = do
-   home_path <- readIORef v_Import_paths
+maybeHomeModule :: DynFlags -> Module -> IO FindResult
+maybeHomeModule dflags mod = do
+   let home_path = importPaths dflags
    hisuf     <- readIORef v_Hi_suf
    mode      <- readIORef v_GhcMode
 
    let
      source_exts = 
-      [ ("hs",   mkHomeModLocationSearched mod_name)
-      , ("lhs",  mkHomeModLocationSearched mod_name)
+      [ ("hs",   mkHomeModLocationSearched mod)
+      , ("lhs",  mkHomeModLocationSearched mod)
       ]
      
-     hi_exts = [ (hisuf,  mkHiOnlyModLocation hisuf mod_name) ]
+     hi_exts = [ (hisuf,  mkHiOnlyModLocation hisuf mod) ]
      
      boot_exts =
-       [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod_name)
-       , (hiBootExt,    mkHiOnlyModLocation hisuf mod_name)
+       [ (hiBootVerExt, mkHiOnlyModLocation hisuf mod)
+       , (hiBootExt,    mkHiOnlyModLocation hisuf mod)
        ]
 
        -- In compilation manager modes, we look for source files in the home
@@ -146,16 +173,33 @@ maybeHomeModule mod_name = do
          | isCompManagerMode mode = source_exts
         | otherwise {-one-shot-} = hi_exts ++ boot_exts
 
-   searchPathExts home_path mod_name exts
+   searchPathExts home_path mod exts
        
 -- -----------------------------------------------------------------------------
 -- Looking for a package module
 
-findPackageMod :: ModuleName -> IO (Either [FilePath] (Module, ModLocation))
-findPackageMod mod_name = do
+findPackageModule :: DynFlags -> Module -> Bool -> IO FindResult
+findPackageModule = cached findPackageModule'
+
+findPackageModule' :: DynFlags -> Module -> Bool -> IO FindResult
+findPackageModule' dflags mod explicit = do
   mode     <- readIORef v_GhcMode
-  imp_dirs <- getPackageImportPath -- including the 'auto' ones
 
+  case moduleToPackageConfig dflags mod of
+    Nothing -> return (NotFound [])
+    pkg_info@(Just (pkg_conf, module_exposed))
+       | Just err <- visible explicit pkg_info  ->  return err
+       | otherwise  ->  findPackageIface mode mod paths pkg_info
+      where 
+           paths   = importDirs pkg_conf
+
+findPackageIface
+       :: GhcMode
+       -> Module
+       -> [FilePath]
+       -> Maybe (PackageConfig,Bool)
+       -> IO FindResult
+findPackageIface mode mod imp_dirs pkg_info = do
    -- hi-suffix for packages depends on the build tag.
   package_hisuf <-
        do tag <- readIORef v_Build_tag
@@ -165,13 +209,14 @@ findPackageMod mod_name = do
 
   let
      hi_exts =
-        [ (package_hisuf, mkPackageModLocation package_hisuf mod_name) ]
+        [ (package_hisuf, 
+           mkPackageModLocation pkg_info package_hisuf mod) ]
 
      source_exts = 
-       [ ("hs",   mkPackageModLocation package_hisuf mod_name)
-       , ("lhs",  mkPackageModLocation package_hisuf mod_name)
+       [ ("hs",   mkPackageModLocation pkg_info package_hisuf mod)
+       , ("lhs",  mkPackageModLocation pkg_info package_hisuf mod)
        ]
-     
+
      -- mkdependHS needs to look for source files in packages too, so
      -- that we can make dependencies between package before they have
      -- been built.
@@ -181,26 +226,26 @@ findPackageMod mod_name = do
 
       -- we never look for a .hi-boot file in an external package;
       -- .hi-boot files only make sense for the home package.
-  searchPathExts imp_dirs mod_name exts
+  searchPathExts imp_dirs mod exts
 
 -- -----------------------------------------------------------------------------
 -- General path searching
 
 searchPathExts
   :: [FilePath]                -- paths to search
-  -> ModuleName                -- module name
+  -> Module            -- module name
   -> [ (
-       String,                                         -- suffix
-       String -> String -> String -> IO (Module, ModLocation)  -- action
+       String,                                      -- suffix
+       String -> String -> String -> IO FindResult  -- action
        )
      ] 
-  -> IO (Either [FilePath] (Module, ModLocation))
+  -> IO FindResult
 
-searchPathExts path mod_name exts = search to_search
+searchPathExts path mod exts = search to_search
   where
-    basename = dots_to_slashes (moduleNameUserString mod_name)
+    basename = dots_to_slashes (moduleUserString mod)
 
-    to_search :: [(FilePath, IO (Module,ModLocation))]
+    to_search :: [(FilePath, IO FindResult)]
     to_search = [ (file, fn p basename ext)
                | p <- path, 
                  (ext,fn) <- exts,
@@ -209,29 +254,27 @@ searchPathExts path mod_name exts = search to_search
                      file = base ++ '.':ext
                ]
 
-    search [] = return (Left (map fst to_search))
+    search [] = return (NotFound (map fst to_search))
     search ((file, result) : rest) = do
       b <- doesFileExist file
       if b 
-       then Right `liftM` result
+       then result
        else search rest
 
 -- -----------------------------------------------------------------------------
 -- Building ModLocations
 
-mkHiOnlyModLocation hisuf mod_name path basename _ext = do
-  -- basename == dots_to_slashes (moduleNameUserString mod_name)
+mkHiOnlyModLocation hisuf mod path basename _ext = do
+  -- basename == dots_to_slashes (moduleNameUserString mod)
   loc <- hiOnlyModLocation path basename hisuf
-  let result = (mkHomeModule mod_name, loc)
-  addToFinderCache mod_name result
-  return result
+  addToFinderCache mod (loc, Nothing)
+  return (Found loc ThisPackage)
 
-mkPackageModLocation hisuf mod_name path basename _ext = do
-  -- basename == dots_to_slashes (moduleNameUserString mod_name)
+mkPackageModLocation pkg_info hisuf mod path basename _ext = do
+  -- basename == dots_to_slashes (moduleNameUserString mod)
   loc <- hiOnlyModLocation path basename hisuf
-  let result = (mkPackageModule mod_name, loc)
-  addToFinderCache mod_name result
-  return result
+  addToFinderCache mod (loc, pkg_info)
+  return (Found loc (pkgInfoToId pkg_info))
 
 hiOnlyModLocation path basename hisuf 
  = do let full_basename = path++'/':basename
@@ -265,7 +308,7 @@ hiOnlyModLocation path basename hisuf
 --
 -- Parameters are:
 --
--- mod_name
+-- mod
 --      The name of the module
 --
 -- path
@@ -273,34 +316,33 @@ hiOnlyModLocation path basename hisuf
 --      (b) and (c): "."
 --
 -- src_basename
---      (a): dots_to_slashes (moduleNameUserString mod_name)
+--      (a): dots_to_slashes (moduleNameUserString mod)
 --      (b) and (c): The filename of the source file, minus its extension
 --
 -- ext
 --     The filename extension of the source file (usually "hs" or "lhs").
 
-mkHomeModLocation mod_name src_filename = do
+mkHomeModLocation mod src_filename = do
    let (basename,extension) = splitFilename src_filename
-   mkHomeModLocation' mod_name basename extension
+   mkHomeModLocation' mod basename extension
 
-mkHomeModLocationSearched mod_name path basename ext =
-   mkHomeModLocation' mod_name (path ++ '/':basename) ext
+mkHomeModLocationSearched mod path basename ext = do
+   loc <- mkHomeModLocation' mod (path ++ '/':basename) ext
+   return (Found loc ThisPackage)
 
-mkHomeModLocation' mod_name src_basename ext = do
-   let mod_basename = dots_to_slashes (moduleNameUserString mod_name)
+mkHomeModLocation' mod src_basename ext = do
+   let mod_basename = dots_to_slashes (moduleUserString mod)
 
    obj_fn <- mkObjPath src_basename mod_basename
    hi_fn  <- mkHiPath  src_basename mod_basename
 
-   let result = ( mkHomeModule mod_name,
-                  ModLocation{ ml_hspp_file = Nothing,
-                               ml_hs_file   = Just (src_basename ++ '.':ext),
-                               ml_hi_file   = hi_fn,
-                               ml_obj_file  = obj_fn
-                      })
+   let loc = ModLocation{ ml_hspp_file = Nothing,
+                         ml_hs_file   = Just (src_basename ++ '.':ext),
+                         ml_hi_file   = hi_fn,
+                         ml_obj_file  = obj_fn }
 
-   addToFinderCache mod_name result
-   return result
+   addToFinderCache mod (loc, Nothing)
+   return loc
 
 -- | Constructs the filename of a .o file for a given source file.
 -- Does /not/ check whether the .o file exists
@@ -336,7 +378,7 @@ mkHiPath basename mod_basename
 -- findLinkable isn't related to the other stuff in here, 
 -- but there's no other obvious place for it
 
-findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable)
+findLinkable :: Module -> ModLocation -> IO (Maybe Linkable)
 findLinkable mod locn
    = do let obj_fn = ml_obj_file locn
        obj_exist <- doesFileExist obj_fn
index 57ded51..249e1e1 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: GetImports.hs,v 1.10 2002/09/13 15:02:34 simonpj Exp $
+-- $Id: GetImports.hs,v 1.11 2004/11/26 16:20:57 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -18,7 +18,7 @@ import Char
 -- getImportsFromFile is careful to close the file afterwards, otherwise
 -- we can end up with a large number of open handles before the garbage
 -- collector gets around to closing them.
-getImportsFromFile :: String -> IO ([ModuleName], [ModuleName], ModuleName)
+getImportsFromFile :: String -> IO ([Module], [Module], Module)
 getImportsFromFile filename
   = do  hdl <- openFile filename ReadMode
         modsrc <- hGetContents hdl
@@ -27,11 +27,11 @@ getImportsFromFile filename
        hClose hdl
        return (srcimps,imps,mod_name)
 
-getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
+getImports :: String -> ([Module], [Module], Module)
 getImports s
    = case f [{-accum source imports-}] [{-accum normal imports-}] 
           Nothing (clean s) of
-        (si, ni, Nothing) -> (si, ni, mkModuleName "Main")
+        (si, ni, Nothing) -> (si, ni, mkModule "Main")
         (si, ni, Just me) -> (si, ni, me)
      where
         -- Only pick up the name following 'module' the first time.
@@ -59,7 +59,7 @@ getImports s
         f si ni me (w:ws) = f si ni me ws
         f si ni me [] = (nub si, nub ni, me)
 
-        mkMN str = mkModuleName (takeWhile isModId (reverse str))
+        mkMN str = mkModule (takeWhile isModId (reverse str))
         isModId c = isAlphaNum c || c `elem` "'._"
 
 
index bcb967f..3ce9eb9 100644 (file)
@@ -15,14 +15,13 @@ module HscTypes (
 
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
-       lookupIface, lookupIfaceByModName, moduleNameToModule,
-       emptyModIface,
+       lookupIface, lookupIfaceByModule, emptyModIface,
 
        InteractiveContext(..), emptyInteractiveContext, 
        icPrintUnqual, unQualInScope,
 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
-                     emptyIfaceDepCache, 
+       IfacePackage(..), emptyIfaceDepCache, 
 
        Deprecs(..), IfaceDeprecs,
 
@@ -64,7 +63,7 @@ import ByteCodeAsm    ( CompiledByteCode )
 import RdrName         ( GlobalRdrEnv, emptyGlobalRdrEnv,
                          LocalRdrEnv, emptyLocalRdrEnv,
                          GlobalRdrElt(..), mkRdrUnqual, lookupGRE_RdrName )
-import Name            ( Name, NamedThing, getName, nameOccName, nameModule, nameModuleName )
+import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
 import NameEnv
 import NameSet 
 import OccName         ( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, 
@@ -79,7 +78,7 @@ import Type           ( TyThing(..) )
 import Class           ( Class, classSelIds, classTyCon )
 import TyCon           ( TyCon, tyConSelIds, tyConDataCons )
 import DataCon         ( dataConImplicitIds )
-import Packages                ( PackageName )
+import Packages                ( PackageId )
 import CmdLineOpts     ( DynFlags )
 
 import BasicTypes      ( Version, initialVersion, IPName, 
@@ -176,24 +175,14 @@ lookupIface hpt pit mod
        Just mod_info -> Just (hm_iface mod_info)
        Nothing       -> lookupModuleEnv pit mod
 
-lookupIfaceByModName :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Maybe ModIface
+lookupIfaceByModule :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
 -- We often have two IfaceTables, and want to do a lookup
-lookupIfaceByModName hpt pit mod
-  = case lookupModuleEnvByName hpt mod of
+lookupIfaceByModule hpt pit mod
+  = case lookupModuleEnv hpt mod of
        Just mod_info -> Just (hm_iface mod_info)
-       Nothing       -> lookupModuleEnvByName pit mod
-\end{code}
-
-\begin{code}
--- Use instead of Finder.findModule if possible: this way doesn't
--- require filesystem operations, and it is guaranteed not to fail
--- when the IfaceTables are properly populated (i.e. after the renamer).
-moduleNameToModule :: HomePackageTable -> PackageIfaceTable -> ModuleName -> Module
-moduleNameToModule hpt pit mod 
-   = mi_module (fromJust (lookupIfaceByModName hpt pit mod))
+       Nothing       -> lookupModuleEnv pit mod
 \end{code}
 
-
 %************************************************************************
 %*                                                                     *
 \subsection{Symbol tables and Module details}
@@ -212,7 +201,7 @@ the declarations into a single indexed map in the @PersistentRenamerState@.
 \begin{code}
 data ModIface 
    = ModIface {
-       mi_package  :: !PackageName,        -- Which package the module comes from
+       mi_package  :: !IfacePackage,       -- Which package the module comes from
         mi_module   :: !Module,
         mi_mod_vers :: !Version,           -- Module version: changes when anything changes
 
@@ -266,6 +255,8 @@ data ModIface
                        -- seeing if we are up to date wrt the old interface
      }
 
+data IfacePackage = ThisPackage | ExternalPackage PackageId
+
 -- Should be able to construct ModDetails from mi_decls in ModIface
 data ModDetails
    = ModDetails {
@@ -348,10 +339,10 @@ data ForeignStubs = NoStubs
 \end{code}
 
 \begin{code}
-emptyModIface :: PackageName -> ModuleName -> ModIface
+emptyModIface :: IfacePackage -> Module -> ModIface
 emptyModIface pkg mod
   = ModIface { mi_package  = pkg,
-              mi_module   = mkModule pkg mod,
+              mi_module   = mod,
               mi_mod_vers = initialVersion,
               mi_orphan   = False,
               mi_boot     = False,
@@ -421,7 +412,7 @@ unQualInScope :: GlobalRdrEnv -> PrintUnqualified
 -- [Out of date] Also checks for built-in syntax, which is always 'in scope'
 unQualInScope env mod occ
   = case lookupGRE_RdrName (mkRdrUnqual occ) env of
-       [gre] -> nameModuleName (gre_name gre) == mod
+       [gre] -> nameModule (gre_name gre) == mod
        other -> False
 \end{code}
 
@@ -585,7 +576,7 @@ data GenAvailInfo name      = Avail name     -- An ordinary identifier
                        deriving( Eq )
                        -- Equality used when deciding if the interface has changed
 
-type IfaceExport = (ModuleName, [GenAvailInfo OccName])
+type IfaceExport = (Module, [GenAvailInfo OccName])
 
 availsToNameSet :: [AvailInfo] -> NameSet
 availsToNameSet avails = foldl add emptyNameSet avails
@@ -662,9 +653,9 @@ type IsBootInterface = Bool
 -- Invariant: the dependencies of a module M never includes M
 -- Invariant: the lists are unordered, with no duplicates
 data Dependencies
-  = Deps { dep_mods  :: [(ModuleName,IsBootInterface)],        -- Home-package module dependencies
-          dep_pkgs  :: [PackageName],                  -- External package dependencies
-          dep_orphs :: [ModuleName] }                  -- Orphan modules (whether home or external pkg)
+  = Deps { dep_mods  :: [(Module,IsBootInterface)],    -- Home-package module dependencies
+          dep_pkgs  :: [PackageId],                    -- External package dependencies
+          dep_orphs :: [Module] }                      -- Orphan modules (whether home or external pkg)
   deriving( Eq )
        -- Equality used only for old/new comparison in MkIface.addVersionInfo
 
@@ -672,7 +663,7 @@ noDependencies :: Dependencies
 noDependencies = Deps [] [] []
          
 data Usage
-  = Usage { usg_name     :: ModuleName,                        -- Name of the module
+  = Usage { usg_name     :: Module,                    -- Name of the module
            usg_mod      :: Version,                    -- Module version
&nb