Distinguish between UnitId and InstalledUnitId.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 6 Oct 2016 07:17:15 +0000 (00:17 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Sat, 8 Oct 2016 08:37:33 +0000 (01:37 -0700)
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
42 files changed:
compiler/backpack/DriverBkp.hs
compiler/basicTypes/Module.hs
compiler/deSugar/Desugar.hs
compiler/ghci/Linker.hs
compiler/iface/LoadIface.hs
compiler/iface/MkIface.hs
compiler/iface/TcIface.hs
compiler/main/CodeOutput.hs
compiler/main/DriverPipeline.hs
compiler/main/Finder.hs
compiler/main/GHC.hs
compiler/main/GhcMake.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.hs
compiler/main/PackageConfig.hs
compiler/main/Packages.hs
compiler/main/SysTools.hs
compiler/rename/RnNames.hs
compiler/typecheck/TcBackpack.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnTypes.hs
ghc/GHCi/UI.hs
ghc/Main.hs
libraries/ghc-boot/GHC/PackageDb.hs
testsuite/tests/backpack/cabal/bkpcabal01/.gitignore [new file with mode: 0644]
testsuite/tests/cabal/cabal05/cabal05.stderr
testsuite/tests/cabal/ghcpkg01.stdout
testsuite/tests/cabal/ghcpkg04.stderr
testsuite/tests/driver/driver063.stderr
testsuite/tests/ghc-e/should_run/T2636.stderr
testsuite/tests/module/mod1.stderr
testsuite/tests/module/mod2.stderr
testsuite/tests/package/package01e.stderr
testsuite/tests/package/package06e.stderr
testsuite/tests/package/package07e.stderr
testsuite/tests/package/package08e.stderr
testsuite/tests/package/package09e.stderr
testsuite/tests/perf/compiler/parsing001.stderr
testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr
testsuite/tests/th/T10279.stderr
testsuite/tests/typecheck/should_fail/tcfail082.stderr
utils/ghc-pkg/Main.hs

index 25d2d92..53a7e85 100644 (file)
@@ -161,7 +161,7 @@ withBkpSession cid insts deps session_type do_this = do
                 TcSession -> newUnitId cid insts
                 -- No hash passed if no instances
                 _ | null insts -> newSimpleUnitId cid
-                  | otherwise  -> newHashedUnitId cid (Just (hashUnitId cid insts)),
+                  | otherwise  -> newDefiniteUnitId cid (Just (hashUnitId cid insts)),
         -- Setup all of the output directories according to our hierarchy
         objectDir   = Just (outdir objectDir),
         hiDir       = Just (outdir hiDir),
@@ -207,7 +207,7 @@ compileUnit cid insts = do
     lunit <- getSource cid
     buildUnit CompSession cid insts lunit
 
--- Invariant: this NEVER returns HashedUnitId
+-- Invariant: this NEVER returns InstalledUnitId
 hsunitDeps :: HsUnit HsComponentId -> [(UnitId, ModRenaming)]
 hsunitDeps unit = concatMap get_dep (hsunitBody unit)
   where
@@ -281,7 +281,7 @@ buildUnit session cid insts lunit = do
             sourcePackageId = SourcePackageId compat_fs,
             packageName = compat_pn,
             packageVersion = makeVersion [0],
-            unitId = thisPackage dflags,
+            unitId = toInstalledUnitId (thisPackage dflags),
             instantiatedWith = insts,
             -- Slight inefficiency here haha
             exposedModules = map (\(m,n) -> (m,Just n)) mods,
@@ -293,7 +293,7 @@ buildUnit session cid insts lunit = do
                         -- really used for anything, so we leave it
                         -- blank for now.
                         TcSession -> []
-                        _ -> map (unwireUnitId dflags)
+                        _ -> map (toInstalledUnitId . unwireUnitId dflags)
                                 $ deps ++ [ moduleUnitId mod
                                           | (_, mod) <- insts
                                           , not (isHoleModule mod) ],
@@ -302,6 +302,9 @@ buildUnit session cid insts lunit = do
                             _ -> obj_files,
             importDirs = [ hi_dir ],
             exposed = False,
+            indefinite = case session of
+                            TcSession -> True
+                            _ -> False,
             -- nope
             hsLibraries = [],
             extraLibraries = [],
@@ -353,7 +356,7 @@ addPackage pkg = do
                         -- liftIO $ setUnsafeGlobalDynFlags dflags
                         return ()
 
--- Precondition: UnitId is NOT HashedUnitId
+-- Precondition: UnitId is NOT InstalledUnitId
 compileInclude :: Int -> (Int, UnitId) -> BkpM ()
 compileInclude n (i, uid) = do
     hsc_env <- getSession
index 7057db0..fd12c2b 100644 (file)
@@ -11,6 +11,7 @@ the keys.
 
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Module
     (
@@ -34,7 +35,8 @@ module Module
         unitIdKey,
         unitIdComponentId,
         IndefUnitId(..),
-        HashedUnitId(..),
+        InstalledUnitId(..),
+        toInstalledUnitId,
         ShHoleSubst,
 
         unitIdIsDefinite,
@@ -44,7 +46,7 @@ module Module
         newUnitId,
         newIndefUnitId,
         newSimpleUnitId,
-        newHashedUnitId,
+        newDefiniteUnitId,
         hashUnitId,
         fsToUnitId,
         stringToUnitId,
@@ -93,10 +95,21 @@ module Module
         HasModule(..),
         ContainsModule(..),
 
-        -- * Virgin modules
-        VirginModule,
-        VirginUnitId,
-        VirginModuleEnv,
+        -- * Installed unit ids and modules
+        InstalledModule(..),
+        InstalledModuleEnv,
+        installedModuleEq,
+        installedUnitIdEq,
+        installedUnitIdString,
+        newInstalledUnitId,
+        fsToInstalledUnitId,
+        stringToInstalledUnitId,
+        emptyInstalledModuleEnv,
+        lookupInstalledModuleEnv,
+        extendInstalledModuleEnv,
+        filterInstalledModuleEnv,
+        delInstalledModuleEnv,
+        DefUnitId(..),
 
         -- * Hole module
         HoleModule,
@@ -180,10 +193,9 @@ import {-# SOURCE #-} Packages (componentIdString, improveUnitId, PackageConfigM
 -- 'ComponentId's.
 --      - Same as Distribution.Package.ComponentId
 --
--- UnitId: A ComponentId + a mapping from hole names (ModuleName) to
--- Modules.  This is how the compiler identifies instantatiated
--- components, and also is the main identifier by which GHC identifies
--- things.
+-- UnitId/InstalledUnitId: A ComponentId + a mapping from hole names
+-- (ModuleName) to Modules.  This is how the compiler identifies instantatiated
+-- components, and also is the main identifier by which GHC identifies things.
 --      - When Backpack is not being used, UnitId = ComponentId.
 --        this means a useful fiction for end-users is that there are
 --        only ever ComponentIds, and some ComponentIds happen to have
@@ -193,9 +205,13 @@ import {-# SOURCE #-} Packages (componentIdString, improveUnitId, PackageConfigM
 --      - The same as PackageKey in GHC 7.10 (we renamed it because
 --        they don't necessarily identify packages anymore.)
 --      - Same as -this-package-key/-package-name flags
+--      - An InstalledUnitId corresponds to an actual package which
+--        we have installed on disk.  It could be definite or indefinite,
+--        but if it's indefinite, it has nothing instantiated (we
+--        never install partially instantiated units.)
 --
--- Module: A UnitId + ModuleName. This is how the compiler identifies
--- modules (e.g. a Name is a Module + OccName)
+-- Module/InstalledModule: A UnitId/InstalledUnitId + ModuleName. This is how
+-- the compiler identifies modules (e.g. a Name is a Module + OccName)
 --      - Same as Language.Haskell.TH.Syntax:Module
 --
 -- THE LESS IMPORTANT ONES
@@ -471,8 +487,8 @@ instance DbUnitIdModuleRep ComponentId UnitId ModuleName Module where
   fromDbModule (DbModuleVar mod_name) = mkHoleModule mod_name
   fromDbUnitId (DbUnitId { dbUnitIdComponentId = cid, dbUnitIdInsts = insts })
     = newUnitId cid insts
-  fromDbUnitId (DbHashedUnitId cid hash)
-    = newHashedUnitId cid (fmap mkFastStringByteString hash)
+  fromDbUnitId (DbInstalledUnitId cid hash) -- TODO rename this
+    = newDefiniteUnitId cid (fmap mkFastStringByteString hash)
   -- GHC never writes to the database, so it's not needed
   toDbModule = error "toDbModule: not implemented"
   toDbUnitId = error "toDbUnitId: not implemented"
@@ -518,36 +534,43 @@ instance Outputable ComponentId where
 ************************************************************************
 -}
 
--- | A unit identifier uniquely identifies a library (e.g.,
--- a package) in GHC.  In the absence of Backpack, unit identifiers
--- are just strings ('SimpleUnitId'); however, if a library is
--- parametrized over some signatures, these identifiers need
--- more structure.
+-- | A unit identifier identifies a (possibly partially) instantiated
+-- library.  It is primarily used as part of 'Module', which in turn
+-- is used in 'Name', which is used to give names to entities when
+-- typechecking.
+--
+-- There are two possible forms for a 'UnitId'.  It can be a
+-- 'DefiniteUnitId', in which case we just have a string that uniquely
+-- identifies some fully compiled, installed library we have on disk.
+-- However, when we are typechecking a library with missing holes,
+-- we may need to instantiate a library on the fly (in which case
+-- we don't have any on-disk representation.)  In that case, you
+-- have an 'IndefiniteUnitId', which explicitly records the
+-- instantiation, so that we can substitute over it.
 data UnitId
-    = AnIndefUnitId {-# UNPACK #-} !IndefUnitId
-    | AHashedUnitId {-# UNPACK #-} !HashedUnitId
+    = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId
+    |   DefiniteUnitId {-# UNPACK #-} !DefUnitId
     deriving (Typeable)
 
 unitIdFS :: UnitId -> FastString
-unitIdFS (AnIndefUnitId x) = indefUnitIdFS x
-unitIdFS (AHashedUnitId x) = hashedUnitIdFS x
+unitIdFS (IndefiniteUnitId x) = indefUnitIdFS x
+unitIdFS (DefiniteUnitId (DefUnitId x)) = installedUnitIdFS x
 
 unitIdKey :: UnitId -> Unique
-unitIdKey (AnIndefUnitId x) = indefUnitIdKey x
-unitIdKey (AHashedUnitId x) = hashedUnitIdKey x
+unitIdKey (IndefiniteUnitId x) = indefUnitIdKey x
+unitIdKey (DefiniteUnitId (DefUnitId x)) = installedUnitIdKey x
 
 unitIdComponentId :: UnitId -> ComponentId
-unitIdComponentId (AnIndefUnitId x) = indefUnitIdComponentId x
-unitIdComponentId (AHashedUnitId x) = hashedUnitIdComponentId x
-
--- | A non-hashed unit identifier identifies an indefinite
--- library (with holes) which has been *on-the-fly* instantiated
--- with a substitution 'unitIdInsts_'.  These unit identifiers
--- are recorded in interface files and installed package
--- database entries for indefinite libraries.  We can substitute
--- over these identifiers.
+unitIdComponentId (IndefiniteUnitId x) = indefUnitIdComponentId x
+unitIdComponentId (DefiniteUnitId (DefUnitId x)) = installedUnitIdComponentId x
+
+-- | A unit identifier which identifies an indefinite
+-- library (with holes) that has been *on-the-fly* instantiated
+-- with a substitution 'indefUnitIdInsts'.  In fact, an indefinite
+-- unit identifier could have no holes, but we haven't gotten
+-- around to compiling the actual library yet.
 --
--- A non-hashed unit identifier pretty-prints to something like
+-- An indefinite unit identifier pretty-prints to something like
 -- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'ComponentId', and the
 -- brackets enclose the module substitution).
 data IndefUnitId
@@ -571,44 +594,89 @@ data IndefUnitId
         indefUnitIdFreeHoles :: UniqDSet ModuleName
     } deriving (Typeable)
 
--- | A hashed unit identifier identifies an indefinite library which has
--- been fully instantiated, compiled and installed to the package database.
--- The ONLY source of hashed unit identifiers is the package database and
--- the @-this-unit-id@ flag: if a non-hashed unit id is substituted into one
--- with no holes, you don't necessarily get a hashed unit id: a hashed unit
--- id means *you have actual code*.  To promote a fully instantiated unit
--- identifier into a hashed unit identifier, you have to look it up in the
--- package database.
---
--- Hashed unit identifiers don't record the full instantiation tree,
--- making them a bit more efficient to work with.  This is possible
--- because substituting over a hashed unit id is always a no-op
--- (no free module variables)
+instance Eq IndefUnitId where
+  u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2
+
+instance Ord IndefUnitId where
+  u1 `compare` u2 = indefUnitIdFS u1 `compare` indefUnitIdFS u2
+
+-- | An installed unit identifier identifies a library which has
+-- been installed to the package database.  These strings are
+-- provided to us via the @-this-unit-id@ flag.  The library
+-- in question may be definite or indefinite; if it is indefinite,
+-- none of the holes have been filled (we never install partially
+-- instantiated libraries.)  Put another way, an installed unit id
+-- is either fully instantiated, or not instantiated at all.
 --
--- Hashed unit identifiers look something like @p+af23SAj2dZ219@
-data HashedUnitId =
-    HashedUnitId {
+-- Installed unit identifiers look something like @p+af23SAj2dZ219@,
+-- or maybe just @p@ if they don't use Backpack.
+data InstalledUnitId =
+    InstalledUnitId {
       -- | The full hashed unit identifier, including the component id
       -- and the hash.
-      hashedUnitIdFS :: FastString,
+      installedUnitIdFS :: FastString,
       -- | Cached unique of 'unitIdFS'.
-      hashedUnitIdKey :: Unique,
+      installedUnitIdKey :: Unique,
       -- | The component identifier of the hashed unit identifier.
-      hashedUnitIdComponentId :: !ComponentId
+      installedUnitIdComponentId :: !ComponentId
     }
    deriving (Typeable)
 
-instance Eq IndefUnitId where
-  u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2
+-- | A 'DefUnitId' is an 'InstalledUnitId' with the invariant that
+-- it only refers to a definite library; i.e., one we have generated
+-- code for.
+newtype DefUnitId = DefUnitId { unDefUnitId :: InstalledUnitId }
+    deriving (Eq, Ord, Outputable, Typeable)
 
-instance Ord IndefUnitId where
-  u1 `compare` u2 = indefUnitIdFS u1 `compare` indefUnitIdFS u2
+instance Binary InstalledUnitId where
+  put_ bh uid
+    | cid == ComponentId fs = do
+        putByte bh 0
+        put_ bh fs
+    | otherwise = do
+        putByte bh 2
+        put_ bh cid
+        put_ bh fs
+   where
+    cid = installedUnitIdComponentId uid
+    fs  = installedUnitIdFS uid
+  get bh = do b <- getByte bh
+              case b of
+                0 -> fmap fsToInstalledUnitId (get bh)
+                _ -> do
+                  cid <- get bh
+                  fs  <- get bh
+                  return (rawNewInstalledUnitId cid fs)
 
-instance Outputable HashedUnitId where
+instance BinaryStringRep InstalledUnitId where
+  fromStringRep bs = rawNewInstalledUnitId (fromStringRep cid) (mkFastStringByteString bs)
+    where cid = BS.Char8.takeWhile (/='+') bs
+  -- GHC doesn't write to database
+  toStringRep   = error "BinaryStringRep InstalledUnitId: not implemented"
+
+instance Eq InstalledUnitId where
+    uid1 == uid2 = installedUnitIdKey uid1 == installedUnitIdKey uid2
+
+instance Ord InstalledUnitId where
+    u1 `compare` u2 = installedUnitIdFS u1 `compare` installedUnitIdFS u2
+
+instance Uniquable InstalledUnitId where
+    getUnique = installedUnitIdKey
+
+instance Outputable InstalledUnitId where
     ppr uid =
-        if hashedUnitIdComponentId uid == ComponentId (hashedUnitIdFS uid)
-            then ppr (hashedUnitIdComponentId uid)
-            else ftext (hashedUnitIdFS uid)
+        if installedUnitIdComponentId uid == ComponentId (installedUnitIdFS uid)
+            then ppr (installedUnitIdComponentId uid)
+            else ftext (installedUnitIdFS uid)
+
+-- | Lossy conversion to the on-disk 'InstalledUnitId' for a component.
+toInstalledUnitId :: UnitId -> InstalledUnitId
+toInstalledUnitId (DefiniteUnitId (DefUnitId iuid)) = iuid
+toInstalledUnitId (IndefiniteUnitId indef) =
+    newInstalledUnitId (indefUnitIdComponentId indef) Nothing
+
+installedUnitIdString :: InstalledUnitId -> String
+installedUnitIdString = unpackFS . installedUnitIdFS
 
 instance Outputable IndefUnitId where
     ppr uid =
@@ -636,25 +704,53 @@ instance Outputable IndefUnitId where
       cid   = indefUnitIdComponentId uid
       insts = indefUnitIdInsts uid
 
-{-
-newtype DefiniteUnitId  = DefiniteUnitId  HashedUnitId
-    deriving (Eq, Ord, Outputable, Typeable)
+-- | A 'InstalledModule' is a 'Module' which contains a 'InstalledUnitId'.
+data InstalledModule = InstalledModule {
+   installedModuleUnitId :: !InstalledUnitId,
+   installedModuleName :: !ModuleName
+  }
+  deriving (Eq, Ord)
 
-newtype InstalledUnitId = InstalledUnitId HashedUnitId
-    deriving (Eq, Ord, Outputable, Typeable)
--}
+instance Outputable InstalledModule where
+  ppr (InstalledModule p n) =
+    ppr p <> char ':' <> pprModuleName n
+
+fsToInstalledUnitId :: FastString -> InstalledUnitId
+fsToInstalledUnitId fs = rawNewInstalledUnitId (ComponentId fs) fs
+
+stringToInstalledUnitId :: String -> InstalledUnitId
+stringToInstalledUnitId = fsToInstalledUnitId . mkFastString
+
+-- | Test if a 'Module' corresponds to a given 'InstalledModule',
+-- modulo instantiation.
+installedModuleEq :: InstalledModule -> Module -> Bool
+installedModuleEq imod mod =
+    fst (splitModuleInsts mod) == imod
+
+-- | Test if a 'UnitId' corresponds to a given 'InstalledUnitId',
+-- modulo instantiation.
+installedUnitIdEq :: InstalledUnitId -> UnitId -> Bool
+installedUnitIdEq iuid uid =
+    fst (splitUnitIdInsts uid) == iuid
+
+-- | A map keyed off of 'InstalledModule'
+newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)
+
+emptyInstalledModuleEnv :: InstalledModuleEnv a
+emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
 
--- | A 'VirginModule' is a 'Module' which contains a 'VirginUnitId'.
-type VirginModule = Module
+lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
+lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
 
--- | A virgin unit id is either a 'HashedUnitId',
--- or a 'UnitId' whose instantiation all have the form @A=<A>@.
--- Intuitively, virgin unit identifiers are those which are recorded
--- in the installed package database and can be read off disk.
-type VirginUnitId = UnitId
+extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
+extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
 
--- | A map keyed off of 'VirginModule'
-type VirginModuleEnv elt = ModuleEnv elt
+filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
+filterInstalledModuleEnv f (InstalledModuleEnv e) =
+  InstalledModuleEnv (Map.filterWithKey f e)
+
+delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
+delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
 
 -- | A hole module is a 'Module' representing a required
 -- signature that we are going to merge in.  The unit id
@@ -662,10 +758,10 @@ type VirginModuleEnv elt = ModuleEnv elt
 -- an instantiation.
 type HoleModule = (IndefUnitId, ModuleName)
 
--- Note [UnitId to HashedUnitId improvement]
+-- Note [UnitId to InstalledUnitId improvement]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- Just because a UnitId is definite (has no holes) doesn't
--- mean it's necessarily a HashedUnitId; it could just be
+-- mean it's necessarily a InstalledUnitId; it could just be
 -- that over the course of renaming UnitIds on the fly
 -- while typechecking an indefinite library, we
 -- ended up with a fully instantiated unit id with no hash,
@@ -678,21 +774,19 @@ type HoleModule = (IndefUnitId, ModuleName)
 -- (the unitIdFS for a UnitId never corresponds to a Cabal-provided
 -- hash of a compiled instantiated library).
 --
--- There is one last niggle which is not currently fixed:
--- improvement based on the package database means that
--- we might end up developing on a package that is not transitively
--- depended upon by the packages the user specified directly
--- via command line flags.  This could lead to strange and
--- difficult to understand bugs if those instantiations are
--- out of date.  The fix is that GHC has to be a bit more
--- careful about what instantiated packages get put in the package database.
--- I haven't implemented this yet.
+-- There is one last niggle: improvement based on the package database means
+-- that we might end up developing on a package that is not transitively
+-- depended upon by the packages the user specified directly via command line
+-- flags.  This could lead to strange and difficult to understand bugs if those
+-- instantiations are out of date.  The solution is to only improve a
+-- unit id if the new unit id is part of the 'preloadClosure'; i.e., the
+-- closure of all the packages which were explicitly specified.
 
 -- | Retrieve the set of free holes of a 'UnitId'.
 unitIdFreeHoles :: UnitId -> UniqDSet ModuleName
-unitIdFreeHoles (AnIndefUnitId x) = indefUnitIdFreeHoles x
+unitIdFreeHoles (IndefiniteUnitId x) = indefUnitIdFreeHoles x
 -- Hashed unit ids are always fully instantiated
-unitIdFreeHoles (AHashedUnitId _) = emptyUniqDSet
+unitIdFreeHoles (DefiniteUnitId _) = emptyUniqDSet
 
 instance Show UnitId where
     show = unitIdString
@@ -707,14 +801,12 @@ unitIdIsDefinite = isEmptyUniqDSet . unitIdFreeHoles
 -- coincides with its 'ComponentId'.  This hash is completely internal
 -- to GHC and is not used for symbol names or file paths.
 hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString
-hashUnitId (ComponentId fs_cid) sorted_holes
-    -- Make the special-case work.
-    | all (\(mod_name, m) -> mkHoleModule mod_name == m) sorted_holes = fs_cid
 hashUnitId cid sorted_holes =
     mkFastStringByteString
   . fingerprintUnitId (toStringRep cid)
   $ rawHashUnitId sorted_holes
 
+-- | Generate a hash for a sorted module substitution.
 rawHashUnitId :: [(ModuleName, Module)] -> Fingerprint
 rawHashUnitId sorted_holes =
     fingerprintByteString
@@ -739,27 +831,37 @@ fingerprintUnitId prefix (Fingerprint a b)
 
 -- | Create a new, externally provided hashed unit id from
 -- a hash.
-newHashedUnitId :: ComponentId -> Maybe FastString -> UnitId
-newHashedUnitId cid@(ComponentId cid_fs) (Just fs)
-    = rawNewHashedUnitId cid (cid_fs `appendFS` mkFastString "+" `appendFS` fs)
-newHashedUnitId cid@(ComponentId cid_fs) Nothing
-    = rawNewHashedUnitId cid cid_fs
-
--- | Smart constructor for 'HashedUnitId'; input 'FastString'
+newInstalledUnitId :: ComponentId -> Maybe FastString -> InstalledUnitId
+newInstalledUnitId cid@(ComponentId cid_fs) (Just fs)
+    = rawNewInstalledUnitId cid (cid_fs `appendFS` mkFastString "+" `appendFS` fs)
+newInstalledUnitId cid@(ComponentId cid_fs) Nothing
+    = rawNewInstalledUnitId cid cid_fs
+
+rawNewDefiniteUnitId :: ComponentId -> FastString -> UnitId
+rawNewDefiniteUnitId cid fs =
+    DefiniteUnitId (DefUnitId (rawNewInstalledUnitId cid fs))
+
+-- | Create a new 'UnitId' for an instantiated unit id.
+newDefiniteUnitId :: ComponentId -> Maybe FastString -> UnitId
+newDefiniteUnitId cid mb_fs =
+    DefiniteUnitId (DefUnitId (newInstalledUnitId cid mb_fs))
+
+-- | Smart constructor for 'InstalledUnitId'; input 'FastString'
 -- is assumed to be the FULL identifying string for this
 -- UnitId (e.g., it contains the 'ComponentId').
-rawNewHashedUnitId :: ComponentId -> FastString -> UnitId
-rawNewHashedUnitId cid fs = AHashedUnitId $ HashedUnitId {
-        hashedUnitIdFS = fs,
-        hashedUnitIdKey = getUnique fs,
-        hashedUnitIdComponentId = cid
+rawNewInstalledUnitId :: ComponentId -> FastString -> InstalledUnitId
+rawNewInstalledUnitId cid fs = InstalledUnitId {
+        installedUnitIdFS = fs,
+        installedUnitIdKey = getUnique fs,
+        installedUnitIdComponentId = cid
     }
 
 -- | Create a new, un-hashed unit identifier.
 newUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId
 newUnitId cid [] = newSimpleUnitId cid -- TODO: this indicates some latent bug...
-newUnitId cid insts = AnIndefUnitId $ newIndefUnitId cid insts
+newUnitId cid insts = IndefiniteUnitId $ newIndefUnitId cid insts
 
+-- | Create a new 'IndefUnitId' given an explicit module substitution.
 newIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId
 newIndefUnitId cid insts =
     IndefUnitId {
@@ -773,10 +875,9 @@ newIndefUnitId cid insts =
      fs = hashUnitId cid sorted_insts
      sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts
 
-
 pprUnitId :: UnitId -> SDoc
-pprUnitId (AHashedUnitId uid) = ppr uid
-pprUnitId (AnIndefUnitId uid) = ppr uid
+pprUnitId (DefiniteUnitId uid) = ppr uid
+pprUnitId (IndefiniteUnitId uid) = ppr uid
 
 instance Eq UnitId where
   uid1 == uid2 = unitIdKey uid1 == unitIdKey uid2
@@ -805,7 +906,7 @@ instance Outputable UnitId where
 
 -- Performance: would prefer to have a NameCache like thing
 instance Binary UnitId where
-  put_ bh (AHashedUnitId uid)
+  put_ bh (DefiniteUnitId (DefUnitId uid))
     | cid == ComponentId fs = do
         putByte bh 0
         put_ bh fs
@@ -814,9 +915,9 @@ instance Binary UnitId where
         put_ bh cid
         put_ bh fs
    where
-    cid = hashedUnitIdComponentId uid
-    fs  = hashedUnitIdFS uid
-  put_ bh (AnIndefUnitId uid) = do
+    cid = installedUnitIdComponentId uid
+    fs  = installedUnitIdFS uid
+  put_ bh (IndefiniteUnitId uid) = do
     putByte bh 1
     put_ bh cid
     put_ bh insts
@@ -833,13 +934,7 @@ instance Binary UnitId where
                 _ -> do
                   cid <- get bh
                   fs  <- get bh
-                  return (rawNewHashedUnitId cid fs)
-
-instance BinaryStringRep UnitId where
-  fromStringRep bs = rawNewHashedUnitId (fromStringRep cid) (mkFastStringByteString bs)
-    where cid = BS.Char8.takeWhile (/='+') bs
-  -- GHC doesn't write to database
-  toStringRep   = error "BinaryStringRep UnitId: not implemented"
+                  return (rawNewDefiniteUnitId cid fs)
 
 instance Binary ComponentId where
   put_ bh (ComponentId fs) = put_ bh fs
@@ -852,7 +947,7 @@ newSimpleUnitId (ComponentId fs) = fsToUnitId fs
 -- | Create a new simple unit identifier from a 'FastString'.  Internally,
 -- this is primarily used to specify wired-in unit identifiers.
 fsToUnitId :: FastString -> UnitId
-fsToUnitId fs = rawNewHashedUnitId (ComponentId fs) fs
+fsToUnitId fs = rawNewDefiniteUnitId (ComponentId fs) fs
 
 stringToUnitId :: String -> UnitId
 stringToUnitId = fsToUnitId . mkFastString
@@ -902,7 +997,7 @@ renameHoleModule' pkg_map env m
 renameHoleUnitId' :: PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId
 renameHoleUnitId' pkg_map env uid =
     case uid of
-      (AnIndefUnitId
+      (IndefiniteUnitId
         IndefUnitId{ indefUnitIdComponentId = cid
                    , indefUnitIdInsts       = insts
                    , indefUnitIdFreeHoles   = fh })
@@ -911,7 +1006,7 @@ renameHoleUnitId' pkg_map env uid =
                 -- Functorially apply the substitution to the instantiation,
                 -- then check the 'PackageConfigMap' to see if there is
                 -- a compiled version of this 'UnitId' we can improve to.
-                -- See Note [UnitId to HashedUnitId] improvement
+                -- See Note [UnitId to InstalledUnitId] improvement
                 else improveUnitId pkg_map $
                         newUnitId cid
                             (map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)
@@ -921,16 +1016,16 @@ renameHoleUnitId' pkg_map env uid =
 -- a 'Module' that we definitely can find on-disk, as well as an
 -- instantiation if we need to instantiate it on the fly.  If the
 -- instantiation is @Nothing@ no on-the-fly renaming is needed.
-splitModuleInsts :: Module -> (VirginModule, Maybe [(ModuleName, Module)])
+splitModuleInsts :: Module -> (InstalledModule, Maybe [(ModuleName, Module)])
 splitModuleInsts m =
     let (uid, mb_insts) = splitUnitIdInsts (moduleUnitId m)
-    in (mkModule uid (moduleName m), mb_insts)
+    in (InstalledModule uid (moduleName m), mb_insts)
 
 -- | See 'splitModuleInsts'.
-splitUnitIdInsts :: UnitId -> (VirginUnitId, Maybe [(ModuleName, Module)])
-splitUnitIdInsts (AnIndefUnitId iuid) =
-    (AnIndefUnitId (generalizeIndefUnitId iuid), Just (indefUnitIdInsts iuid))
-splitUnitIdInsts uid = (uid, Nothing)
+splitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe [(ModuleName, Module)])
+splitUnitIdInsts (IndefiniteUnitId iuid) =
+    (newInstalledUnitId (indefUnitIdComponentId iuid) Nothing, Just (indefUnitIdInsts iuid))
+splitUnitIdInsts (DefiniteUnitId (DefUnitId uid)) = (uid, Nothing)
 
 generalizeIndefUnitId :: IndefUnitId -> IndefUnitId
 generalizeIndefUnitId IndefUnitId{ indefUnitIdComponentId = cid
@@ -942,17 +1037,20 @@ parseModuleName = fmap mkModuleName
                 $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")
 
 parseUnitId :: ReadP UnitId
-parseUnitId = parseFullUnitId <++ parseHashedUnitId <++ parseSimpleUnitId
+parseUnitId = parseFullUnitId <++ parseDefiniteUnitId <++ parseSimpleUnitId
   where
-    parseFullUnitId = do cid <- parseComponentId
-                         insts <- parseModSubst
-                         return (newUnitId cid insts)
-    parseHashedUnitId = do cid <- parseComponentId
-                           _ <- Parse.char '+'
-                           hash <- Parse.munch1 isAlphaNum
-                           return (newHashedUnitId cid (Just (mkFastString hash)))
-    parseSimpleUnitId = do cid <- parseComponentId
-                           return (newSimpleUnitId cid)
+    parseFullUnitId = do
+        cid <- parseComponentId
+        insts <- parseModSubst
+        return (newUnitId cid insts)
+    parseDefiniteUnitId = do
+        cid <- parseComponentId
+        _ <- Parse.char '+'
+        hash <- Parse.munch1 isAlphaNum
+        return (newDefiniteUnitId cid (Just (mkFastString hash)))
+    parseSimpleUnitId = do
+        cid <- parseComponentId
+        return (newSimpleUnitId cid)
 
 parseComponentId :: ReadP ComponentId
 parseComponentId = (ComponentId . mkFastString)  `fmap` Parse.munch1 abi_char
index 72d2f9b..1f589a9 100644 (file)
@@ -92,12 +92,12 @@ mkDependencies
                 --  on M.hi-boot, and hence that we should do the hi-boot consistency
                 --  check.)
 
-          pkgs | th_used   = insertList thUnitId (imp_dep_pkgs imports)
+          pkgs | th_used   = insertList (toInstalledUnitId thUnitId) (imp_dep_pkgs imports)
                | otherwise = imp_dep_pkgs imports
 
           -- Set the packages required to be Safe according to Safe Haskell.
           -- See Note [RnNames . Tracking Trust Transitively]
-          sorted_pkgs = sortBy stableUnitIdCmp pkgs
+          sorted_pkgs = sort pkgs
           trust_pkgs  = imp_trust_pkgs imports
           dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
 
index 251d9a8..0b3fd94 100644 (file)
@@ -116,7 +116,7 @@ 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 :: ![UnitId],
+        pkgs_loaded :: ![LinkerUnitId],
 
         -- we need to remember the name of previous temporary DLL/.so
         -- libraries so we can link them (see #10322)
@@ -137,10 +137,10 @@ emptyPLS _ = PersistentLinkerState {
   --
   -- The linker's symbol table is populated with RTS symbols using an
   -- explicit list.  See rts/Linker.c for details.
-  where init_pkgs = [rtsUnitId]
+  where init_pkgs = map toInstalledUnitId [rtsUnitId]
 
 
-extendLoadedPkgs :: [UnitId] -> IO ()
+extendLoadedPkgs :: [InstalledUnitId] -> IO ()
 extendLoadedPkgs pkgs =
   modifyPLS_ $ \s ->
       return s{ pkgs_loaded = pkgs ++ pkgs_loaded s }
@@ -566,7 +566,7 @@ getLinkDeps :: HscEnv -> HomePackageTable
             -> Maybe FilePath                   -- replace object suffices?
             -> SrcSpan                          -- for error messages
             -> [Module]                         -- If you need these
-            -> IO ([Linkable], [UnitId])     -- ... then link these first
+            -> IO ([Linkable], [InstalledUnitId])     -- ... then link these first
 -- Fails with an IO exception if it can't find enough files
 
 getLinkDeps hsc_env hpt pls replace_osuf span mods
@@ -604,8 +604,8 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
         -- tree recursively.  See bug #936, testcase ghci/prog007.
     follow_deps :: [Module]             -- modules to follow
                 -> UniqDSet ModuleName         -- accum. module dependencies
-                -> UniqDSet UnitId          -- accum. package dependencies
-                -> IO ([ModuleName], [UnitId]) -- result
+                -> UniqDSet InstalledUnitId          -- accum. package dependencies
+                -> IO ([ModuleName], [InstalledUnitId]) -- result
     follow_deps []     acc_mods acc_pkgs
         = return (uniqDSetToList acc_mods, uniqDSetToList acc_pkgs)
     follow_deps (mod:mods) acc_mods acc_pkgs
@@ -632,7 +632,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
             acc_pkgs'  = addListToUniqDSet acc_pkgs $ map fst pkg_deps
           --
           if pkg /= this_pkg
-             then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' pkg)
+             then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toInstalledUnitId pkg))
              else follow_deps (map (mkModule this_pkg) boot_deps' ++ mods)
                               acc_mods' acc_pkgs'
         where
@@ -1126,12 +1126,15 @@ showLS (DLL nm)       = "(dynamic) " ++ nm
 showLS (DLLPath nm)   = "(dynamic) " ++ nm
 showLS (Framework nm) = "(framework) " ++ nm
 
+-- TODO: Make this type more precise
+type LinkerUnitId = InstalledUnitId
+
 -- | 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 what order you specify the input
 -- packages.
 --
-linkPackages :: HscEnv -> [UnitId] -> IO ()
+linkPackages :: HscEnv -> [LinkerUnitId] -> IO ()
 -- NOTE: in fact, since each module tracks all the packages it depends on,
 --       we don't really need to use the package-config dependencies.
 --
@@ -1147,7 +1150,7 @@ linkPackages hsc_env new_pkgs = do
   modifyPLS_ $ \pls -> do
     linkPackages' hsc_env new_pkgs pls
 
-linkPackages' :: HscEnv -> [UnitId] -> PersistentLinkerState
+linkPackages' :: HscEnv -> [LinkerUnitId] -> PersistentLinkerState
              -> IO PersistentLinkerState
 linkPackages' hsc_env new_pks pls = do
     pkgs' <- link (pkgs_loaded pls) new_pks
@@ -1155,7 +1158,7 @@ linkPackages' hsc_env new_pks pls = do
   where
      dflags = hsc_dflags hsc_env
 
-     link :: [UnitId] -> [UnitId] -> IO [UnitId]
+     link :: [LinkerUnitId] -> [LinkerUnitId] -> IO [LinkerUnitId]
      link pkgs new_pkgs =
          foldM link_one pkgs new_pkgs
 
@@ -1163,7 +1166,7 @@ linkPackages' hsc_env new_pks pls = do
         | new_pkg `elem` pkgs   -- Already linked
         = return pkgs
 
-        | Just pkg_cfg <- lookupPackage dflags new_pkg
+        | Just pkg_cfg <- lookupInstalledPackage dflags new_pkg
         = do {  -- Link dependents first
                pkgs' <- link pkgs (depends pkg_cfg)
                 -- Now link the package itself
@@ -1171,7 +1174,7 @@ linkPackages' hsc_env new_pks pls = do
              ; return (new_pkg : pkgs') }
 
         | otherwise
-        = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unitIdString new_pkg))
+        = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (installedUnitIdFS new_pkg)))
 
 
 linkPackage :: HscEnv -> PackageConfig -> IO ()
index 4e1fea0..ca11c6f 100644 (file)
@@ -276,7 +276,8 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
        ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
        ; case res of
            Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
-           err         -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
+           -- TODO: Make sure this error message is good
+           err         -> return (Failed (cannotFindModule (hsc_dflags hsc_env) mod err)) }
 
 -- | Load interface directly for a fully qualified 'Module'.  (This is a fairly
 -- rare operation, but in particular it is used to load orphan modules
@@ -572,7 +573,7 @@ moduleFreeHolesPrecise doc_str mod
     tryEpsAndHpt dflags eps hpt =
         fmap mi_free_holes (lookupIfaceByModule dflags hpt (eps_PIT eps) mod)
     tryDepsCache eps imod insts =
-        case lookupModuleEnv (eps_free_holes eps) imod of
+        case lookupInstalledModuleEnv (eps_free_holes eps) imod of
             Just ifhs  -> Just (renameFreeHoles ifhs insts)
             _otherwise -> Nothing
     readAndCache imod insts = do
@@ -582,7 +583,7 @@ moduleFreeHolesPrecise doc_str mod
                 let ifhs = mi_free_holes iface
                 -- Cache it
                 updateEps_ (\eps ->
-                    eps { eps_free_holes = extendModuleEnv (eps_free_holes eps) imod ifhs })
+                    eps { eps_free_holes = extendInstalledModuleEnv (eps_free_holes eps) imod ifhs })
                 return (Succeeded (renameFreeHoles ifhs insts))
             Failed err -> return (Failed err)
 
@@ -769,7 +770,7 @@ This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
 See Trac #8320.
 -}
 
-findAndReadIface :: SDoc -> VirginModule
+findAndReadIface :: SDoc -> InstalledModule
                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
                                         -- False <=> Look for .hi file
                  -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
@@ -788,7 +789,8 @@ findAndReadIface doc_str mod hi_boot_file
                      nest 4 (text "reason:" <+> doc_str)])
 
        -- Check for GHC.Prim, and return its static interface
-       if mod == gHC_PRIM
+       -- TODO: make this check a function
+       if mod `installedModuleEq` gHC_PRIM
            then do
                iface <- getHooked ghcPrimIfaceHook ghcPrimIface
                return (Succeeded (iface,
@@ -799,13 +801,13 @@ findAndReadIface doc_str mod hi_boot_file
                hsc_env <- getTopEnv
                mb_found <- liftIO (findExactModule hsc_env mod)
                case mb_found of
-                   Found loc mod -> do
+                   InstalledFound loc mod -> do
                        -- Found file, so read it
                        let file_path = addBootSuffix_maybe hi_boot_file
                                                            (ml_hi_file loc)
 
                        -- See Note [Home module load error]
-                       if thisPackage dflags == moduleUnitId mod &&
+                       if installedModuleUnitId mod `installedUnitIdEq` thisPackage dflags &&
                           not (isOneShot (ghcMode dflags))
                            then return (Failed (homeModError mod loc))
                            else do r <- read_file file_path
@@ -815,14 +817,14 @@ findAndReadIface doc_str mod hi_boot_file
                        traceIf (text "...not found")
                        dflags <- getDynFlags
                        return (Failed (cannotFindInterface dflags
-                                           (moduleName mod) err))
+                                           (installedModuleName mod) err))
     where read_file file_path = do
               traceIf (text "readIFace" <+> text file_path)
               read_result <- readIface mod file_path
               case read_result of
                 Failed err -> return (Failed (badIfaceFile file_path err))
                 Succeeded iface
-                    | mi_module iface /= mod ->
+                    | not (mod `installedModuleEq` mi_module iface) ->
                       return (Failed (wrongIfaceModErr iface mod file_path))
                     | otherwise ->
                       return (Succeeded (iface, file_path))
@@ -852,7 +854,7 @@ findAndReadIface doc_str mod hi_boot_file
 
 -- @readIface@ tries just the one file.
 
-readIface :: VirginModule -> FilePath
+readIface :: InstalledModule -> FilePath
           -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
         -- Failed err    <=> file not found, or unreadable, or illegible
         -- Succeeded iface <=> successfully found and parsed
@@ -862,8 +864,10 @@ readIface wanted_mod file_path
                  readBinIface CheckHiWay QuietBinIFaceReading file_path
         ; case res of
             Right iface
-                | wanted_mod == actual_mod -> return (Succeeded iface)
-                | otherwise                -> return (Failed err)
+                -- Same deal
+                | wanted_mod `installedModuleEq` actual_mod
+                                -> return (Succeeded iface)
+                | otherwise     -> return (Failed err)
                 where
                   actual_mod = mi_module iface
                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
@@ -884,7 +888,7 @@ initExternalPackageState
   = EPS {
       eps_is_boot      = emptyUFM,
       eps_PIT          = emptyPackageIfaceTable,
-      eps_free_holes   = emptyModuleEnv,
+      eps_free_holes   = emptyInstalledModuleEnv,
       eps_PTE          = emptyTypeEnv,
       eps_inst_env     = emptyInstEnv,
       eps_fam_inst_env = emptyFamInstEnv,
@@ -1114,7 +1118,7 @@ badIfaceFile file err
   = vcat [text "Bad interface file:" <+> text file,
           nest 4 err]
 
-hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc
+hiModuleNameMismatchWarn :: InstalledModule -> Module -> MsgDoc
 hiModuleNameMismatchWarn requested_mod read_mod =
   -- ToDo: This will fail to have enough qualification when the package IDs
   -- are the same
@@ -1127,11 +1131,11 @@ hiModuleNameMismatchWarn requested_mod read_mod =
          , ppr read_mod
          ]
 
-wrongIfaceModErr :: ModIface -> Module -> String -> SDoc
-wrongIfaceModErr iface mod_name file_path
+wrongIfaceModErr :: ModIface -> InstalledModule -> String -> SDoc
+wrongIfaceModErr iface mod file_path
   = sep [text "Interface file" <+> iface_file,
          text "contains module" <+> quotes (ppr (mi_module iface)) <> comma,
-         text "but we were expecting module" <+> quotes (ppr mod_name),
+         text "but we were expecting module" <+> quotes (ppr mod),
          sep [text "Probable cause: the source code which generated",
              nest 2 iface_file,
              text "has an incompatible module name"
@@ -1139,7 +1143,7 @@ wrongIfaceModErr iface mod_name file_path
         ]
   where iface_file = doubleQuotes (text file_path)
 
-homeModError :: Module -> ModLocation -> SDoc
+homeModError :: InstalledModule -> ModLocation -> SDoc
 -- See Note [Home module load error]
 homeModError mod location
   = text "attempting to use module " <> quotes (ppr mod)
index 3ab898e..7cff946 100644 (file)
@@ -651,7 +651,7 @@ getOrphanHashes hsc_env mods = do
 sortDependencies :: Dependencies -> Dependencies
 sortDependencies d
  = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
-          dep_pkgs   = sortBy (stableUnitIdCmp `on` fst) (dep_pkgs d),
+          dep_pkgs   = sortBy (compare `on` fst) (dep_pkgs d),
           dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
           dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
 
@@ -1009,7 +1009,7 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
 
         loadIface = do
              let iface_path = msHiFilePath mod_summary
-             read_result <- readIface (ms_mod mod_summary) iface_path
+             read_result <- readIface (ms_installed_mod mod_summary) iface_path
              case read_result of
                  Failed err -> do
                      traceIf (text "FYI: cannot read old interface file:" $$ nest 4 err)
@@ -1107,7 +1107,7 @@ checkHsig mod_summary iface = do
     dflags <- getDynFlags
     let outer_mod = ms_mod mod_summary
         inner_mod = canonicalizeHomeModule dflags (moduleName outer_mod)
-    MASSERT( thisPackage dflags == moduleUnitId outer_mod )
+    MASSERT( moduleUnitId outer_mod == thisPackage dflags )
     case inner_mod == mi_semantic_module iface of
         True -> up_to_date (text "implementing module unchanged")
         False -> return (RecompBecause "implementing module changed")
@@ -1158,7 +1158,7 @@ checkDependencies hsc_env summary iface
                  else
                          return UpToDate
           | otherwise
-           -> if pkg `notElem` (map fst prev_dep_pkgs)
+           -> if toInstalledUnitId pkg `notElem` (map fst prev_dep_pkgs)
                  then do traceHiDiffs $
                            text "imported module " <> quotes (ppr mod) <>
                            text " is from package " <> quotes (ppr pkg) <>
index 024cd7b..0794a9e 100644 (file)
@@ -378,7 +378,7 @@ tcHiBootIface hsc_src mod
         -- to check consistency against, rather than just when we notice
         -- that an hi-boot is necessary due to a circular import.
         { read_result <- findAndReadIface
-                                need mod
+                                need (fst (splitModuleInsts mod))
                                 True    -- Hi-boot file
 
         ; case read_result of {
index f172cf1..f4681dc 100644 (file)
@@ -50,7 +50,7 @@ codeOutput :: DynFlags
            -> FilePath
            -> ModLocation
            -> ForeignStubs
-           -> [UnitId]
+           -> [InstalledUnitId]
            -> Stream IO RawCmmGroup ()                       -- Compiled C--
            -> IO (FilePath,
                   (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}))
@@ -107,7 +107,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
 outputC :: DynFlags
         -> FilePath
         -> Stream IO RawCmmGroup ()
-        -> [UnitId]
+        -> [InstalledUnitId]
         -> IO ()
 
 outputC dflags filenm cmm_stream packages
@@ -131,7 +131,7 @@ outputC dflags filenm cmm_stream packages
                '<':_      -> "#include "++h_file
                _          -> "#include \""++h_file++"\""
 
-       let pkg_names = map unitIdString packages
+       let pkg_names = map installedUnitIdString packages
 
        doOutput filenm $ \ h -> do
           hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
index 30493f1..b1f1f6c 100644 (file)
@@ -402,7 +402,7 @@ link' dflags batch_attempt_linking hpt
         return Succeeded
 
 
-linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [UnitId] -> IO Bool
+linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [InstalledUnitId] -> IO Bool
 linkingNeeded dflags staticLink linkables pkg_deps = do
         -- if the modification time on the executable is later than the
         -- modification times on all of the objects and libraries, then omit
@@ -424,7 +424,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
         -- next, check libraries. XXX this only checks Haskell libraries,
         -- not extra_libraries or -l things from the command line.
         let pkg_hslibs  = [ (libraryDirs c, lib)
-                          | Just c <- map (lookupPackage dflags) pkg_deps,
+                          | Just c <- map (lookupInstalledPackage dflags) pkg_deps,
                             lib <- packageHsLibs dflags c ]
 
         pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs
@@ -438,7 +438,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
 
 -- Returns 'False' if it was, and we can avoid linking, because the
 -- previous binary was linked with "the same options".
-checkLinkInfo :: DynFlags -> [UnitId] -> FilePath -> IO Bool
+checkLinkInfo :: DynFlags -> [InstalledUnitId] -> FilePath -> IO Bool
 checkLinkInfo dflags pkg_deps exe_file
  | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))
  -- ToDo: Windows and OS X do not use the ELF binary format, so
@@ -1652,7 +1652,7 @@ mkExtraObjToLinkIntoBinary dflags = do
 -- this was included as inline assembly in the main.c file but this
 -- is pretty fragile. gas gets upset trying to calculate relative offsets
 -- that span the .note section (notably .text) when debug info is present
-mkNoteObjsToLinkIntoBinary :: DynFlags -> [UnitId] -> IO [FilePath]
+mkNoteObjsToLinkIntoBinary :: DynFlags -> [InstalledUnitId] -> IO [FilePath]
 mkNoteObjsToLinkIntoBinary dflags dep_packages = do
    link_info <- getLinkInfo dflags dep_packages
 
@@ -1677,7 +1677,7 @@ mkNoteObjsToLinkIntoBinary dflags dep_packages = do
 -- | Return the "link info" string
 --
 -- See Note [LinkInfo section]
-getLinkInfo :: DynFlags -> [UnitId] -> IO String
+getLinkInfo :: DynFlags -> [InstalledUnitId] -> IO String
 getLinkInfo dflags dep_packages = do
    package_link_opts <- getPackageLinkOpts dflags dep_packages
    pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags)
@@ -1714,13 +1714,13 @@ not follow the specified record-based format (see #11022).
 -----------------------------------------------------------------------------
 -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
 
-getHCFilePackages :: FilePath -> IO [UnitId]
+getHCFilePackages :: FilePath -> IO [InstalledUnitId]
 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 stringToUnitId (words rest))
+          return (map stringToInstalledUnitId (words rest))
       _other ->
           return []
 
@@ -1737,10 +1737,10 @@ getHCFilePackages filename =
 -- read any interface files), so the user must explicitly specify all
 -- the packages.
 
-linkBinary :: DynFlags -> [FilePath] -> [UnitId] -> IO ()
+linkBinary :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
 linkBinary = linkBinary' False
 
-linkBinary' :: Bool -> DynFlags -> [FilePath] -> [UnitId] -> IO ()
+linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ()
 linkBinary' staticLink dflags o_files dep_packages = do
     let platform = targetPlatform dflags
         mySettings = settings dflags
@@ -1987,7 +1987,7 @@ maybeCreateManifest dflags exe_filename
  | otherwise = return []
 
 
-linkDynLibCheck :: DynFlags -> [String] -> [UnitId] -> IO ()
+linkDynLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
 linkDynLibCheck dflags o_files dep_packages
  = do
     when (haveRtsOptsFlags dflags) $ do
@@ -1997,7 +1997,7 @@ linkDynLibCheck dflags o_files dep_packages
 
     linkDynLib dflags o_files dep_packages
 
-linkStaticLibCheck :: DynFlags -> [String] -> [UnitId] -> IO ()
+linkStaticLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
 linkStaticLibCheck dflags o_files dep_packages
  = do
     when (platformOS (targetPlatform dflags) `notElem` [OSiOS, OSDarwin]) $
@@ -2229,7 +2229,7 @@ haveRtsOptsFlags dflags =
 -- | Find out path to @ghcversion.h@ file
 getGhcVersionPathName :: DynFlags -> IO FilePath
 getGhcVersionPathName dflags = do
-  dirs <- getPackageIncludePath dflags [rtsUnitId]
+  dirs <- getPackageIncludePath dflags [toInstalledUnitId rtsUnitId]
 
   found <- filterM doesFileExist (map (</> "ghcversion.h") dirs)
   case found of
index e813e9e..2bcdd33 100644 (file)
@@ -71,25 +71,25 @@ type BaseName = String  -- Basename of file
 -- assumed to not move around during a session.
 flushFinderCaches :: HscEnv -> IO ()
 flushFinderCaches hsc_env =
-  atomicModifyIORef' fc_ref $ \fm -> (filterModuleEnv is_ext fm, ())
+  atomicModifyIORef' fc_ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
  where
         this_pkg = thisPackage (hsc_dflags hsc_env)
         fc_ref = hsc_FC hsc_env
-        is_ext mod _ | moduleUnitId mod /= this_pkg = True
+        is_ext mod _ | not (installedModuleUnitId mod `installedUnitIdEq` this_pkg) = True
                      | otherwise = False
 
-addToFinderCache :: IORef FinderCache -> Module -> FindResult -> IO ()
+addToFinderCache :: IORef FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
 addToFinderCache ref key val =
-  atomicModifyIORef' ref $ \c -> (extendModuleEnv c key val, ())
+  atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ())
 
-removeFromFinderCache :: IORef FinderCache -> Module -> IO ()
+removeFromFinderCache :: IORef FinderCache -> InstalledModule -> IO ()
 removeFromFinderCache ref key =
-  atomicModifyIORef' ref $ \c -> (delModuleEnv c key, ())
+  atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())
 
-lookupFinderCache :: IORef FinderCache -> VirginModule -> IO (Maybe FindResult)
+lookupFinderCache :: IORef FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
 lookupFinderCache ref key = do
    c <- readIORef ref
-   return $! lookupModuleEnv c key
+   return $! lookupInstalledModuleEnv c key
 
 -- -----------------------------------------------------------------------------
 -- The three external entry points
@@ -131,11 +131,11 @@ findPluginModule hsc_env mod_name =
 -- reading the interface for a module mentioned by another interface,
 -- for example (a "system import").
 
-findExactModule :: HscEnv -> VirginModule -> IO FindResult
+findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
 findExactModule hsc_env mod =
     let dflags = hsc_dflags hsc_env
-    in if moduleUnitId mod == thisPackage dflags
-       then findHomeModule hsc_env (moduleName mod)
+    in if installedModuleUnitId mod `installedUnitIdEq` thisPackage dflags
+       then findInstalledHomeModule hsc_env (installedModuleName mod)
        else findPackageModule hsc_env mod
 
 -- -----------------------------------------------------------------------------
@@ -169,9 +169,9 @@ orIfNotFound this or_this = do
 -- been done.  Otherwise, do the lookup (with the IO action) and save
 -- the result in the finder cache and the module location cache (if it
 -- was successful.)
-homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
+homeSearchCache :: HscEnv -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
 homeSearchCache hsc_env mod_name do_this = do
-  let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
+  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
   modLocationCache hsc_env mod do_this
 
 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
@@ -190,8 +190,20 @@ findExposedPluginPackageModule hsc_env mod_name
 
 findLookupResult :: HscEnv -> LookupResult -> IO FindResult
 findLookupResult hsc_env r = case r of
-     LookupFound m pkg_conf ->
-       findPackageModule_ hsc_env m pkg_conf
+     LookupFound m pkg_conf -> do
+       let im = fst (splitModuleInsts m)
+       r' <- findPackageModule_ hsc_env im pkg_conf
+       case r' of
+        -- TODO: ghc -M is unlikely to do the right thing
+        -- with just the location of the thing that was
+        -- instantiated; you probably also need all of the
+        -- implicit locations from the instances
+        InstalledFound loc   _ -> return (Found loc m)
+        InstalledNoPackage   _ -> return (NoPackage (moduleUnitId m))
+        InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnitId m)
+                                         , fr_pkgs_hidden = []
+                                         , fr_mods_hidden = []
+                                         , fr_suggestions = []})
      LookupMultiple rs ->
        return (FoundMultiple rs)
      LookupHidden pkg_hiddens mod_hiddens ->
@@ -205,7 +217,7 @@ findLookupResult hsc_env r = case r of
                        , fr_mods_hidden = []
                        , fr_suggestions = suggest })
 
-modLocationCache :: HscEnv -> VirginModule -> IO FindResult -> IO FindResult
+modLocationCache :: HscEnv -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
 modLocationCache hsc_env mod do_this = do
   m <- lookupFinderCache (hsc_FC hsc_env) mod
   case m of
@@ -215,20 +227,43 @@ modLocationCache hsc_env mod do_this = do
         addToFinderCache (hsc_FC hsc_env) mod result
         return result
 
+mkHomeInstalledModule :: DynFlags -> ModuleName -> InstalledModule
+mkHomeInstalledModule dflags mod_name =
+  let iuid = fst (splitUnitIdInsts (thisPackage dflags))
+  in InstalledModule iuid mod_name
+
+-- This returns a module because it's more convenient for users
 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
 addHomeModuleToFinder hsc_env mod_name loc = do
-  let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
-  addToFinderCache (hsc_FC hsc_env) mod (Found loc mod)
-  return mod
+  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
+  addToFinderCache (hsc_FC hsc_env) mod (InstalledFound loc mod)
+  return (mkModule (thisPackage (hsc_dflags hsc_env)) mod_name)
 
 uncacheModule :: HscEnv -> ModuleName -> IO ()
-uncacheModule hsc_env mod = do
-  let this_pkg = thisPackage (hsc_dflags hsc_env)
-  removeFromFinderCache (hsc_FC hsc_env) (mkModule this_pkg mod)
+uncacheModule hsc_env mod_name = do
+  let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
+  removeFromFinderCache (hsc_FC hsc_env) mod
 
 -- -----------------------------------------------------------------------------
 --      The internal workers
 
+findHomeModule :: HscEnv -> ModuleName -> IO FindResult
+findHomeModule hsc_env mod_name = do
+  r <- findInstalledHomeModule hsc_env mod_name
+  return $ case r of
+    InstalledFound loc _ -> Found loc (mkModule uid mod_name)
+    InstalledNoPackage _ -> NoPackage uid -- impossible
+    InstalledNotFound fps _ -> NotFound {
+        fr_paths = fps,
+        fr_pkg = Just uid,
+        fr_mods_hidden = [],
+        fr_pkgs_hidden = [],
+        fr_suggestions = []
+      }
+ where
+  dflags = hsc_dflags hsc_env
+  uid = thisPackage dflags
+
 -- | Implements the search for a module name in the home package only.  Calling
 -- this function directly is usually *not* what you want; currently, it's used
 -- as a building block for the following operations:
@@ -245,14 +280,14 @@ uncacheModule hsc_env mod = do
 --
 --  4. Some special-case code in GHCi (ToDo: Figure out why that needs to
 --  call this.)
-findHomeModule :: HscEnv -> ModuleName -> IO FindResult
-findHomeModule hsc_env mod_name =
+findInstalledHomeModule :: HscEnv -> ModuleName -> IO InstalledFindResult
+findInstalledHomeModule hsc_env mod_name =
    homeSearchCache hsc_env mod_name $
    let
      dflags = hsc_dflags hsc_env
      home_path = importPaths dflags
      hisuf = hiSuf dflags
-     mod = mkModule (thisPackage dflags) mod_name
+     mod = mkHomeInstalledModule dflags mod_name
 
      source_exts =
       [ ("hs",   mkHomeModLocationSearched dflags mod_name "hs")
@@ -275,20 +310,20 @@ findHomeModule hsc_env mod_name =
   -- special case for GHC.Prim; we won't find it in the filesystem.
   -- This is important only when compiling the base package (where GHC.Prim
   -- is a home module).
-  if mod == gHC_PRIM
-        then return (Found (error "GHC.Prim ModLocation") mod)
+  if mod `installedModuleEq` gHC_PRIM
+        then return (InstalledFound (error "GHC.Prim ModLocation") mod)
         else searchPathExts home_path mod exts
 
 
 -- | Search for a module in external packages only.
-findPackageModule :: HscEnv -> VirginModule -> IO FindResult
+findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
 findPackageModule hsc_env mod = do
   let
         dflags = hsc_dflags hsc_env
-        pkg_id = moduleUnitId mod
+        pkg_id = installedModuleUnitId mod
   --
-  case lookupPackage dflags pkg_id of
-     Nothing -> return (NoPackage pkg_id)
+  case lookupInstalledPackage dflags pkg_id of
+     Nothing -> return (InstalledNoPackage pkg_id)
      Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
 
 -- | Look up the interface file associated with module @mod@.  This function
@@ -298,14 +333,14 @@ findPackageModule hsc_env mod = do
 -- the 'PackageConfig' must be consistent with the unit id in the 'Module'.
 -- The redundancy is to avoid an extra lookup in the package state
 -- for the appropriate config.
-findPackageModule_ :: HscEnv -> VirginModule -> PackageConfig -> IO FindResult
+findPackageModule_ :: HscEnv -> InstalledModule -> PackageConfig -> IO InstalledFindResult
 findPackageModule_ hsc_env mod pkg_conf =
-  ASSERT( moduleUnitId mod == packageConfigId pkg_conf )
+  ASSERT( installedModuleUnitId mod == installedPackageConfigId pkg_conf )
   modLocationCache hsc_env mod $
 
   -- special case for GHC.Prim; we won't find it in the filesystem.
-  if mod == gHC_PRIM
-        then return (Found (error "GHC.Prim ModLocation") mod)
+  if mod `installedModuleEq` gHC_PRIM
+        then return (InstalledFound (error "GHC.Prim ModLocation") mod)
         else
 
   let
@@ -326,9 +361,9 @@ findPackageModule_ hsc_env mod pkg_conf =
     [one] | MkDepend <- ghcMode dflags -> do
           -- there's only one place that this .hi file can be, so
           -- don't bother looking for it.
-          let basename = moduleNameSlashes (moduleName mod)
+          let basename = moduleNameSlashes (installedModuleName mod)
           loc <- mk_hi_loc one basename
-          return (Found loc mod)
+          return (InstalledFound loc mod)
     _otherwise ->
           searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
 
@@ -337,13 +372,13 @@ findPackageModule_ hsc_env mod pkg_conf =
 
 searchPathExts
   :: [FilePath]         -- paths to search
-  -> Module             -- module name
+  -> InstalledModule             -- module name
   -> [ (
         FileExt,                                -- suffix
         FilePath -> BaseName -> IO ModLocation  -- action
        )
      ]
-  -> IO FindResult
+  -> IO InstalledFindResult
 
 searchPathExts paths mod exts
    = do result <- search to_search
@@ -358,7 +393,7 @@ searchPathExts paths mod exts
         return result
 
   where
-    basename = moduleNameSlashes (moduleName mod)
+    basename = moduleNameSlashes (installedModuleName mod)
 
     to_search :: [(FilePath, IO ModLocation)]
     to_search = [ (file, fn path basename)
@@ -369,15 +404,12 @@ searchPathExts paths mod exts
                       file = base <.> ext
                 ]
 
-    search [] = return (NotFound { fr_paths = map fst to_search
-                                 , fr_pkg   = Just (moduleUnitId mod)
-                                 , fr_mods_hidden = [], fr_pkgs_hidden = []
-                                 , fr_suggestions = [] })
+    search [] = return (InstalledNotFound (map fst to_search) (Just (installedModuleUnitId mod)))
 
     search ((file, mk_result) : rest) = do
       b <- doesFileExist file
       if b
-        then do { loc <- mk_result; return (Found loc mod) }
+        then do { loc <- mk_result; return (InstalledFound loc mod) }
         else search rest
 
 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
@@ -539,9 +571,9 @@ cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
 cannotFindModule = cantFindErr (sLit "Could not find module")
                                (sLit "Ambiguous module name")
 
-cannotFindInterface  :: DynFlags -> ModuleName -> FindResult -> SDoc
-cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
-                                  (sLit "Ambiguous interface for")
+cannotFindInterface  :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc
+cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
+                                           (sLit "Ambiguous interface for")
 
 cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
             -> SDoc
@@ -581,7 +613,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
       = case find_result of
             NoPackage pkg
                 -> text "no unit id matching" <+> quotes (ppr pkg) <+>
-                   text "was found" $$ looks_like_srcpkgid pkg
+                   text "was found"
 
             NotFound { fr_paths = files, fr_pkg = mb_pkg
                      , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
@@ -642,18 +674,6 @@ cantFindErr cannot_find _ dflags mod_name find_result
               text "to the build-depends in your .cabal file."
      | otherwise = Outputable.empty
 
-    looks_like_srcpkgid :: UnitId -> SDoc
-    looks_like_srcpkgid pk
-     -- Unsafely coerce a unit id FastString into a source package ID
-     -- FastString and see if it means anything.
-     | (pkg:pkgs) <- searchPackageId dflags (SourcePackageId (unitIdFS pk))
-     = parens (text "This unit ID looks like the source package ID;" $$
-       text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$
-       (if null pkgs then Outputable.empty
-        else text "and" <+> int (length pkgs) <+> text "other candidates"))
-     -- Todo: also check if it looks like a package name!
-     | otherwise = Outputable.empty
-
     mod_hidden pkg =
         text "it is a hidden module in the package" <+> quotes (ppr pkg)
 
@@ -693,3 +713,64 @@ cantFindErr cannot_find _ dflags mod_name find_result
                  = parens (text "needs flag -package-id"
                     <+> ppr (packageConfigId pkg))
               | otherwise = Outputable.empty
+
+cantFindInstalledErr :: LitString -> LitString -> DynFlags -> ModuleName -> InstalledFindResult
+            -> SDoc
+cantFindInstalledErr cannot_find _ dflags mod_name find_result
+  = ptext cannot_find <+> quotes (ppr mod_name)
+    $$ more_info
+  where
+    more_info
+      = case find_result of
+            InstalledNoPackage pkg
+                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
+                   text "was found" $$ looks_like_srcpkgid pkg
+
+            InstalledNotFound files mb_pkg
+                | Just pkg <- mb_pkg, not (pkg `installedUnitIdEq` thisPackage dflags)
+                -> not_found_in_package pkg files
+
+                | null files
+                -> text "It is not a module in the current program, or in any known package."
+
+                | otherwise
+                -> tried_these files
+
+            _ -> panic "cantFindInstalledErr"
+
+    build_tag = buildTag dflags
+
+    looks_like_srcpkgid :: InstalledUnitId -> SDoc
+    looks_like_srcpkgid pk
+     -- Unsafely coerce a unit id FastString into a source package ID
+     -- FastString and see if it means anything.
+     | (pkg:pkgs) <- searchPackageId dflags (SourcePackageId (installedUnitIdFS pk))
+     = parens (text "This unit ID looks like the source package ID;" $$
+       text "the real unit ID is" <+> quotes (ftext (installedUnitIdFS (unitId pkg))) $$
+       (if null pkgs then Outputable.empty
+        else text "and" <+> int (length pkgs) <+> text "other candidates"))
+     -- Todo: also check if it looks like a package name!
+     | otherwise = Outputable.empty
+
+    not_found_in_package pkg files
+       | build_tag /= ""
+       = let
+            build = if build_tag == "p" then "profiling"
+                                        else "\"" ++ build_tag ++ "\""
+         in
+         text "Perhaps you haven't installed the " <> text build <>
+         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
+         tried_these files
+
+       | otherwise
+       = text "There are files missing in the " <> quotes (ppr pkg) <>
+         text " package," $$
+         text "try running 'ghc-pkg check'." $$
+         tried_these files
+
+    tried_these files
+        | null files = Outputable.empty
+        | verbosity dflags < 3 =
+              text "Use -v to see a list of the files searched for."
+        | otherwise =
+               hang (text "Locations searched:") 2 $ vcat (map text files)
index 6a3887a..5122329 100644 (file)
@@ -576,7 +576,7 @@ checkBrokenTablesNextToCode' dflags
 -- flags.  If you are not doing linking or doing static linking, you
 -- can ignore the list of packages returned.
 --
-setSessionDynFlags :: GhcMonad m => DynFlags -> m [UnitId]
+setSessionDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]
 setSessionDynFlags dflags = do
   dflags' <- checkNewDynFlags dflags
   (dflags'', preload) <- liftIO $ initPackages dflags'
@@ -586,7 +586,7 @@ setSessionDynFlags dflags = do
   return preload
 
 -- | Sets the program 'DynFlags'.
-setProgramDynFlags :: GhcMonad m => DynFlags -> m [UnitId]
+setProgramDynFlags :: GhcMonad m => DynFlags -> m [InstalledUnitId]
 setProgramDynFlags dflags = do
   dflags' <- checkNewDynFlags dflags
   (dflags'', preload) <- liftIO $ initPackages dflags'
@@ -1435,7 +1435,7 @@ isModuleTrusted m = withSession $ \hsc_env ->
     liftIO $ hscCheckSafe hsc_env m noSrcSpan
 
 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
-moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [UnitId])
+moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [InstalledUnitId])
 moduleTrustReqs m = withSession $ \hsc_env ->
     liftIO $ hscGetSafe hsc_env m noSrcSpan
 
index 998d68c..0921a58 100644 (file)
@@ -1916,7 +1916,8 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
         extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name
         required_by_imports <- implicitRequirements hsc_env the_imps
 
-        return (ModSummary { ms_mod = mod, ms_hsc_src = hsc_src,
+        return (ModSummary { ms_mod = mod,
+                             ms_hsc_src = hsc_src,
                              ms_location = location,
                              ms_hspp_file = hspp_fn,
                              ms_hspp_opts = dflags',
index cd8b568..ae6ad7d 100644 (file)
@@ -179,7 +179,7 @@ newHscEnv dflags = do
     eps_var <- newIORef initExternalPackageState
     us      <- mkSplitUniqSupply 'r'
     nc_var  <- newIORef (initNameCache us allKnownKeyNames)
-    fc_var  <- newIORef emptyModuleEnv
+    fc_var  <- newIORef emptyInstalledModuleEnv
 #ifdef GHCI
     iserv_mvar <- newMVar Nothing
 #endif
@@ -444,12 +444,14 @@ hscTypecheck keep_rn mod_summary mb_rdr_module = do
     let hsc_src = ms_hsc_src mod_summary
         dflags = hsc_dflags hsc_env
         outer_mod = ms_mod mod_summary
-        inner_mod = canonicalizeHomeModule dflags (moduleName outer_mod)
+        mod_name = moduleName outer_mod
+        outer_mod' = mkModule (thisPackage dflags) mod_name
+        inner_mod = canonicalizeHomeModule dflags mod_name
         src_filename  = ms_hspp_file mod_summary
         real_loc = realSrcLocSpan $ mkRealSrcLoc (mkFastString src_filename) 1 1
     MASSERT( moduleUnitId outer_mod == thisPackage dflags )
     if hsc_src == HsigFile && not (isHoleModule inner_mod)
-        then ioMsgMaybe $ tcRnInstantiateSignature hsc_env outer_mod real_loc
+        then ioMsgMaybe $ tcRnInstantiateSignature hsc_env outer_mod' real_loc
         else
          do hpm <- case mb_rdr_module of
                     Just hpm -> return hpm
@@ -1021,7 +1023,7 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do
     return $ isEmptyBag errs
 
 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
-hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, [UnitId])
+hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, [InstalledUnitId])
 hscGetSafe hsc_env m l = runHsc hsc_env $ do
     dflags       <- getDynFlags
     (self, pkgs) <- hscCheckSafe' dflags m l
@@ -1035,15 +1037,17 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
 -- Return (regardless of trusted or not) if the trust type requires the modules
 -- own package be trusted and a list of other packages required to be trusted
 -- (these later ones haven't been checked) but the own package trust has been.
-hscCheckSafe' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe UnitId, [UnitId])
+hscCheckSafe' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe InstalledUnitId, [InstalledUnitId])
 hscCheckSafe' dflags m l = do
     (tw, pkgs) <- isModSafe m l
     case tw of
         False              -> return (Nothing, pkgs)
         True | isHomePkg m -> return (Nothing, pkgs)
-             | otherwise   -> return (Just $ moduleUnitId m, pkgs)
+             -- TODO: do we also have to check the trust of the instantiation?
+             -- Not necessary if that is reflected in dependencies
+             | otherwise   -> return (Just $ toInstalledUnitId (moduleUnitId m), pkgs)
   where
-    isModSafe :: Module -> SrcSpan -> Hsc (Bool, [UnitId])
+    isModSafe :: Module -> SrcSpan -> Hsc (Bool, [InstalledUnitId])
     isModSafe m l = do
         iface <- lookup' m
         case iface of
@@ -1123,7 +1127,7 @@ hscCheckSafe' dflags m l = do
         | otherwise                               = False
 
 -- | Check the list of packages are trusted.
-checkPkgTrust :: DynFlags -> [UnitId] -> Hsc ()
+checkPkgTrust :: DynFlags -> [InstalledUnitId] -> Hsc ()
 checkPkgTrust dflags pkgs =
     case errors of
         [] -> return ()
@@ -1131,7 +1135,7 @@ checkPkgTrust dflags pkgs =
     where
         errors = catMaybes $ map go pkgs
         go pkg
-            | trusted $ getPackageDetails dflags pkg
+            | trusted $ getInstalledPackageDetails dflags pkg
             = Nothing
             | otherwise
             = Just $ mkErrMsg dflags noSrcSpan (pkgQual dflags)
index c2d2938..1320a57 100644 (file)
@@ -10,7 +10,7 @@
 module HscTypes (
         -- * compilation state
         HscEnv(..), hscEPS,
-        FinderCache, FindResult(..),
+        FinderCache, FindResult(..), InstalledFindResult(..),
         Target(..), TargetId(..), pprTarget, pprTargetId,
         ModuleGraph, emptyMG,
         HscStatus(..),
@@ -26,7 +26,7 @@ module HscTypes (
         ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
         ImportedMods, ImportedModsVal(..),
 
-        ModSummary(..), ms_imps, ms_mod_name, showModMsg, isBootSummary,
+        ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,
         msHsFilePath, msHiFilePath, msObjFilePath,
         SourceModified(..),
 
@@ -771,16 +771,18 @@ prepareAnnotations hsc_env mb_guts = do
 -- modules along the search path. On @:load@, we flush the entire
 -- contents of this cache.
 --
--- Although the @FinderCache@ range is 'FindResult' for convenience,
--- in fact it will only ever contain 'Found' or 'NotFound' entries.
---
-type FinderCache = VirginModuleEnv FindResult
+type FinderCache = InstalledModuleEnv InstalledFindResult
+
+data InstalledFindResult
+  = InstalledFound ModLocation InstalledModule
+  | InstalledNoPackage InstalledUnitId
+  | InstalledNotFound [FilePath] (Maybe InstalledUnitId)
 
 -- | The result of searching for an imported module.
 --
 -- NB: FindResult manages both user source-import lookups
 -- (which can result in 'Module') as well as direct imports
--- for interfaces (which always result in 'VirginModule').
+-- for interfaces (which always result in 'InstalledModule').
 data FindResult
   = Found ModLocation Module
         -- ^ The module was found
@@ -1272,8 +1274,8 @@ data CgGuts
                 -- as part of the code-gen of tycons
 
         cg_foreign   :: !ForeignStubs,   -- ^ Foreign export stubs
-        cg_dep_pkgs  :: ![UnitId],    -- ^ Dependent packages, used to
-                                         -- generate #includes for C code gen
+        cg_dep_pkgs  :: ![InstalledUnitId], -- ^ Dependent packages, used to
+                                            -- generate #includes for C code gen
         cg_hpc_info  :: !HpcInfo,        -- ^ Program coverage tick box information
         cg_modBreaks :: !(Maybe ModBreaks) -- ^ Module breakpoints
     }
@@ -2240,7 +2242,7 @@ data Dependencies
                         -- I.e. modules that this one imports, or that are in the
                         --      dep_mods of those directly-imported modules
 
-         , dep_pkgs   :: [(UnitId, Bool)]
+         , dep_pkgs   :: [(InstalledUnitId, Bool)]
                         -- ^ All packages transitively below this module
                         -- I.e. packages to which this module's direct imports belong,
                         --      or that are in the dep_pkgs of those modules
@@ -2449,7 +2451,7 @@ data ExternalPackageState
                 --
                 -- * Deprecations and warnings
 
-        eps_free_holes :: ModuleEnv (UniqDSet ModuleName),
+        eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName),
                 -- ^ Cache for 'mi_free_holes'.  Ordinarily, we can rely on
                 -- the 'eps_PIT' for this information, EXCEPT that when
                 -- we do dependency analysis, we need to look at the
@@ -2602,6 +2604,9 @@ data ModSummary
           -- ^ The actual preprocessed source, if we have it
      }
 
+ms_installed_mod :: ModSummary -> InstalledModule
+ms_installed_mod = fst . splitModuleInsts . ms_mod
+
 ms_mod_name :: ModSummary -> ModuleName
 ms_mod_name = moduleName . ms_mod
 
index f16c902..6e3e2f1 100644 (file)
@@ -12,6 +12,8 @@ module PackageConfig (
         -- * UnitId
         packageConfigId,
         expandedPackageConfigId,
+        definitePackageConfigId,
+        installedPackageConfigId,
 
         -- * The PackageConfig type: information about a package
         PackageConfig,
@@ -35,6 +37,7 @@ import FastString
 import Outputable
 import Module
 import Unique
+import UniqDSet
 
 -- -----------------------------------------------------------------------------
 -- Our PackageConfig type is the InstalledPackageInfo from ghc-boot,
@@ -44,7 +47,7 @@ type PackageConfig = InstalledPackageInfo
                        ComponentId
                        SourcePackageId
                        PackageName
-                       Module.UnitId
+                       Module.InstalledUnitId
                        Module.UnitId
                        Module.ModuleName
                        Module.Module
@@ -129,11 +132,21 @@ pprPackageConfig InstalledPackageInfo {..} =
 -- version is, so these are handled specially; see #wired_in_packages#.
 
 -- | Get the GHC 'UnitId' right out of a Cabalish 'PackageConfig'
+installedPackageConfigId :: PackageConfig -> InstalledUnitId
+installedPackageConfigId = unitId
+
 packageConfigId :: PackageConfig -> UnitId
-packageConfigId = unitId
+packageConfigId p =
+    if indefinite p
+        then newUnitId (installedUnitIdComponentId (unitId p)) (instantiatedWith p)
+        else DefiniteUnitId (DefUnitId (unitId p))
 
 expandedPackageConfigId :: PackageConfig -> UnitId
 expandedPackageConfigId p =
-    case instantiatedWith p of
-        [] -> packageConfigId p
-        _ -> newUnitId (unitIdComponentId (packageConfigId p)) (instantiatedWith p)
+    newUnitId (installedUnitIdComponentId (unitId p)) (instantiatedWith p)
+
+definitePackageConfigId :: PackageConfig -> Maybe DefUnitId
+definitePackageConfigId p =
+    case packageConfigId p of
+        DefiniteUnitId def_uid -> Just def_uid
+        _ -> Nothing
index 3003e01..566d998 100644 (file)
@@ -20,11 +20,12 @@ module Packages (
         -- * Querying the package config
         lookupPackage,
         lookupPackage',
+        lookupInstalledPackage,
         lookupPackageName,
-        lookupComponentId,
         improveUnitId,
         searchPackageId,
         getPackageDetails,
+        getInstalledPackageDetails,
         componentIdString,
         listVisibleModuleNames,
         lookupModuleInAllPackages,
@@ -65,6 +66,7 @@ import DynFlags
 import Name             ( Name, nameModule_maybe )
 import UniqFM
 import UniqDFM
+import UniqSet
 import Module
 import Util
 import Panic
@@ -238,12 +240,18 @@ originEmpty :: ModuleOrigin -> Bool
 originEmpty (ModOrigin Nothing [] [] False) = True
 originEmpty _ = False
 
--- | 'UniqFM' map from 'UnitId'
-type UnitIdMap = UniqDFM
-
--- | 'UniqFM' map from 'UnitId' to 'PackageConfig'
--- (newtyped so we can put it in boot.)
-newtype PackageConfigMap = PackageConfigMap { unPackageConfigMap :: UnitIdMap PackageConfig }
+-- | 'UniqFM' map from 'InstalledUnitId'
+type InstalledUnitIdMap = UniqDFM
+
+-- | 'UniqFM' map from 'UnitId' to 'PackageConfig', plus
+-- the transitive closure of preload packages.
+data PackageConfigMap = PackageConfigMap {
+        unPackageConfigMap :: InstalledUnitIdMap PackageConfig,
+        -- | The set of transitively reachable packages according
+        -- to the explicitly provided command line arguments.
+        -- See Note [UnitId to InstalledUnitId improvement]
+        preloadClosure :: UniqSet InstalledUnitId
+    }
 
 -- | 'UniqFM' map from 'UnitId' to a 'UnitVisibility'.
 type VisibilityMap = Map UnitId UnitVisibility
@@ -294,6 +302,9 @@ instance Monoid UnitVisibility where
           , uv_explicit = uv_explicit uv1 || uv_explicit uv2
           }
 
+type WiredUnitId = DefUnitId
+type PreloadUnitId = InstalledUnitId
+
 -- | Map from 'ModuleName' to 'Module' to all the origins of the bindings
 -- in scope.  The 'PackageConf' is not cached, mostly for convenience reasons
 -- (since this is the slow path, we'll just look it up again).
@@ -314,12 +325,12 @@ data PackageState = PackageState {
 
   -- | A mapping from wired in names to the original names from the
   -- package database.
-  unwireMap :: Map UnitId UnitId,
+  unwireMap :: Map WiredUnitId WiredUnitId,
 
   -- | The packages we're going to link in eagerly.  This list
   -- should be in reverse dependency order; that is, a package
   -- is always mentioned before the packages it depends on.
-  preloadPackages      :: [UnitId],
+  preloadPackages      :: [PreloadUnitId],
 
   -- | Packages which we explicitly depend on (from a command line flag).
   -- We'll use this to generate version macros.
@@ -355,11 +366,11 @@ emptyPackageState = PackageState {
     requirementContext = Map.empty
     }
 
-type InstalledPackageIndex = Map UnitId PackageConfig
+type InstalledPackageIndex = Map InstalledUnitId PackageConfig
 
 -- | Empty package configuration map
 emptyPackageConfigMap :: PackageConfigMap
-emptyPackageConfigMap = PackageConfigMap emptyUDFM
+emptyPackageConfigMap = PackageConfigMap emptyUDFM emptyUniqSet
 
 -- | Find the package we know about with the given unit id, if any
 lookupPackage :: DynFlags -> UnitId -> Maybe PackageConfig
@@ -370,14 +381,15 @@ lookupPackage dflags = lookupPackage' (isIndefinite dflags) (pkgIdMap (pkgState
 -- just a 'PackageConfigMap' rather than a 'DynFlags' (so it can
 -- be used while we're initializing 'DynFlags'
 lookupPackage' :: Bool -> PackageConfigMap -> UnitId -> Maybe PackageConfig
-lookupPackage' False (PackageConfigMap pkg_map) uid = lookupUDFM pkg_map uid
-lookupPackage' True (PackageConfigMap pkg_map) uid =
+lookupPackage' False (PackageConfigMap pkg_map _) uid = lookupUDFM pkg_map uid
+lookupPackage' True m@(PackageConfigMap pkg_map _) uid =
     case splitUnitIdInsts uid of
         (iuid, Just insts) ->
-            fmap (renamePackage (PackageConfigMap pkg_map) insts)
+            fmap (renamePackage m insts)
                  (lookupUDFM pkg_map iuid)
         (_, Nothing) -> lookupUDFM pkg_map uid
 
+{-
 -- | Find the indefinite package for a given 'ComponentId'.
 -- The way this works is just by fiat'ing that every indefinite package's
 -- unit key is precisely its component ID; and that they share uniques.
@@ -385,6 +397,7 @@ lookupComponentId :: DynFlags -> ComponentId -> Maybe PackageConfig
 lookupComponentId dflags (ComponentId cid_fs) = lookupUDFM pkg_map cid_fs
   where
     PackageConfigMap pkg_map = pkgIdMap (pkgState dflags)
+-}
 
 -- | Find the package we know about with the given package name (e.g. @foo@), if any
 -- (NB: there might be a locally defined unit name which overrides this)
@@ -399,12 +412,12 @@ searchPackageId dflags pid = filter ((pid ==) . sourcePackageId)
 -- | Extends the package configuration map with a list of package configs.
 extendPackageConfigMap
    :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
-extendPackageConfigMap (PackageConfigMap pkg_map) new_pkgs
-  = PackageConfigMap (foldl add pkg_map new_pkgs)
+extendPackageConfigMap (PackageConfigMap pkg_map closure) new_pkgs
+  = PackageConfigMap (foldl add pkg_map new_pkgs) closure
     -- We also add the expanded version of the packageConfigId, so that
     -- 'improveUnitId' can find it.
   where add pkg_map p = addToUDFM (addToUDFM pkg_map (expandedPackageConfigId p) p)
-                                  (packageConfigId p) p
+                                  (installedPackageConfigId p) p
 
 -- | Looks up the package with the given id in the package state, panicing if it is
 -- not found
@@ -412,6 +425,17 @@ getPackageDetails :: DynFlags -> UnitId -> PackageConfig
 getPackageDetails dflags pid =
     expectJust "getPackageDetails" (lookupPackage dflags pid)
 
+lookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig
+lookupInstalledPackage dflags uid = lookupInstalledPackage' (pkgIdMap (pkgState dflags)) uid
+
+lookupInstalledPackage' :: PackageConfigMap -> InstalledUnitId -> Maybe PackageConfig
+lookupInstalledPackage' (PackageConfigMap db _) uid = lookupUDFM db uid
+
+getInstalledPackageDetails :: DynFlags -> InstalledUnitId -> PackageConfig
+getInstalledPackageDetails dflags uid =
+    expectJust "getInstalledPackageDetails" $
+        lookupInstalledPackage dflags uid
+
 -- | Get a list of entries from the package database.  NB: be careful with
 -- this function, although all packages in this map are "visible", this
 -- does not imply that the exposed-modules of the package are available
@@ -419,7 +443,7 @@ getPackageDetails dflags pid =
 listPackageConfigMap :: DynFlags -> [PackageConfig]
 listPackageConfigMap dflags = eltsUDFM pkg_map
   where
-    PackageConfigMap pkg_map = pkgIdMap (pkgState dflags)
+    PackageConfigMap pkg_map = pkgIdMap (pkgState dflags)
 
 -- ----------------------------------------------------------------------------
 -- Loading the package db files and building up the package state
@@ -437,7 +461,7 @@ listPackageConfigMap dflags = eltsUDFM pkg_map
 -- 'packageFlags' field of the 'DynFlags', and it will update the
 -- 'pkgState' in 'DynFlags' and return a list of packages to
 -- link in.
-initPackages :: DynFlags -> IO (DynFlags, [UnitId])
+initPackages :: DynFlags -> IO (DynFlags, [PreloadUnitId])
 initPackages dflags0 = do
   dflags <- interpretPackageEnv dflags0
   pkg_db <-
@@ -741,7 +765,7 @@ findPackages pkg_db arg pkgs unusable
           else Nothing
     finder (UnitIdArg uid) p
       = let (iuid, mb_insts) = splitUnitIdInsts uid
-        in if iuid == packageConfigId p
+        in if iuid == installedPackageConfigId p
               then Just (case mb_insts of
                             Nothing    -> p
                             Just insts -> renamePackage pkg_db insts p)
@@ -765,12 +789,10 @@ renamePackage :: PackageConfigMap -> [(ModuleName, Module)]
               -> PackageConfig -> PackageConfig
 renamePackage pkg_map insts conf =
     let hsubst = listToUFM insts
-        smod = renameHoleModule' pkg_map hsubst
-        suid = renameHoleUnitId' pkg_map hsubst
-        new_uid = suid (unitId conf)
+        smod  = renameHoleModule' pkg_map hsubst
+        new_insts = map (\(k,v) -> (k,smod v)) (instantiatedWith conf)
     in conf {
-        unitId = new_uid,
-        depends = map suid (depends conf),
+        instantiatedWith = new_insts,
         exposedModules = map (\(mod_name, mb_mod) -> (mod_name, fmap smod mb_mod))
                              (exposedModules conf)
     }
@@ -783,12 +805,13 @@ matchingStr str p
         =  str == sourcePackageIdString p
         || str == packageNameString p
 
-matchingId :: UnitId -> PackageConfig -> Bool
-matchingId uid p = uid == packageConfigId p
+matchingId :: InstalledUnitId -> PackageConfig -> Bool
+matchingId uid p = uid == installedPackageConfigId p
 
 matching :: PackageArg -> PackageConfig -> Bool
 matching (PackageArg str) = matchingStr str
-matching (UnitIdArg uid)  = matchingId uid
+matching (UnitIdArg (DefiniteUnitId (DefUnitId uid)))  = matchingId uid
+matching (UnitIdArg _)  = \_ -> False -- TODO: warn in this case
 
 sortByVersion :: [PackageConfig] -> [PackageConfig]
 sortByVersion = sortBy (flip (comparing packageVersion))
@@ -849,7 +872,7 @@ pprTrustFlag flag = case flag of
 wired_in_pkgids :: [String]
 wired_in_pkgids = map unitIdString wiredInUnitIds
 
-type WiredPackagesMap = Map UnitId UnitId
+type WiredPackagesMap = Map WiredUnitId WiredUnitId
 
 findWiredInPackages
    :: DynFlags
@@ -918,7 +941,7 @@ findWiredInPackages dflags pkgs vis_map = do
   mb_wired_in_pkgs <- mapM (findWiredInPackage pkgs) wired_in_pkgids
   let
         wired_in_pkgs = catMaybes mb_wired_in_pkgs
-        wired_in_ids = map unitId wired_in_pkgs
+        wired_in_ids = mapMaybe definitePackageConfigId wired_in_pkgs
 
         -- this is old: we used to assume that if there were
         -- multiple versions of wired-in packages installed that
@@ -933,30 +956,38 @@ findWiredInPackages dflags pkgs vis_map = do
                       && package p `notElem` map fst wired_in_ids
         -}
 
-        wiredInMap :: Map UnitId UnitId
+        wiredInMap :: Map WiredUnitId WiredUnitId
         wiredInMap = foldl' add_mapping Map.empty pkgs
           where add_mapping m pkg
-                  | let key = unitId pkg
+                  | Just key <- definitePackageConfigId pkg
                   , key `elem` wired_in_ids
-                  = Map.insert key (stringToUnitId (packageNameString pkg)) m
+                  = Map.insert key (DefUnitId (stringToInstalledUnitId (packageNameString pkg))) m
                   | otherwise = m
 
         updateWiredInDependencies pkgs = map (upd_deps . upd_pkg) pkgs
           where upd_pkg pkg
-                  | unitId pkg `elem` wired_in_ids
+                  | Just def_uid <- definitePackageConfigId pkg
+                  , def_uid `elem` wired_in_ids
                   = pkg {
                       unitId = let PackageName fs = packageName pkg
-                               in fsToUnitId fs
+                               in fsToInstalledUnitId fs
                     }
                   | otherwise
                   = pkg
                 upd_deps pkg = pkg {
-                      depends = map upd_wired_in (depends pkg),
+                      -- temporary harmless DefUnitId invariant violation
+                      depends = map (unDefUnitId . upd_wired_in . DefUnitId) (depends pkg),
                       exposedModules
                         = map (\(k,v) -> (k, fmap upd_wired_in_mod v))
                               (exposedModules pkg)
                     }
-                upd_wired_in_mod (Module uid m) = Module (upd_wired_in uid) m
+                upd_wired_in_mod (Module uid m) = Module (upd_wired_in_uid uid) m
+                upd_wired_in_uid (DefiniteUnitId def_uid) =
+                    DefiniteUnitId (upd_wired_in def_uid)
+                upd_wired_in_uid (IndefiniteUnitId indef_uid) =
+                    IndefiniteUnitId $ newIndefUnitId
+                        (indefUnitIdComponentId indef_uid)
+                        (map (\(x,y) -> (x,upd_wired_in_mod y)) (indefUnitIdInsts indef_uid))
                 upd_wired_in key
                     | Just key' <- Map.lookup key wiredInMap = key'
                     | otherwise = key
@@ -966,9 +997,10 @@ findWiredInPackages dflags pkgs vis_map = do
 
 updateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap
 updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap)
-  where f vm (from, to) = case Map.lookup from vis_map of
+  where f vm (from, to) = case Map.lookup (DefiniteUnitId from) vis_map of
                     Nothing -> vm
-                    Just r -> Map.insert to r (Map.delete from vm)
+                    Just r -> Map.insert (DefiniteUnitId to) r
+                                (Map.delete (DefiniteUnitId from) vm)
 
 
 -- ----------------------------------------------------------------------------
@@ -976,13 +1008,13 @@ updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap
 type IsShadowed = Bool
 data UnusablePackageReason
   = IgnoredWithFlag
-  | MissingDependencies IsShadowed [UnitId]
+  | MissingDependencies IsShadowed [InstalledUnitId]
 instance Outputable UnusablePackageReason where
     ppr IgnoredWithFlag = text "[ignored with flag]"
     ppr (MissingDependencies b uids) =
         brackets (if b then text "shadowed" else empty <+> ppr uids)
 
-type UnusablePackages = Map UnitId
+type UnusablePackages = Map InstalledUnitId
                             (PackageConfig, UnusablePackageReason)
 
 pprReason :: SDoc -> UnusablePackageReason -> SDoc
@@ -1014,7 +1046,7 @@ reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
 --
 findBroken :: IsShadowed
            -> [PackageConfig]
-           -> Map UnitId PackageConfig
+           -> Map InstalledUnitId PackageConfig
            -> UnusablePackages
 findBroken is_shadowed pkgs pkg_map0 = go [] pkg_map0 pkgs
  where
@@ -1031,7 +1063,7 @@ findBroken is_shadowed pkgs pkg_map0 = go [] pkg_map0 pkgs
 
    depsAvailable :: InstalledPackageIndex
                  -> PackageConfig
-                 -> Either PackageConfig (PackageConfig, [UnitId])
+                 -> Either PackageConfig (PackageConfig, [InstalledUnitId])
    depsAvailable pkg_map pkg
         | null dangling = Left pkg
         | otherwise     = Right (pkg, dangling)
@@ -1058,9 +1090,9 @@ ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
 mkPackageState
     :: DynFlags
     -> [(FilePath, [PackageConfig])]     -- initial databases
-    -> [UnitId]              -- preloaded packages
+    -> [PreloadUnitId]              -- preloaded packages
     -> IO (PackageState,
-           [UnitId])         -- new packages to preload
+           [PreloadUnitId])         -- new packages to preload
 
 mkPackageState dflags dbs preload0 = do
   -- Compute the unit id
@@ -1138,7 +1170,7 @@ mkPackageState dflags dbs preload0 = do
                                     `Map.union` unusable)
         where -- The set of UnitIds which appear in both
               -- db and pkgs (to be shadowed from pkgs)
-              shadow_set :: Set UnitId
+              shadow_set :: Set InstalledUnitId
               shadow_set = foldr ins Set.empty db
                 where ins pkg s
                         -- If the package from the upper database is
@@ -1180,7 +1212,7 @@ mkPackageState dflags dbs preload0 = do
 
               -- Now merge the sets together (NB: later overrides
               -- earlier!)
-              pkg_map' :: Map UnitId PackageConfig
+              pkg_map' :: Map InstalledUnitId PackageConfig
               pkg_map' = mk_pkg_map (shadowed_pkgs ++ db3)
 
   (pkg_map1, unusable) <- foldM merge (Map.empty, Map.empty) dbs
@@ -1309,7 +1341,7 @@ mkPackageState dflags dbs preload0 = do
                      $ (basicLinkedPackages ++ preload2)
 
   -- Close the preload packages with their dependencies
-  dep_preload <- closeDeps dflags pkg_db (zip preload3 (repeat Nothing))
+  dep_preload <- closeDeps dflags pkg_db (zip (map toInstalledUnitId preload3) (repeat Nothing))
   let new_dep_preload = filter (`notElem` preload0) dep_preload
 
   let mod_map = mkModuleToPkgConfAll dflags pkg_db vis_map
@@ -1333,8 +1365,9 @@ mkPackageState dflags dbs preload0 = do
 -- | Given a wired-in 'UnitId', "unwire" it into the 'UnitId'
 -- that it was recorded as in the package database.
 unwireUnitId :: DynFlags -> UnitId -> UnitId
-unwireUnitId dflags uid =
-    fromMaybe uid (Map.lookup uid (unwireMap (pkgState dflags)))
+unwireUnitId dflags uid@(DefiniteUnitId def_uid) =
+    maybe uid DefiniteUnitId (Map.lookup def_uid (unwireMap (pkgState dflags)))
+unwireUnitId _ uid = uid
 
 -- -----------------------------------------------------------------------------
 -- | Makes the mapping from module to package info
@@ -1415,7 +1448,7 @@ mkModuleToPkgConfAll dflags pkg_db vis_map =
 -- use.
 
 -- | Find all the include directories in these and the preload packages
-getPackageIncludePath :: DynFlags -> [UnitId] -> IO [String]
+getPackageIncludePath :: DynFlags -> [PreloadUnitId] -> IO [String]
 getPackageIncludePath dflags pkgs =
   collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
 
@@ -1423,7 +1456,7 @@ collectIncludeDirs :: [PackageConfig] -> [FilePath]
 collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))
 
 -- | Find all the library paths in these and the preload packages
-getPackageLibraryPath :: DynFlags -> [UnitId] -> IO [String]
+getPackageLibraryPath :: DynFlags -> [PreloadUnitId] -> IO [String]
 getPackageLibraryPath dflags pkgs =
   collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs
 
@@ -1432,7 +1465,7 @@ collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps))
 
 -- | Find all the link options in these and the preload packages,
 -- returning (package hs lib options, extra library options, other flags)
-getPackageLinkOpts :: DynFlags -> [UnitId] -> IO ([String], [String], [String])
+getPackageLinkOpts :: DynFlags -> [PreloadUnitId] -> IO ([String], [String], [String])
 getPackageLinkOpts dflags pkgs =
   collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
 
@@ -1481,19 +1514,19 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
                     | otherwise = '_':t
 
 -- | Find all the C-compiler options in these and the preload packages
-getPackageExtraCcOpts :: DynFlags -> [UnitId] -> IO [String]
+getPackageExtraCcOpts :: DynFlags -> [PreloadUnitId] -> IO [String]
 getPackageExtraCcOpts dflags pkgs = do
   ps <- getPreloadPackagesAnd dflags pkgs
   return (concatMap ccOptions ps)
 
 -- | Find all the package framework paths in these and the preload packages
-getPackageFrameworkPath  :: DynFlags -> [UnitId] -> IO [String]
+getPackageFrameworkPath  :: DynFlags -> [PreloadUnitId] -> IO [String]
 getPackageFrameworkPath dflags pkgs = do
   ps <- getPreloadPackagesAnd dflags pkgs
   return (nub (filter notNull (concatMap frameworkDirs ps)))
 
 -- | Find all the package frameworks in these and the preload packages
-getPackageFrameworks  :: DynFlags -> [UnitId] -> IO [String]
+getPackageFrameworks  :: DynFlags -> [PreloadUnitId] -> IO [String]
 getPackageFrameworks dflags pkgs = do
   ps <- getPreloadPackagesAnd dflags pkgs
   return (concatMap frameworks ps)
@@ -1616,7 +1649,7 @@ listVisibleModuleNames dflags =
 
 -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
 -- 'PackageConfig's
-getPreloadPackagesAnd :: DynFlags -> [UnitId] -> IO [PackageConfig]
+getPreloadPackagesAnd :: DynFlags -> [PreloadUnitId] -> IO [PackageConfig]
 getPreloadPackagesAnd dflags pkgids =
   let
       state   = pkgState dflags
@@ -1625,14 +1658,14 @@ getPreloadPackagesAnd dflags pkgids =
       pairs = zip pkgids (repeat Nothing)
   in do
   all_pkgs <- throwErr dflags (foldM (add_package dflags pkg_map) preload pairs)
-  return (map (getPackageDetails dflags) all_pkgs)
+  return (map (getInstalledPackageDetails dflags) all_pkgs)
 
 -- Takes a list of packages, and returns the list with dependencies included,
 -- in reverse dependency order (a package appears before those it depends on).
 closeDeps :: DynFlags
           -> PackageConfigMap
-          -> [(UnitId, Maybe UnitId)]
-          -> IO [UnitId]
+          -> [(InstalledUnitId, Maybe InstalledUnitId)]
+          -> IO [InstalledUnitId]
 closeDeps dflags pkg_map ps
     = throwErr dflags (closeDepsErr dflags pkg_map ps)
 
@@ -1644,20 +1677,20 @@ throwErr dflags m
 
 closeDepsErr :: DynFlags
              -> PackageConfigMap
-             -> [(UnitId,Maybe UnitId)]
-             -> MaybeErr MsgDoc [UnitId]
+             -> [(InstalledUnitId,Maybe InstalledUnitId)]
+             -> MaybeErr MsgDoc [InstalledUnitId]
 closeDepsErr dflags pkg_map ps = foldM (add_package dflags pkg_map) [] ps
 
 -- internal helper
 add_package :: DynFlags
             -> PackageConfigMap
-            -> [UnitId]
-            -> (UnitId,Maybe UnitId)
-            -> MaybeErr MsgDoc [UnitId]
+            -> [PreloadUnitId]
+            -> (PreloadUnitId,Maybe PreloadUnitId)
+            -> MaybeErr MsgDoc [PreloadUnitId]
 add_package dflags pkg_db ps (p, mb_parent)
   | p `elem` ps = return ps     -- Check if we've already added this package
   | otherwise =
-      case lookupPackage' (isIndefinite dflags) pkg_db p of
+      case lookupInstalledPackage' pkg_db p of
         Nothing -> Failed (missingPackageMsg p <>
                            missingDependencyMsg mb_parent)
         Just pkg -> do
@@ -1671,19 +1704,19 @@ add_package dflags pkg_db ps (p, mb_parent)
 missingPackageMsg :: Outputable pkgid => pkgid -> SDoc
 missingPackageMsg p = text "unknown package:" <+> ppr p
 
-missingDependencyMsg :: Maybe UnitId -> SDoc
+missingDependencyMsg :: Maybe InstalledUnitId -> SDoc
 missingDependencyMsg Nothing = Outputable.empty
 missingDependencyMsg (Just parent)
-  = space <> parens (text "dependency of" <+> ftext (unitIdFS parent))
+  = space <> parens (text "dependency of" <+> ftext (installedUnitIdFS parent))
 
 -- -----------------------------------------------------------------------------
 
 componentIdString :: DynFlags -> ComponentId -> Maybe String
 componentIdString dflags cid =
-    fmap sourcePackageIdString (lookupComponentId dflags cid)
+    fmap sourcePackageIdString (lookupInstalledPackage dflags (newInstalledUnitId cid Nothing))
 
 -- | Will the 'Name' come from a dynamically linked library?
-isDllName :: DynFlags -> UnitId -> Module -> Name -> Bool
+isDllName :: DynFlags -> UnitId {- not used -} -> Module -> Name -> Bool
 -- Despite the "dll", I think this function just means that
 -- the symbol comes from another dynamically-linked package,
 -- and applies on all platforms, not just Windows
@@ -1732,7 +1765,7 @@ pprPackagesWith pprIPI dflags =
 -- be different from the package databases (exposure, trust)
 pprPackagesSimple :: DynFlags -> SDoc
 pprPackagesSimple = pprPackagesWith pprIPI
-    where pprIPI ipi = let i = unitIdFS (unitId ipi)
+    where pprIPI ipi = let i = installedUnitIdFS (unitId ipi)
                            e = if exposed ipi then text "E" else text " "
                            t = if trusted ipi then text "T" else text " "
                        in e <> t <> text "  " <> ftext i
@@ -1752,13 +1785,20 @@ fsPackageName :: PackageConfig -> FastString
 fsPackageName = mkFastString . packageNameString
 
 -- | Given a fully instantiated 'UnitId', improve it into a
--- 'HashedUnitId' if we can find it in the package database.
+-- 'InstalledUnitId' if we can find it in the package database.
 improveUnitId :: PackageConfigMap -> UnitId -> UnitId
+improveUnitId _ uid@(DefiniteUnitId _) = uid -- short circuit
 improveUnitId pkg_map uid =
     -- Do NOT lookup indefinite ones, they won't be useful!
     case lookupPackage' False pkg_map uid of
         Nothing  -> uid
-        Just pkg -> packageConfigId pkg -- use the hashed version!
+        Just pkg ->
+            -- Do NOT improve if the indefinite unit id is not
+            -- part of the closure unique set.  See
+            -- Note [UnitId to InstalledUnitId improvement]
+            if installedPackageConfigId pkg `elementOfUniqSet` preloadClosure pkg_map
+                then packageConfigId pkg
+                else uid
 
 -- | Retrieve the 'PackageConfigMap' from 'DynFlags'; used
 -- in the @hs-boot@ loop-breaker.
index e40b1d6..e901bde 100644 (file)
@@ -1564,7 +1564,7 @@ linesPlatform xs =
 
 #endif
 
-linkDynLib :: DynFlags -> [String] -> [UnitId] -> IO ()
+linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
 linkDynLib dflags0 o_files dep_packages
  = do
     let -- This is a rather ugly hack to fix dynamically linked
@@ -1741,7 +1741,7 @@ linkDynLib dflags0 o_files dep_packages
                  ++ map Option pkg_link_opts
               )
 
-getPkgFrameworkOpts :: DynFlags -> Platform -> [UnitId] -> IO [String]
+getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
 getPkgFrameworkOpts dflags platform dep_packages
   | platformUsesFrameworks platform = do
     pkg_framework_path_opts <- do
index e1258a3..70c6b5f 100644 (file)
@@ -358,6 +358,7 @@ calculateAvails dflags iface mod_safe' want_boot =
              | otherwise  = dep_finsts deps
 
       pkg = moduleUnitId (mi_module iface)
+      ipkg = toInstalledUnitId pkg
 
       -- Does this import mean we now require our own pkg
       -- to be trusted? See Note [Trust Own Package]
@@ -382,9 +383,9 @@ calculateAvails dflags iface mod_safe' want_boot =
             -- Imported module is from another package
             -- Dump the dependent modules
             -- Add the package imp_mod comes from to the dependent packages
-            ASSERT2( not (pkg `elem` (map fst $ dep_pkgs deps))
-                   , ppr pkg <+> ppr (dep_pkgs deps) )
-            ([], (pkg, False) : dep_pkgs deps, False)
+            ASSERT2( not (ipkg `elem` (map fst $ dep_pkgs deps))
+                   , ppr ipkg <+> ppr (dep_pkgs deps) )
+            ([], (ipkg, False) : dep_pkgs deps, False)
 
   in ImportAvails {
           imp_mods       = emptyModuleEnv, -- this gets filled in later
index be24423..9b4f774 100644 (file)
@@ -223,7 +223,7 @@ findExtraSigImports' hsc_env HsigFile modname =
         (initIfaceLoad hsc_env
             . withException
             $ moduleFreeHolesPrecise (text "findExtraSigImports")
-                (mkModule (AnIndefUnitId iuid) mod_name)))
+                (mkModule (IndefiniteUnitId iuid) mod_name)))
   where
     reqs = requirementMerges (hsc_dflags hsc_env) modname
 
@@ -269,7 +269,7 @@ implicitRequirements' hsc_env normal_imports
 -- not; a component may have been filled with implementations for the holes
 -- that don't actually fulfill the requirements.
 --
--- INVARIANT: the UnitId is NOT a HashedUnitId
+-- INVARIANT: the UnitId is NOT a InstalledUnitId
 checkUnitId :: UnitId -> TcM ()
 checkUnitId uid = do
     case splitUnitIdInsts uid of
@@ -354,9 +354,7 @@ mergeSignatures lcl_iface0 = do
            fmap fst
          . withException
          . flip (findAndReadIface (text "mergeSignatures")) False
-         -- Blegh, temporarily violated invariant that hashed unit
-         -- ids are definite
-         $ mkModule (newSimpleUnitId (indefUnitIdComponentId iuid)) mod_name
+         $ fst (splitModuleInsts (mkModule (IndefiniteUnitId iuid) mod_name))
 
     -- STEP 3: Get the unrenamed exports of all these interfaces, and
     -- dO shaping on them.
@@ -478,8 +476,7 @@ tcRnInstantiateSignature hsc_env this_mod real_loc =
 -- explicitly.)
 checkImplements :: Module -> HoleModule -> TcRn TcGblEnv
 checkImplements impl_mod (uid, mod_name) = do
-    let cid   = indefUnitIdComponentId uid
-        insts = indefUnitIdInsts uid
+    let insts = indefUnitIdInsts uid
 
     -- STEP 1: Load the implementing interface, and make a RdrEnv
     -- for its exports
@@ -493,7 +490,7 @@ checkImplements impl_mod (uid, mod_name) = do
     -- the ORIGINAL signature.  We are going to eventually rename it,
     -- but we must proceed slowly, because it is NOT known if the
     -- instantiation is correct.
-    let isig_mod = mkModule (newSimpleUnitId cid) mod_name
+    let isig_mod = fst (splitModuleInsts (mkModule (IndefiniteUnitId uid) mod_name))
     mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod False
     isig_iface <- case mb_isig_iface of
         Succeeded (iface, _) -> return iface
index ff51891..e24305d 100644 (file)
@@ -2471,7 +2471,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
          , text "Dependent modules:" <+>
                 pprUDFM (imp_dep_mods imports) ppr
          , text "Dependent packages:" <+>
-                ppr (sortBy stableUnitIdCmp $ imp_dep_pkgs imports)]
+                ppr (sortBy compare $ imp_dep_pkgs imports)]
   where         -- The use of sortBy is just to reduce unnecessary
                 -- wobbling in testsuite output
 
index 2a55b69..39707b8 100644 (file)
@@ -1171,12 +1171,12 @@ data ImportAvails
           -- compiling M might not need to consult X.hi, but X
           -- is still listed in M's dependencies.
 
-        imp_dep_pkgs :: [UnitId],
+        imp_dep_pkgs :: [InstalledUnitId],
           -- ^ Packages needed by the module being compiled, whether directly,
           -- or via other modules in this package, or via modules imported
           -- from other packages.
 
-        imp_trust_pkgs :: [UnitId],
+        imp_trust_pkgs :: [InstalledUnitId],
           -- ^ This is strictly a subset of imp_dep_pkgs and records the
           -- packages the current module needs to trust for Safe Haskell
           -- compilation to succeed. A package is required to be trusted if
index e3a56d6..3cc3f5c 100644 (file)
@@ -54,7 +54,8 @@ import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC,
                   setInteractivePrintName, hsc_dflags, msObjFilePath )
 import Module
 import Name
-import Packages ( trusted, getPackageDetails, listVisibleModuleNames, pprFlag )
+import Packages ( trusted, getPackageDetails, getInstalledPackageDetails,
+                  listVisibleModuleNames, pprFlag )
 import PprTyThing
 import PrelNames
 import RdrName ( RdrName, getGRE_NameQualifier_maybes, getRdrName )
@@ -2056,7 +2057,7 @@ isSafeModule m = do
 
     tallyPkgs dflags deps | not (packageTrustOn dflags) = ([], [])
                           | otherwise = partition part deps
-        where part pkg = trusted $ getPackageDetails dflags pkg
+        where part pkg = trusted $ getInstalledPackageDetails dflags pkg
 
 -----------------------------------------------------------------------------
 -- :browse
index 9fda919..f8049d6 100644 (file)
@@ -60,7 +60,7 @@ import MonadUtils       ( liftIO )
 -- Imports for --abi-hash
 import LoadIface           ( loadUserInterface )
 import Module              ( mkModuleName )
-import Finder              ( findImportedModule, cannotFindInterface )
+import Finder              ( findImportedModule, cannotFindModule )
 import TcRnMonad           ( initIfaceCheck )
 import Binary              ( openBinMem, put_, fingerprintBinMem )
 
@@ -890,7 +890,7 @@ abiHash strs = do
          case r of
            Found _ m -> return m
            _error    -> throwGhcException $ CmdLineError $ showSDoc dflags $
-                          cannotFindInterface dflags modname r
+                          cannotFindModule dflags modname r
 
   mods <- mapM find_it strs
 
index 2e51af0..eda1a69 100644 (file)
@@ -92,6 +92,7 @@ data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulenam
        haddockHTMLs       :: [FilePath],
        exposedModules     :: [(modulename, Maybe mod)],
        hiddenModules      :: [modulename],
+       indefinite         :: Bool,
        exposed            :: Bool,
        trusted            :: Bool
      }
@@ -139,7 +140,7 @@ data DbUnitId compid unitid modulename mod
        dbUnitIdComponentId :: compid,
        dbUnitIdInsts :: [(modulename, mod)]
      }
-   | DbHashedUnitId {
+   | DbInstalledUnitId {
        dbUnitIdComponentId :: compid,
        dbUnitIdHash :: Maybe BS.ByteString
      }
@@ -175,6 +176,7 @@ emptyInstalledPackageInfo =
        haddockHTMLs       = [],
        exposedModules     = [],
        hiddenModules      = [],
+       indefinite         = False,
        exposed            = False,
        trusted            = False
   }
@@ -313,7 +315,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
          includes includeDirs
          haddockInterfaces haddockHTMLs
          exposedModules hiddenModules
-         exposed trusted) = do
+         indefinite exposed trusted) = do
     put (toStringRep sourcePackageId)
     put (toStringRep packageName)
     put packageVersion
@@ -338,6 +340,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
     put (map (\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))
              exposedModules)
     put (map toStringRep hiddenModules)
+    put indefinite
     put exposed
     put trusted
 
@@ -364,6 +367,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
     haddockHTMLs       <- get
     exposedModules     <- get
     hiddenModules      <- get
+    indefinite         <- get
     exposed            <- get
     trusted            <- get
     return (InstalledPackageInfo
@@ -384,7 +388,7 @@ instance (RepInstalledPackageInfo a b c d e f g) =>
                         (fromStringRep mod_name, fmap fromDbModule mb_mod))
                    exposedModules)
               (map fromStringRep hiddenModules)
-              exposed trusted)
+              indefinite exposed trusted)
 
 instance (BinaryStringRep modulename, BinaryStringRep compid,
           DbUnitIdModuleRep compid unitid modulename mod) =>
@@ -409,7 +413,7 @@ instance (BinaryStringRep modulename, BinaryStringRep compid,
 instance (BinaryStringRep modulename, BinaryStringRep compid,
           DbUnitIdModuleRep compid unitid modulename mod) =>
          Binary (DbUnitId compid unitid modulename mod) where
-  put (DbHashedUnitId cid hash) = do
+  put (DbInstalledUnitId cid hash) = do
     putWord8 0
     put (toStringRep cid)
     put hash
@@ -423,7 +427,7 @@ instance (BinaryStringRep modulename, BinaryStringRep compid,
       0 -> do
         cid <- get
         hash <- get
-        return (DbHashedUnitId (fromStringRep cid) hash)
+        return (DbInstalledUnitId (fromStringRep cid) hash)
       _ -> do
         dbUnitIdComponentId <- get
         dbUnitIdInsts <- get
diff --git a/testsuite/tests/backpack/cabal/bkpcabal01/.gitignore b/testsuite/tests/backpack/cabal/bkpcabal01/.gitignore
new file mode 100644 (file)
index 0000000..1c08f2f
--- /dev/null
@@ -0,0 +1,2 @@
+p/P.hs
+q/Q.hs
index b38f3a5..eb51115 100644 (file)
@@ -1,5 +1,5 @@
 
 T.hs:3:1: error:
-    Ambiguous interface for ‘Conflict’:
+    Ambiguous module name ‘Conflict’:
       it is bound as p-0.1.0.0:P2 by a reexport in package p-0.1.0.0
       it is bound as P by a reexport in package p-0.1.0.0
index d7b35b7..7077b35 100644 (file)
@@ -16,6 +16,7 @@ description:
 category: none
 author: simonmar@microsoft.com
 exposed: True
+indefinite: False
 exposed-modules:
     A
 hidden-modules: B C.D
@@ -42,6 +43,7 @@ description:
 category: none
 author: simonmar@microsoft.com
 exposed: True
+indefinite: False
 exposed-modules:
     A
 hidden-modules: B C.D
@@ -74,6 +76,7 @@ description:
 category: none
 author: simonmar@microsoft.com
 exposed: False
+indefinite: False
 exposed-modules:
     A
 hidden-modules: B C.D C.E
@@ -100,6 +103,7 @@ description:
 category: none
 author: simonmar@microsoft.com
 exposed: False
+indefinite: False
 exposed-modules:
     A
 hidden-modules: B C.D C.E
@@ -126,6 +130,7 @@ description:
 category: none
 author: simonmar@microsoft.com
 exposed: True
+indefinite: False
 exposed-modules:
     A
 hidden-modules: B C.D
@@ -159,6 +164,7 @@ description:
 category: none
 author: simonmar@microsoft.com
 exposed: False
+indefinite: False
 exposed-modules:
     A
 hidden-modules: B C.D
index b601f3e..5cc97f5 100644 (file)
@@ -1,4 +1,4 @@
 
 ghcpkg04.hs:1:1: error:
-    Ambiguous interface for ‘A’:
-      it was found in multiple packages: testpkg-1.2.3.4 newtestpkg-2.0
+    Ambiguous module name ‘A’:
+      it was found in multiple packages: newtestpkg-2.0 testpkg-1.2.3.4
index 84ff5b6..307467b 100644 (file)
@@ -1,4 +1,4 @@
 
 D063.hs:2:1: error:
-    Failed to load interface for ‘A063’
+    Could not find module ‘A063’
     It is not a module in the current program, or in any known package.
index 1a79127..bf73e40 100644 (file)
@@ -1,4 +1,4 @@
 
 T2636.hs:1:1: error:
-    Failed to load interface for ‘MissingModule’
+    Could not find module ‘MissingModule’
     Use -v to see a list of the files searched for.
index ecc1475..50554ae 100644 (file)
@@ -1,4 +1,4 @@
 
-mod1.hs:3:1:
-    Failed to load interface for ‘N’
+mod1.hs:3:1: error:
+    Could not find module ‘N’
     Use -v to see a list of the files searched for.
index 3252289..a070917 100644 (file)
@@ -1,4 +1,4 @@
 
-mod2.hs:3:1:
-    Failed to load interface for ‘N’
+mod2.hs:3:1: error:
+    Could not find module ‘N’
     Use -v to see a list of the files searched for.
index ea5f2f6..f34ee1d 100644 (file)
@@ -1,10 +1,10 @@
 
 package01e.hs:2:1: error:
-    Failed to load interface for ‘Data.Map’
+    Could not find module ‘Data.Map’
     It is a member of the hidden package ‘containers-0.5.7.1’.
     Use -v to see a list of the files searched for.
 
 package01e.hs:3:1: error:
-    Failed to load interface for ‘Data.IntMap’
+    Could not find module ‘Data.IntMap’
     It is a member of the hidden package ‘containers-0.5.7.1’.
     Use -v to see a list of the files searched for.
index 1cb27e3..c634d2d 100644 (file)
@@ -1,10 +1,10 @@
 
-package06e.hs:2:1:
-    Failed to load interface for ‘HsTypes’
-    It is a member of the hidden package ‘ghc-<VERSION>’.
+package06e.hs:2:1: error:
+    Could not find module ‘HsTypes’
+    It is a member of the hidden package ‘ghc-8.1’.
     Use -v to see a list of the files searched for.
 
-package06e.hs:3:1:
-    Failed to load interface for ‘UniqFM’
-    It is a member of the hidden package ‘ghc-<VERSION>’.
+package06e.hs:3:1: error:
+    Could not find module ‘UniqFM’
+    It is a member of the hidden package ‘ghc-8.1’.
     Use -v to see a list of the files searched for.
index 8de07f9..a446a47 100644 (file)
@@ -1,16 +1,16 @@
 
 package07e.hs:2:1: error:
-    Failed to load interface for ‘MyHsTypes’
+    Could not find module ‘MyHsTypes’
     Use -v to see a list of the files searched for.
 
 package07e.hs:3:1: error:
-    Failed to load interface for ‘HsTypes’
+    Could not find module ‘HsTypes’
     Use -v to see a list of the files searched for.
 
 package07e.hs:4:1: error:
-    Failed to load interface for ‘HsUtils’
+    Could not find module ‘HsUtils’
     Use -v to see a list of the files searched for.
 
 package07e.hs:5:1: error:
-    Failed to load interface for ‘UniqFM’
+    Could not find module ‘UniqFM’
     Use -v to see a list of the files searched for.
index c501735..3d8d232 100644 (file)
@@ -1,16 +1,16 @@
 
 package08e.hs:2:1: error:
-    Failed to load interface for ‘MyHsTypes’
+    Could not find module ‘MyHsTypes’
     Use -v to see a list of the files searched for.
 
 package08e.hs:3:1: error:
-    Failed to load interface for ‘HsTypes’
+    Could not find module ‘HsTypes’
     Use -v to see a list of the files searched for.
 
 package08e.hs:4:1: error:
-    Failed to load interface for ‘HsUtils’
+    Could not find module ‘HsUtils’
     Use -v to see a list of the files searched for.
 
 package08e.hs:5:1: error:
-    Failed to load interface for ‘UniqFM’
+    Could not find module ‘UniqFM’
     Use -v to see a list of the files searched for.
index 9cd00a2..3ce28df 100644 (file)
@@ -1,5 +1,5 @@
 
-package09e.hs:2:1:
-    Ambiguous interface for ‘M’:
+package09e.hs:2:1: error:
+    Ambiguous module name ‘M’:
       it is bound as Data.Set by a package flag
       it is bound as Data.Map by a package flag
index 0f86f7f..d24d775 100644 (file)
@@ -1,4 +1,4 @@
 
-parsing001.hs:3:1:
-    Failed to load interface for ‘Wibble’
+parsing001.hs:3:1: error:
+    Could not find module ‘Wibble’
     Use -v to see a list of the files searched for.
index 276c723..d32906e 100644 (file)
@@ -1,7 +1,7 @@
 
-SafeLang07.hs:2:14: Warning:
+SafeLang07.hs:2:14: warning:
     -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving
 
-SafeLang07.hs:15:1:
-    Failed to load interface for ‘SafeLang07_A’
+SafeLang07.hs:15:1: error:
+    Could not find module ‘SafeLang07_A’
     Use -v to see a list of the files searched for.
index 21688ae..0d23a80 100644 (file)
@@ -1,8 +1,8 @@
 
 T10279.hs:10:10: error:
-    Failed to load interface for ‘A’
-    no unit id matching ‘rts-1.0’ was found
-    (This unit ID looks like the source package ID;
-     the real unit ID is ‘rts’)
-    In the expression: (rts-1.0:A.Foo)
-    In an equation for ‘blah’: blah = (rts-1.0:A.Foo)
+    • Failed to load interface for ‘A’
+      no unit id matching ‘rts-1.0’ was found
+      (This unit ID looks like the source package ID;
+       the real unit ID is ‘rts’)
+    • In the expression: (rts-1.0:A.Foo)
+      In an equation for ‘blah’: blah = (rts-1.0:A.Foo)
index 4e3d6ce..841b5c8 100644 (file)
@@ -1,12 +1,12 @@
 
-tcfail082.hs:2:1:
-    Failed to load interface for ‘Data82’
+tcfail082.hs:2:1: error:
+    Could not find module ‘Data82’
     Use -v to see a list of the files searched for.
 
-tcfail082.hs:3:1:
-    Failed to load interface for ‘Inst82_1’
+tcfail082.hs:3:1: error:
+    Could not find module ‘Inst82_1’
     Use -v to see a list of the files searched for.
 
-tcfail082.hs:4:1:
-    Failed to load interface for ‘Inst82_2’
+tcfail082.hs:4:1: error:
+    Could not find module ‘Inst82_2’
     Use -v to see a list of the files searched for.
index 4a72ba7..c047442 100644 (file)
@@ -1119,6 +1119,7 @@ convertPackageInfoToCacheFormat pkg =
        GhcPkg.haddockHTMLs       = haddockHTMLs pkg,
        GhcPkg.exposedModules     = map convertExposed (exposedModules pkg),
        GhcPkg.hiddenModules      = hiddenModules pkg,
+       GhcPkg.indefinite         = indefinite pkg,
        GhcPkg.exposed            = exposed pkg,
        GhcPkg.trusted            = trusted pkg
     }
@@ -1156,9 +1157,12 @@ instance GhcPkg.DbUnitIdModuleRep ComponentId OpenUnitId ModuleName OpenModule w
   toDbModule (OpenModule uid mod_name) = GhcPkg.DbModule uid mod_name
   toDbModule (OpenModuleVar mod_name) = GhcPkg.DbModuleVar mod_name
   fromDbUnitId (GhcPkg.DbUnitId cid insts) = IndefFullUnitId cid (Map.fromList insts)
-  fromDbUnitId (GhcPkg.DbHashedUnitId cid bs) = DefiniteUnitId (DefUnitId (UnitId cid (fmap fromStringRep bs)))
+  fromDbUnitId (GhcPkg.DbInstalledUnitId cid bs)
+    = DefiniteUnitId (unsafeMkDefUnitId (UnitId cid (fmap fromStringRep bs)))
   toDbUnitId (IndefFullUnitId cid insts) = GhcPkg.DbUnitId cid (Map.toList insts)
-  toDbUnitId (DefiniteUnitId (DefUnitId (UnitId cid mb_hash))) = GhcPkg.DbHashedUnitId cid (fmap toStringRep mb_hash)
+  toDbUnitId (DefiniteUnitId def_uid)
+    | UnitId cid mb_hash <- unDefUnitId def_uid
+    = GhcPkg.DbInstalledUnitId cid (fmap toStringRep mb_hash)
 
 -- -----------------------------------------------------------------------------
 -- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar
@@ -1809,8 +1813,9 @@ checkModule :: String
             -> Validate ()
 checkModule _ _ _ (OpenModuleVar _) = error "Impermissible reexport"
 checkModule field_name db_stack pkg
-    (OpenModule (DefiniteUnitId (DefUnitId definingPkgId)) definingModule) =
-  let mpkg = if definingPkgId == installedUnitId pkg
+    (OpenModule (DefiniteUnitId def_uid) definingModule) =
+  let definingPkgId = unDefUnitId def_uid
+      mpkg = if definingPkgId == installedUnitId pkg
               then Just pkg
               else PackageIndex.lookupUnitId ipix definingPkgId
   in case mpkg of