ghc-boot 8.0.2 → 8.2.1

raw patch · 6 files changed

+299/−96 lines, 6 filesdep ~basedep ~ghc-boot-thPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, ghc-boot-th

API changes (from Hackage documentation)

Files

• GHC/ForeignSrcLang.hs +12/−0
• GHC/LanguageExtensions/Type.hs +0/−5
• GHC/PackageDb.hs +272/−77
• GHC/Serialized.hs +10/−1
• changelog.md +0/−4
• ghc-boot.cabal +5/−9

@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | See @GHC.LanguageExtensions@ for an explanation+-- on why this is needed+module GHC.ForeignSrcLang+  ( module GHC.ForeignSrcLang.Type+  ) where++import Data.Binary+import GHC.ForeignSrcLang.Type++instance Binary ForeignSrcLang

@@ -1,5 +0,0 @@-{-# LANGUAGE PackageImports #-}--module GHC.LanguageExtensions.Type ( module X ) where--import "ghc-boot-th" GHC.LanguageExtensions.Type as X

@@ -1,4 +1,16 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} ----------------------------------------------------------------------------- -- |@@ -36,10 +48,17 @@ -- module GHC.PackageDb (        InstalledPackageInfo(..),-       ExposedModule(..),-       OriginalModule(..),+       DbModule(..),+       DbUnitId(..),        BinaryStringRep(..),+       DbUnitIdModuleRep(..),        emptyInstalledPackageInfo,+       PackageDbLock,+       lockPackageDb,+       unlockPackageDb,+       DbMode(..),+       DbOpenMode(..),+       isDbOpenReadMode,        readPackageDbForGhc,        readPackageDbForGhcPkg,        writePackageDb@@ -50,6 +69,8 @@ import qualified Data.ByteString.Char8 as BS.Char8 import qualified Data.ByteString.Lazy as BS.Lazy import qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)+import qualified Data.Foldable as F+import qualified Data.Traversable as F import Data.Binary as Bin import Data.Binary.Put as Bin import Data.Binary.Get as Bin@@ -59,20 +80,30 @@ import System.IO import System.IO.Error import GHC.IO.Exception (IOErrorType(InappropriateType))+#if MIN_VERSION_base(4,10,0)+import GHC.IO.Handle.Lock+#endif import System.Directory   -- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits--- that GHC is interested in.+-- that GHC is interested in.  See Cabal's documentation for a more detailed+-- description of all of the fields. ---data InstalledPackageInfo srcpkgid srcpkgname unitid modulename+data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod    = InstalledPackageInfo {-       unitId             :: unitid,+       unitId             :: instunitid,+       componentId        :: compid,+       instantiatedWith   :: [(modulename, mod)],        sourcePackageId    :: srcpkgid,        packageName        :: srcpkgname,        packageVersion     :: Version,+       sourceLibName      :: Maybe srcpkgname,        abiHash            :: String,-       depends            :: [unitid],+       depends            :: [instunitid],+       -- | Like 'depends', but each dependency is annotated with the+       -- ABI hash we expect the dependency to respect.+       abiDepends         :: [(instunitid, String)],        importDirs         :: [FilePath],        hsLibraries        :: [String],        extraLibraries     :: [String],@@ -87,8 +118,9 @@        includeDirs        :: [FilePath],        haddockInterfaces  :: [FilePath],        haddockHTMLs       :: [FilePath],-       exposedModules     :: [ExposedModule unitid modulename],+       exposedModules     :: [(modulename, Maybe mod)],        hiddenModules      :: [modulename],+       indefinite         :: Bool,        exposed            :: Bool,        trusted            :: Bool      }@@ -96,55 +128,65 @@  -- | A convenience constraint synonym for common constraints over parameters -- to 'InstalledPackageInfo'.-type RepInstalledPackageInfo srcpkgid srcpkgname unitid modulename =+type RepInstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =     (BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,-     BinaryStringRep unitid, BinaryStringRep modulename)+     BinaryStringRep modulename, BinaryStringRep compid,+     BinaryStringRep instunitid,+     DbUnitIdModuleRep instunitid compid unitid modulename mod) --- | An original module is a fully-qualified module name (installed package ID--- plus module name) representing where a module was *originally* defined--- (i.e., the 'exposedReexport' field of the original ExposedModule entry should--- be 'Nothing').  Invariant: an OriginalModule never points to a reexport.-data OriginalModule unitid modulename-   = OriginalModule {-       originalPackageId :: unitid,-       originalModuleName :: modulename+-- | A type-class for the types which can be converted into 'DbModule'/'DbUnitId'.+-- There is only one type class because these types are mutually recursive.+-- NB: The functional dependency helps out type inference in cases+-- where types would be ambiguous.+class DbUnitIdModuleRep instunitid compid unitid modulename mod+    | mod -> unitid, unitid -> mod, mod -> modulename, unitid -> compid, unitid -> instunitid+    where+  fromDbModule :: DbModule instunitid compid unitid modulename mod -> mod+  toDbModule :: mod -> DbModule instunitid compid unitid modulename mod+  fromDbUnitId :: DbUnitId instunitid compid unitid modulename mod -> unitid+  toDbUnitId :: unitid -> DbUnitId instunitid compid unitid modulename mod++-- | @ghc-boot@'s copy of 'Module', i.e. what is serialized to the database.+-- Use 'DbUnitIdModuleRep' to convert it into an actual 'Module'.+-- It has phantom type parameters as this is the most convenient way+-- to avoid undecidable instances.+data DbModule instunitid compid unitid modulename mod+   = DbModule {+       dbModuleUnitId :: unitid,+       dbModuleName :: modulename      }+   | DbModuleVar {+       dbModuleVarName :: modulename+     }   deriving (Eq, Show) --- | Represents a module name which is exported by a package, stored in the--- 'exposedModules' field.  A module export may be a reexport (in which case--- 'exposedReexport' is filled in with the original source of the module).--- Thus:------  * @ExposedModule n Nothing@ represents an exposed module @n@ which---    was defined in this package.------  * @ExposedModule n (Just o)@ represents a reexported module @n@---    which was originally defined in @o@.------ We use a 'Maybe' data types instead of an ADT with two branches because this--- representation allows us to treat reexports uniformly.-data ExposedModule unitid modulename-   = ExposedModule {-       exposedName      :: modulename,-       exposedReexport  :: Maybe (OriginalModule unitid modulename)-     }+-- | @ghc-boot@'s copy of 'UnitId', i.e. what is serialized to the database.+-- Use 'DbUnitIdModuleRep' to convert it into an actual 'UnitId'.+-- It has phantom type parameters as this is the most convenient way+-- to avoid undecidable instances.+data DbUnitId instunitid compid unitid modulename mod+   = DbUnitId compid [(modulename, mod)]+   | DbInstalledUnitId instunitid   deriving (Eq, Show)  class BinaryStringRep a where   fromStringRep :: BS.ByteString -> a   toStringRep   :: a -> BS.ByteString -emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d-                          => InstalledPackageInfo a b c d+emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d e f g+                          => InstalledPackageInfo a b c d e f g emptyInstalledPackageInfo =   InstalledPackageInfo {        unitId             = fromStringRep BS.empty,+       componentId        = fromStringRep BS.empty,+       instantiatedWith   = [],        sourcePackageId    = fromStringRep BS.empty,        packageName        = fromStringRep BS.empty,        packageVersion     = Version [] [],+       sourceLibName      = Nothing,        abiHash            = "",        depends            = [],+       abiDepends         = [],        importDirs         = [],        hsLibraries        = [],        extraLibraries     = [],@@ -161,16 +203,101 @@        haddockHTMLs       = [],        exposedModules     = [],        hiddenModules      = [],+       indefinite         = False,        exposed            = False,        trusted            = False   } +-- | Represents a lock of a package db.+newtype PackageDbLock = PackageDbLock+#if MIN_VERSION_base(4,10,0)+  Handle+#else+  ()  -- no locking primitives available in base < 4.10+#endif++-- | Acquire an exclusive lock related to package DB under given location.+lockPackageDb :: FilePath -> IO PackageDbLock++-- | Release the lock related to package DB.+unlockPackageDb :: PackageDbLock -> IO ()++#if MIN_VERSION_base(4,10,0)++-- | Acquire a lock of given type related to package DB under given location.+lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock+lockPackageDbWith mode file = do+  -- We are trying to open the lock file and then lock it. Thus the lock file+  -- needs to either exist or we need to be able to create it. Ideally we+  -- would not assume that the lock file always exists in advance. When we are+  -- dealing with a package DB where we have write access then if the lock+  -- file does not exist then we can create it by opening the file in+  -- read/write mode. On the other hand if we are dealing with a package DB+  -- where we do not have write access (e.g. a global DB) then we can only+  -- open in read mode, and the lock file had better exist already or we're in+  -- trouble. So for global read-only DBs on platforms where we must lock the+  -- DB for reading then we will require that the installer/packaging has+  -- included the lock file.+  --+  -- Thus the logic here is to first try opening in read-only mode (to handle+  -- global read-only DBs) and if the file does not exist then try opening in+  -- read/write mode to create the lock file. If either succeed then lock the+  -- file. IO exceptions (other than the first open attempt failing due to the+  -- file not existing) simply propagate.+  catchJust+    (\e -> if isDoesNotExistError e then Just () else Nothing)+    (lockFileOpenIn ReadMode)+    (const $ lockFileOpenIn ReadWriteMode)+  where+    lock = file <.> "lock"++    lockFileOpenIn io_mode = bracketOnError+      (openBinaryFile lock io_mode)+      hClose+      -- If file locking support is not available, ignore the error and proceed+      -- normally. Without it the only thing we lose on non-Windows platforms is+      -- the ability to safely issue concurrent updates to the same package db.+      $ \hnd -> do hLock hnd mode `catch` \FileLockingNotSupported -> return ()+                   return $ PackageDbLock hnd++lockPackageDb = lockPackageDbWith ExclusiveLock+unlockPackageDb (PackageDbLock hnd) = hClose hnd++-- MIN_VERSION_base(4,10,0)+#else++lockPackageDb _file = return $ PackageDbLock ()+unlockPackageDb _lock = return ()++-- MIN_VERSION_base(4,10,0)+#endif++-- | Mode to open a package db in.+data DbMode = DbReadOnly | DbReadWrite++-- | 'DbOpenMode' holds a value of type @t@ but only in 'DbReadWrite' mode.  So+-- it is like 'Maybe' but with a type argument for the mode to enforce that the+-- mode is used consistently.+data DbOpenMode (mode :: DbMode) t where+  DbOpenReadOnly  ::      DbOpenMode 'DbReadOnly t+  DbOpenReadWrite :: t -> DbOpenMode 'DbReadWrite t++deriving instance Functor (DbOpenMode mode)+deriving instance F.Foldable (DbOpenMode mode)+deriving instance F.Traversable (DbOpenMode mode)++isDbOpenReadMode :: DbOpenMode mode t -> Bool+isDbOpenReadMode = \case+  DbOpenReadOnly    -> True+  DbOpenReadWrite{} -> False+ -- | Read the part of the package DB that GHC is interested in. ---readPackageDbForGhc :: RepInstalledPackageInfo a b c d =>-                       FilePath -> IO [InstalledPackageInfo a b c d]+readPackageDbForGhc :: RepInstalledPackageInfo a b c d e f g =>+                       FilePath -> IO [InstalledPackageInfo a b c d e f g] readPackageDbForGhc file =-    decodeFromFile file getDbForGhc+  decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case+    (pkgs, DbOpenReadOnly) -> return pkgs   where     getDbForGhc = do       _version    <- getHeader@@ -185,9 +312,14 @@ -- is not defined in this package. This is because ghc-pkg uses Cabal types -- (and Binary instances for these) which this package does not depend on. ---readPackageDbForGhcPkg :: Binary pkgs => FilePath -> IO pkgs-readPackageDbForGhcPkg file =-    decodeFromFile file getDbForGhcPkg+-- If we open the package db in read only mode, we get its contents. Otherwise+-- we additionally receive a PackageDbLock that represents a lock on the+-- database, so that we can safely update it later.+--+readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->+                          IO (pkgs, DbOpenMode mode PackageDbLock)+readPackageDbForGhcPkg file mode =+    decodeFromFile file mode getDbForGhcPkg   where     getDbForGhcPkg = do       _version    <- getHeader@@ -200,10 +332,11 @@  -- | Write the whole of the package DB, both parts. ---writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d) =>-                  FilePath -> [InstalledPackageInfo a b c d] -> pkgs -> IO ()+writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d e f g) =>+                  FilePath -> [InstalledPackageInfo a b c d e f g] ->+                  pkgs -> IO () writePackageDb file ghcPkgs ghcPkgPart =-    writeFileAtomic file (runPut putDbForGhcPkg)+  writeFileAtomic file (runPut putDbForGhcPkg)   where     putDbForGhcPkg = do         putHeader@@ -259,11 +392,28 @@  -- | Feed a 'Get' decoder with data chunks from a file. ---decodeFromFile :: FilePath -> Get a -> IO a-decodeFromFile file decoder =-    withBinaryFile file ReadMode $ \hnd ->-      feed hnd (runGetIncremental decoder)+decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->+                  IO (pkgs, DbOpenMode mode PackageDbLock)+decodeFromFile file mode decoder = case mode of+  DbOpenReadOnly -> do+  -- When we open the package db in read only mode, there is no need to acquire+  -- shared lock on non-Windows platform because we update the database with an+  -- atomic rename, so readers will always see the database in a consistent+  -- state.+#if MIN_VERSION_base(4,10,0) && defined(mingw32_HOST_OS)+    bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \_ -> do+#endif+      (, DbOpenReadOnly) <$> decodeFileContents+  DbOpenReadWrite{} -> do+    -- When we open the package db in read/write mode, acquire an exclusive lock+    -- on the database and return it so we can keep it for the duration of the+    -- update.+    bracketOnError (lockPackageDb file) unlockPackageDb $ \lock -> do+      (, DbOpenReadWrite lock) <$> decodeFileContents   where+    decodeFileContents = withBinaryFile file ReadMode $ \hnd ->+      feed hnd (runGetIncremental decoder)+     feed hnd (Partial k)  = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize                                if BS.null chunk                                  then feed hnd (k Nothing)@@ -287,12 +437,13 @@         hClose handle         renameFile tmpPath targetPath) -instance (RepInstalledPackageInfo a b c d) =>-         Binary (InstalledPackageInfo a b c d) where+instance (RepInstalledPackageInfo a b c d e f g) =>+         Binary (InstalledPackageInfo a b c d e f g) where   put (InstalledPackageInfo-         unitId sourcePackageId+         unitId componentId instantiatedWith sourcePackageId          packageName packageVersion-         abiHash depends importDirs+         sourceLibName+         abiHash depends abiDepends importDirs          hsLibraries extraLibraries extraGHCiLibraries          libraryDirs libraryDynDirs          frameworks frameworkDirs@@ -300,13 +451,18 @@          includes includeDirs          haddockInterfaces haddockHTMLs          exposedModules hiddenModules-         exposed trusted) = do+         indefinite exposed trusted) = do     put (toStringRep sourcePackageId)     put (toStringRep packageName)     put packageVersion+    put (fmap toStringRep sourceLibName)     put (toStringRep unitId)+    put (toStringRep componentId)+    put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))+             instantiatedWith)     put abiHash     put (map toStringRep depends)+    put (map (\(k,v) -> (toStringRep k, v)) abiDepends)     put importDirs     put hsLibraries     put extraLibraries@@ -321,8 +477,10 @@     put includeDirs     put haddockInterfaces     put haddockHTMLs-    put exposedModules+    put (map (\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))+             exposedModules)     put (map toStringRep hiddenModules)+    put indefinite     put exposed     put trusted @@ -330,9 +488,13 @@     sourcePackageId    <- get     packageName        <- get     packageVersion     <- get-    unitId         <- get+    sourceLibName      <- get+    unitId             <- get+    componentId        <- get+    instantiatedWith   <- get     abiHash            <- get     depends            <- get+    abiDepends         <- get     importDirs         <- get     hsLibraries        <- get     extraLibraries     <- get@@ -349,14 +511,20 @@     haddockHTMLs       <- get     exposedModules     <- get     hiddenModules      <- get+    indefinite         <- get     exposed            <- get     trusted            <- get     return (InstalledPackageInfo               (fromStringRep unitId)+              (fromStringRep componentId)+              (map (\(mod_name, mod) -> (fromStringRep mod_name, fromDbModule mod))+                instantiatedWith)               (fromStringRep sourcePackageId)               (fromStringRep packageName) packageVersion+              (fmap fromStringRep sourceLibName)               abiHash               (map fromStringRep depends)+              (map (\(k,v) -> (fromStringRep k, v)) abiDepends)               importDirs               hsLibraries extraLibraries extraGHCiLibraries               libraryDirs libraryDynDirs@@ -364,28 +532,55 @@               ldOptions ccOptions               includes includeDirs               haddockInterfaces haddockHTMLs-              exposedModules+              (map (\(mod_name, mb_mod) ->+                        (fromStringRep mod_name, fmap fromDbModule mb_mod))+                   exposedModules)               (map fromStringRep hiddenModules)-              exposed trusted)+              indefinite exposed trusted) -instance (BinaryStringRep a, BinaryStringRep b) =>-         Binary (OriginalModule a b) where-  put (OriginalModule originalPackageId originalModuleName) = do-    put (toStringRep originalPackageId)-    put (toStringRep originalModuleName)+instance (BinaryStringRep modulename, BinaryStringRep compid,+          BinaryStringRep instunitid,+          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>+         Binary (DbModule instunitid compid unitid modulename mod) where+  put (DbModule dbModuleUnitId dbModuleName) = do+    putWord8 0+    put (toDbUnitId dbModuleUnitId)+    put (toStringRep dbModuleName)+  put (DbModuleVar dbModuleVarName) = do+    putWord8 1+    put (toStringRep dbModuleVarName)   get = do-    originalPackageId <- get-    originalModuleName <- get-    return (OriginalModule (fromStringRep originalPackageId)-                           (fromStringRep originalModuleName))+    b <- getWord8+    case b of+      0 -> do dbModuleUnitId <- get+              dbModuleName <- get+              return (DbModule (fromDbUnitId dbModuleUnitId)+                               (fromStringRep dbModuleName))+      _ -> do dbModuleVarName <- get+              return (DbModuleVar (fromStringRep dbModuleVarName)) -instance (BinaryStringRep a, BinaryStringRep b) =>-         Binary (ExposedModule a b) where-  put (ExposedModule exposedName exposedReexport) = do-    put (toStringRep exposedName)-    put exposedReexport+instance (BinaryStringRep modulename, BinaryStringRep compid,+          BinaryStringRep instunitid,+          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>+         Binary (DbUnitId instunitid compid unitid modulename mod) where+  put (DbInstalledUnitId instunitid) = do+    putWord8 0+    put (toStringRep instunitid)+  put (DbUnitId dbUnitIdComponentId dbUnitIdInsts) = do+    putWord8 1+    put (toStringRep dbUnitIdComponentId)+    put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod)) dbUnitIdInsts)   get = do-    exposedName <- get-    exposedReexport <- get-    return (ExposedModule (fromStringRep exposedName)-                          exposedReexport)+    b <- getWord8+    case b of+      0 -> do+        instunitid <- get+        return (DbInstalledUnitId (fromStringRep instunitid))+      _ -> do+        dbUnitIdComponentId <- get+        dbUnitIdInsts <- get+        return (DbUnitId+            (fromStringRep dbUnitIdComponentId)+            (map (\(mod_name, mod) -> ( fromStringRep mod_name+                                      , fromDbModule mod))+                 dbUnitIdInsts))

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} @@ -26,15 +28,22 @@ data Serialized = Serialized TypeRep [Word8]  -- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later-toSerialized :: Typeable a => (a -> [Word8]) -> a -> Serialized+toSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized toSerialized serialize what = Serialized (typeOf what) (serialize what)  -- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that. -- Otherwise return @Nothing@. fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a+#if MIN_VERSION_base(4,10,0) fromSerialized deserialize (Serialized the_type bytes)+  | the_type == rep = Just (deserialize bytes)+  | otherwise       = Nothing+  where rep = typeRep (Proxy :: Proxy a)+#else+fromSerialized deserialize (Serialized the_type bytes)   | the_type == typeOf (undefined :: a) = Just (deserialize bytes)   | otherwise                           = Nothing+#endif  -- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData' serializeWithData :: Data a => a -> [Word8]

@@ -1,7 +1,3 @@-## 8.0.2  *Jan 2017*--  * Bundled with GHC 8.0.2- ## 8.0.1  *May 2016*    * Bundled with GHC 8.0.1

@@ -1,9 +1,5 @@--- WARNING: ghc-boot.cabal is automatically generated from ghc-boot.cabal.in by--- ../../configure.  Make sure you are editing ghc-boot.cabal.in, not--- ghc-boot.cabal.- name:           ghc-boot-version:        8.0.2+version:        8.2.1 license:        BSD3 license-file:   LICENSE category:       GHC@@ -22,7 +18,7 @@                 The package database format and this library are constructed in                 such a way that while ghc-pkg depends on Cabal, the GHC library                 and program do not have to depend on Cabal.-cabal-version:  >=1.10+cabal-version:  >=1.22 build-type:     Simple extra-source-files: changelog.md @@ -37,13 +33,13 @@      exposed-modules:             GHC.LanguageExtensions-            GHC.LanguageExtensions.Type             GHC.PackageDb             GHC.Serialized+            GHC.ForeignSrcLang -    build-depends: base       >= 4.7 && < 4.10,+    build-depends: base       >= 4.7 && < 4.11,                    binary     == 0.8.*,                    bytestring == 0.10.*,                    directory  >= 1.2 && < 1.4,                    filepath   >= 1.3 && < 1.5,-                   ghc-boot-th == 8.0.2+                   ghc-boot-th == 8.2.1