Delete ShPackageKey for now.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Sat, 10 Oct 2015 19:00:55 +0000 (12:00 -0700)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Sat, 10 Oct 2015 19:01:03 +0000 (12:01 -0700)
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
compiler/backpack/ShPackageKey.hs [deleted file]
compiler/ghc.cabal.in
compiler/main/DynFlags.hs
compiler/main/PackageConfig.hs

diff --git a/compiler/backpack/ShPackageKey.hs b/compiler/backpack/ShPackageKey.hs
deleted file mode 100644 (file)
index f0d7c65..0000000
+++ /dev/null
@@ -1,241 +0,0 @@
-{-# LANGUAGE CPP #-}
-module ShPackageKey(
-    ShFreeHoles,
-    calcModuleFreeHoles,
-
-    newPackageKey,
-    newPackageKeyWithScope,
-    lookupPackageKey,
-
-    generalizeHoleModule,
-    canonicalizeModule,
-
-    pprPackageKey
-) where
-
-#include "HsVersions.h"
-
-import Module
-import Packages
-import Encoding
-import FastString
-import UniqFM
-import UniqSet
-import Outputable
-import Util
-import DynFlags
-
-import System.IO.Unsafe ( unsafePerformIO )
-import Control.Monad
-import Data.IORef
-import GHC.Fingerprint
-import Data.List
-import Data.Function
-
--- NB: didn't put this in Module, that seems a bit too low in the
--- hierarchy, need to refer to DynFlags
-
-{-
-************************************************************************
-*                                                                      *
-                        Package Keys
-*                                                                      *
-************************************************************************
--}
-
--- Note: [PackageKey cache]
--- ~~~~~~~~~~~~~~~~~~~~~~~~
--- The built-in PackageKey type (used by Module, Name, etc)
--- records the instantiation of the package as an MD5 hash
--- which is not reversible without some extra information.
--- However, the shape merging process requires us to be able
--- to substitute Module occurrences /inside/ the package key.
---
--- Thus, we maintain the invariant: for every PackageKey
--- in our system, either:
---
---      1. It is in the installed package database (lookupPackage)
---         so we can lookup the recorded instantiatedWith
---      2. We've recorded the associated mapping in the
---         PackageKeyCache.
---
--- A PackageKey can be expanded into a ShPackageKey which has
--- the instance mapping.  In the mapping, we don't bother
--- expanding a 'Module'; depending on 'shPackageKeyFreeHoles',
--- it may not be necessary to do a substitution (you only
--- need to drill down when substituing HOLE:H if H is in scope.
-
--- Note: [Module name in scope set]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Similar to InScopeSet, ShFreeHoles is an optimization that
--- allows us to avoid expanding a PackageKey into an ShPackageKey
--- if there isn't actually anything in the module expression that
--- we can substitute.
-
--- | Given a Name or Module, the 'ShFreeHoles' contains the set
--- of free variables, i.e. HOLE:A modules, which may be substituted.
--- If this set is empty no substitutions are possible.
-type ShFreeHoles = UniqSet ModuleName
-
--- | Calculate the free holes of a 'Module'.
-calcModuleFreeHoles :: DynFlags -> Module -> IO ShFreeHoles
-calcModuleFreeHoles dflags m
-    | modulePackageKey m == holePackageKey = return (unitUniqSet (moduleName m))
-    | otherwise = do
-        shpk <- lookupPackageKey dflags (modulePackageKey m)
-        return $ case shpk of
-            ShDefinitePackageKey{} -> emptyUniqSet
-            ShPackageKey{ shPackageKeyFreeHoles = in_scope } -> in_scope
-
--- | Calculate the free holes of the hole map @[('ModuleName', 'Module')]@.
-calcInstsFreeHoles :: DynFlags -> [(ModuleName, Module)] -> IO ShFreeHoles
-calcInstsFreeHoles dflags insts =
-    fmap unionManyUniqSets (mapM (calcModuleFreeHoles dflags . snd) insts)
-
--- | Given a 'UnitName', a 'LibraryName', and sorted mapping of holes to
--- their implementations, compute the 'PackageKey' associated with it, as well
--- as the recursively computed 'ShFreeHoles' of holes that may be substituted.
-newPackageKeyWithScope :: DynFlags
-                       -> UnitName
-                       -> LibraryName
-                       -> [(ModuleName, Module)]
-                       -> IO (PackageKey, ShFreeHoles)
-newPackageKeyWithScope dflags pn vh insts = do
-    fhs <- calcInstsFreeHoles dflags insts
-    pk <- newPackageKey' dflags (ShPackageKey pn vh insts fhs)
-    return (pk, fhs)
-
--- | Given a 'UnitName' and sorted mapping of holes to
--- their implementations, compute the 'PackageKey' associated with it.
--- (Analogous to 'newGlobalBinder').
-newPackageKey :: DynFlags
-              -> UnitName
-              -> LibraryName
-              -> [(ModuleName, Module)]
-              -> IO PackageKey
-newPackageKey dflags pn vh insts = do
-    (pk, _) <- newPackageKeyWithScope dflags pn vh insts
-    return pk
-
--- | Given a 'ShPackageKey', compute the 'PackageKey' associated with it.
--- This function doesn't calculate the 'ShFreeHoles', because it is
--- provided with 'ShPackageKey'.
-newPackageKey' :: DynFlags -> ShPackageKey -> IO PackageKey
-newPackageKey' _ (ShDefinitePackageKey pk) = return pk
-newPackageKey' dflags
-               shpk@(ShPackageKey pn vh insts fhs) = do
-    ASSERTM( fmap (==fhs) (calcInstsFreeHoles dflags insts) )
-    let pk = mkPackageKey pn vh insts
-        pkt_var = pkgKeyCache dflags
-    pk_cache <- readIORef pkt_var
-    let consistent pk_cache = maybe True (==shpk) (lookupUFM pk_cache pk)
-    MASSERT( consistent pk_cache )
-    when (not (elemUFM pk pk_cache)) $
-        atomicModifyIORef' pkt_var (\pk_cache ->
-            -- Could race, but it's guaranteed to be the same
-            ASSERT( consistent pk_cache ) (addToUFM pk_cache pk shpk, ()))
-    return pk
-
--- | Given a 'PackageKey', reverse lookup the 'ShPackageKey' associated
--- with it.  This only gives useful information for keys which are
--- created using 'newPackageKey' or the associated functions, or that are
--- already in the installed package database, since we generally cannot reverse
--- MD5 hashes.
-lookupPackageKey :: DynFlags
-                 -> PackageKey
-                 -> IO ShPackageKey
-lookupPackageKey dflags pk
-  | pk `elem` wiredInPackageKeys
-     || pk == mainPackageKey
-     || pk == holePackageKey
-  = return (ShDefinitePackageKey pk)
-  | otherwise = do
-    let pkt_var = pkgKeyCache dflags
-    pk_cache <- readIORef pkt_var
-    case lookupUFM pk_cache pk of
-        Just r -> return r
-        _ -> return (ShDefinitePackageKey pk)
-
-pprPackageKey :: PackageKey -> SDoc
-pprPackageKey pk = sdocWithDynFlags $ \dflags ->
-    -- name cache is a memotable
-    let shpk = unsafePerformIO (lookupPackageKey dflags pk)
-    in case shpk of
-        shpk@ShPackageKey{} ->
-            ppr (shPackageKeyUnitName shpk) <>
-                parens (hsep
-                    (punctuate comma [ ppUnless (moduleName m == modname)
-                                                (ppr modname <+> text "->")
-                                       <+> ppr m
-                                     | (modname, m) <- shPackageKeyInsts shpk]))
-            <> ifPprDebug (braces (ftext (packageKeyFS pk)))
-        ShDefinitePackageKey pk -> ftext (packageKeyFS pk)
-
--- NB: newPackageKey and lookupPackageKey are mutually recursive; this
--- recursion is guaranteed to bottom out because you can't set up cycles
--- of PackageKeys.
-
-
-{-
-************************************************************************
-*                                                                      *
-                        Package key hashing
-*                                                                      *
-************************************************************************
--}
-
--- | Generates a 'PackageKey'.  Don't call this directly; you probably
--- want to cache the result.
-mkPackageKey :: UnitName
-             -> LibraryName
-             -> [(ModuleName, Module)] -- hole instantiations
-             -> PackageKey
-mkPackageKey (UnitName fsUnitName)
-             (LibraryName fsLibraryName) unsorted_holes =
-    -- NB: don't use concatFS here, it's not much of an improvement
-    fingerprintPackageKey . fingerprintString $
-        unpackFS fsUnitName ++ "\n" ++
-        unpackFS fsLibraryName ++ "\n" ++
-        concat [ moduleNameString m
-                ++ " " ++ packageKeyString (modulePackageKey b)
-                ++ ":" ++ moduleNameString (moduleName b) ++ "\n"
-               | (m, b) <- sortBy (stableModuleNameCmp `on` fst) unsorted_holes]
-
--- | Generalize a 'Module' into one where all the holes are indefinite.
--- @p(A -> ...):C@ generalizes to @p(A -> HOLE:A):C@.  Useful when
--- you need to figure out if you've already type-checked the generalized
--- version of this module, so you don't have to do the whole rigamarole.
-generalizeHoleModule :: DynFlags -> Module -> IO Module
-generalizeHoleModule dflags m = do
-    pk <- generalizeHolePackageKey dflags (modulePackageKey m)
-    return (mkModule pk (moduleName m))
-
--- | Generalize a 'PackageKey' into one where all the holes are indefinite.
--- @p(A -> q():A) generalizes to p(A -> HOLE:A)@.
-generalizeHolePackageKey :: DynFlags -> PackageKey -> IO PackageKey
-generalizeHolePackageKey dflags pk = do
-    shpk <- lookupPackageKey dflags pk
-    case shpk of
-        ShDefinitePackageKey _ -> return pk
-        ShPackageKey { shPackageKeyUnitName = pn,
-                       shPackageKeyLibraryName = vh,
-                       shPackageKeyInsts = insts0 }
-          -> let insts = map (\(x, _) -> (x, mkModule holePackageKey x)) insts0
-             in newPackageKey dflags pn vh insts
-
--- | Canonicalize a 'Module' so that it uniquely identifies a module.
--- For example, @p(A -> M):A@ canonicalizes to @M@.  Useful for making
--- sure the interface you've loaded as the right @mi_module@.
-canonicalizeModule :: DynFlags -> Module -> IO Module
-canonicalizeModule dflags m = do
-    let pk = modulePackageKey m
-    shpk <- lookupPackageKey dflags pk
-    return $ case shpk of
-        ShPackageKey { shPackageKeyInsts = insts }
-            | Just m' <- lookup (moduleName m) insts -> m'
-        _ -> m
-
-fingerprintPackageKey :: Fingerprint -> PackageKey
-fingerprintPackageKey (Fingerprint a b)
-    = stringToPackageKey (toBase62Padded a ++ toBase62Padded b)
-      -- See Note [Base 62 encoding 128-bit integers]
index 16918d6..37a4f28 100644 (file)
@@ -497,7 +497,6 @@ Library
         Vectorise
         Hoopl.Dataflow
         Hoopl
-        ShPackageKey
 --        CgInfoTbls used in ghci/DebuggerUtils
 --        CgHeapery  mkVirtHeapOffsets used in ghci
 
index 4d5d727..0bb816c 100644 (file)
@@ -100,10 +100,6 @@ module DynFlags (
         parseDynamicFilePragma,
         parseDynamicFlagsFull,
 
-        -- ** Package key cache
-        PackageKeyCache,
-        ShPackageKey(..),
-
         -- ** Available DynFlags
         allFlags,
         flagsAll,
@@ -181,8 +177,6 @@ import Foreign.C        ( CInt(..) )
 import System.IO.Unsafe ( unsafeDupablePerformIO )
 #endif
 import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
-import UniqFM
-import UniqSet
 
 import System.IO.Unsafe ( unsafePerformIO )
 import Data.IORef
@@ -666,29 +660,6 @@ type SigOf = Map ModuleName Module
 getSigOf :: DynFlags -> ModuleName -> Maybe Module
 getSigOf dflags n = Map.lookup n (sigOf dflags)
 
--- NameCache updNameCache
-type PackageKeyEnv = UniqFM
-type PackageKeyCache = PackageKeyEnv ShPackageKey
-
--- | An elaborated representation of a 'PackageKey', which records
--- all of the components that go into the hashed 'PackageKey'.
-data ShPackageKey
-    = ShPackageKey {
-          shPackageKeyUnitName          :: !UnitName,
-          shPackageKeyLibraryName       :: !LibraryName,
-          shPackageKeyInsts             :: ![(ModuleName, Module)],
-          shPackageKeyFreeHoles         :: UniqSet ModuleName
-      }
-    | ShDefinitePackageKey {
-          shPackageKey :: !PackageKey
-      }
-    deriving Eq
-
-instance Outputable ShPackageKey where
-    ppr (ShPackageKey pn vh insts fh)
-        = ppr pn <+> ppr vh <+> ppr insts <+> parens (ppr fh)
-    ppr (ShDefinitePackageKey pk) = ppr pk
-
 -- | Contains not only a collection of 'GeneralFlag's but also a plethora of
 -- information relating to the compilation of a single file or GHC session
 data DynFlags = DynFlags {
@@ -734,9 +705,6 @@ data DynFlags = DynFlags {
                                          --   Typically only 1 is needed
 
   thisPackage           :: PackageKey,   -- ^ key of package currently being compiled
-  thisLibraryName       :: LibraryName,
-                            -- ^ the version hash which identifies the textual
-                            --   package being compiled.
 
   -- ways
   ways                  :: [Way],       -- ^ Way flags from the command line
@@ -823,7 +791,6 @@ data DynFlags = DynFlags {
   -- Packages.initPackages
   pkgDatabase           :: Maybe [PackageConfig],
   pkgState              :: PackageState,
-  pkgKeyCache           :: {-# UNPACK #-} !(IORef PackageKeyCache),
 
   -- Temporary files
   -- These have to be IORefs, because the defaultCleanupHandler needs to
@@ -1473,7 +1440,6 @@ defaultDynFlags mySettings =
         solverIterations        = treatZeroAsInf mAX_SOLVER_ITERATIONS,
 
         thisPackage             = mainPackageKey,
-        thisLibraryName         = LibraryName nilFS,
 
         objectDir               = Nothing,
         dylibInstallName        = Nothing,
@@ -1519,7 +1485,6 @@ defaultDynFlags mySettings =
         pkgDatabase             = Nothing,
         -- This gets filled in with GHC.setSessionDynFlags
         pkgState                = emptyPackageState,
-        pkgKeyCache             = v_unsafePkgKeyCache,
         ways                    = defaultWays mySettings,
         buildTag                = mkBuildTag (defaultWays mySettings),
         rtsBuildTag             = mkBuildTag (defaultWays mySettings),
@@ -2768,7 +2733,6 @@ package_flags = [
                                       upd (setPackageKey name)
                                       deprecate "Use -this-package-key instead")
   , defGhcFlag "this-package-key"   (hasArg setPackageKey)
-  , defGhcFlag "library-name"       (hasArg setLibraryName)
   , defFlag "package-id"            (HasArg exposePackageId)
   , defFlag "package"               (HasArg exposePackage)
   , defFlag "package-key"           (HasArg exposePackageKey)
@@ -3773,9 +3737,6 @@ exposePackage' p dflags
 setPackageKey :: String -> DynFlags -> DynFlags
 setPackageKey p s =  s{ thisPackage = stringToPackageKey p }
 
-setLibraryName :: String -> DynFlags -> DynFlags
-setLibraryName v s = s{ thisLibraryName = LibraryName (mkFastString v) }
-
 -- -----------------------------------------------------------------------------
 -- | Find the package environment (if one exists)
 --
@@ -4266,8 +4227,6 @@ unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
 setUnsafeGlobalDynFlags :: DynFlags -> IO ()
 setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
 
-GLOBAL_VAR(v_unsafePkgKeyCache, emptyUFM, PackageKeyCache)
-
 -- -----------------------------------------------------------------------------
 -- SSE and AVX
 
index 71a84d8..f3cdac7 100644 (file)
@@ -12,18 +12,13 @@ module PackageConfig (
         -- * PackageKey
         packageConfigId,
 
-        -- * LibraryName
-        LibraryName(..),
-
         -- * The PackageConfig type: information about a package
         PackageConfig,
         InstalledPackageInfo(..),
         InstalledPackageId(..),
         SourcePackageId(..),
         PackageName(..),
-        UnitName(..),
         Version(..),
-        packageUnitName,
         defaultPackageConfig,
         installedPackageIdString,
         sourcePackageIdString,
@@ -59,8 +54,6 @@ type PackageConfig = InstalledPackageInfo
 newtype InstalledPackageId = InstalledPackageId FastString deriving (Eq, Ord)
 newtype SourcePackageId    = SourcePackageId    FastString deriving (Eq, Ord)
 newtype PackageName        = PackageName        FastString deriving (Eq, Ord)
-newtype UnitName           = UnitName           FastString deriving (Eq, Ord)
-newtype LibraryName        = LibraryName        FastString deriving (Eq, Ord)
 
 instance BinaryStringRep InstalledPackageId where
   fromStringRep = InstalledPackageId . mkFastStringByteString
@@ -74,10 +67,6 @@ instance BinaryStringRep PackageName where
   fromStringRep = PackageName . mkFastStringByteString
   toStringRep (PackageName s) = fastStringToByteString s
 
-instance BinaryStringRep LibraryName where
-  fromStringRep = LibraryName . mkFastStringByteString
-  toStringRep (LibraryName s) = fastStringToByteString s
-
 instance Uniquable InstalledPackageId where
   getUnique (InstalledPackageId n) = getUnique n
 
@@ -90,12 +79,6 @@ instance Uniquable PackageName where
 instance Outputable InstalledPackageId where
   ppr (InstalledPackageId str) = ftext str
 
-instance Outputable UnitName where
-  ppr (UnitName str) = ftext str
-
-instance Outputable LibraryName where
-  ppr (LibraryName str) = ftext str
-
 instance Outputable SourcePackageId where
   ppr (SourcePackageId str) = ftext str
 
@@ -188,7 +171,3 @@ pprPackageConfig InstalledPackageInfo {..} =
 -- | Get the GHC 'PackageKey' right out of a Cabalish 'PackageConfig'
 packageConfigId :: PackageConfig -> PackageKey
 packageConfigId = packageKey
-
-packageUnitName :: PackageConfig -> UnitName
-packageUnitName pkg = let PackageName fs = packageName pkg
-                      in UnitName fs