diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2017-08-28 Facundo Domínguez 0.3.8 + +* Remove support for ghc-7.8 and lower +* Fix build errors with ghc-8.2.1 + 2017-08-22 Facundo Domínguez 0.3.7 * Make nominal the role of static diff --git a/distributed-static.cabal b/distributed-static.cabal --- a/distributed-static.cabal +++ b/distributed-static.cabal @@ -1,5 +1,5 @@ Name: distributed-static -Version: 0.3.7 +Version: 0.3.8 Synopsis: Compositional, type-safe, polymorphic static values and closures Description: /Towards Haskell in the Cloud/ (Epstein et al, Haskell Symposium 2011) introduces the concept of /static/ values: @@ -32,10 +32,10 @@ Library Exposed-Modules: Control.Distributed.Static - Build-Depends: base >= 4 && < 5, + Build-Depends: base >= 4.8 && < 5, rank1dynamic >= 0.1 && < 0.5, containers >= 0.4 && < 0.6, - bytestring >= 0.9 && < 0.11, + bytestring >= 0.10 && < 0.11, binary >= 0.5 && < 0.9, deepseq >= 1.3.0.1 && < 1.6 HS-Source-Dirs: src diff --git a/src/Control/Distributed/Static.hs b/src/Control/Distributed/Static.hs --- a/src/Control/Distributed/Static.hs +++ b/src/Control/Distributed/Static.hs @@ -167,20 +167,15 @@ -- > where -- > sdictSendPort :: forall a. SerializableDict a -> SerializableDict (SendPort a) -- > sdictSendPort SerializableDict = SerializableDict -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE StaticPointers #-} {-# LANGUAGE RoleAnnotations #-} -#endif module Control.Distributed.Static ( -- * Static values Static , staticLabel , staticApply -#if __GLASGOW_HASKELL__ >= 710 , staticPtr , staticApplyPtr -#endif -- * Derived static combinators , staticCompose , staticSplit @@ -213,9 +208,6 @@ , decode ) import Data.ByteString.Lazy (ByteString, empty) -#if ! MIN_VERSION_bytestring(0,10,0) -import Data.ByteString.Lazy as BSL -#endif import Data.Map (Map) import qualified Data.Map as Map (lookup, empty, insert) import Control.Applicative ((<$>), (<*>)) @@ -228,27 +220,22 @@ , ANY2 , ANY3 , ANY4 -#if __GLASGOW_HASKELL__ >= 710 , TypeRep , typeOf -#endif ) -- Imports necessary to support StaticPtr -#if __GLASGOW_HASKELL__ >= 710 import qualified GHC.Exts as GHC (Any) import GHC.StaticPtr import GHC.Fingerprint.Type (Fingerprint(..)) import System.IO.Unsafe (unsafePerformIO) import Data.Rank1Dynamic (unsafeToDynamic) import Unsafe.Coerce (unsafeCoerce) -#endif -------------------------------------------------------------------------------- -- Introducing static values -- -------------------------------------------------------------------------------- -#if __GLASGOW_HASKELL__ >= 710 -- | Static dynamic values -- -- In the new proposal for static, the SPT contains these 'TypeRep's. @@ -259,7 +246,11 @@ instance Show SDynamic where show (SDynamic typ ptr) = - "<>" + let spi = staticPtrInfo ptr + (line, col) = spInfoSrcLoc spi + in concat [ "<>" + ] instance Eq SDynamic where SDynamic _ ptr1 == SDynamic _ ptr2 = @@ -268,32 +259,25 @@ instance Ord SDynamic where SDynamic _ ptr1 `compare` SDynamic _ ptr2 = staticKey ptr1 `compare` staticKey ptr2 -#endif data StaticLabel = StaticLabel String | StaticApply !StaticLabel !StaticLabel -#if __GLASGOW_HASKELL__ >= 710 | StaticPtr SDynamic -#endif deriving (Eq, Ord, Typeable, Show) instance NFData StaticLabel where rnf (StaticLabel s) = rnf s rnf (StaticApply a b) = rnf a `seq` rnf b -- There are no NFData instances for TypeRep or for StaticPtr :/ -#if __GLASGOW_HASKELL__ >= 710 rnf (StaticPtr (SDynamic _a _b)) = () -#endif -- | A static value. Static is opaque; see 'staticLabel' and 'staticApply'. newtype Static a = Static StaticLabel deriving (Eq, Ord, Typeable, Show) -- Trying to 'coerce' static values will lead to unification errors -#if __GLASGOW_HASKELL__ >= 710 type role Static nominal -#endif instance NFData (Static a) where rnf (Static s) = rnf s @@ -308,11 +292,9 @@ putWord8 0 >> put string putStaticLabel (StaticApply label1 label2) = putWord8 1 >> putStaticLabel label1 >> putStaticLabel label2 -#if __GLASGOW_HASKELL__ >= 710 putStaticLabel (StaticPtr (SDynamic typ ptr)) = let Fingerprint hi lo = staticKey ptr in putWord8 2 >> put typ >> put hi >> put lo -#endif getStaticLabel :: Get StaticLabel getStaticLabel = do @@ -320,7 +302,6 @@ case header of 0 -> StaticLabel <$> get 1 -> StaticApply <$> getStaticLabel <*> getStaticLabel -#if __GLASGOW_HASKELL__ >= 710 2 -> do typ <- get hi <- get lo <- get @@ -328,15 +309,12 @@ case unsaferLookupStaticPtr key of Nothing -> fail "StaticLabel.get: invalid pointer" Just ptr -> return $ StaticPtr (SDynamic typ ptr) -#endif _ -> fail "StaticLabel.get: invalid" -#if __GLASGOW_HASKELL__ >= 710 -- | We need to be able to lookup keys outside of the IO monad so that we -- can provide a 'Get' instance. unsaferLookupStaticPtr :: StaticKey -> Maybe (StaticPtr a) unsaferLookupStaticPtr = unsafePerformIO . unsafeLookupStaticPtr -#endif -- | Create a primitive static value. -- @@ -349,7 +327,6 @@ staticApply :: Static (a -> b) -> Static a -> Static b staticApply (Static f) (Static x) = Static (StaticApply f x) -#if __GLASGOW_HASKELL__ >= 710 -- | Construct a static value from a static pointer -- -- Since 0.3.4.0. @@ -363,7 +340,6 @@ staticApplyPtr :: (Typeable a, Typeable b) => StaticPtr (a -> b) -> Static a -> Static b staticApplyPtr = staticApply . staticPtr -#endif -------------------------------------------------------------------------------- -- Eliminating static values -- @@ -398,10 +374,8 @@ f <- resolveStaticLabel rtable label1 x <- resolveStaticLabel rtable label2 f `dynApply` x -#if __GLASGOW_HASKELL__ >= 710 resolveStaticLabel _ (StaticPtr (SDynamic typ ptr)) = return $ unsafeToDynamic typ (deRefStaticPtr ptr) -#endif -- | Resolve a static value unstatic :: Typeable a => RemoteTable -> Static a -> Either String a @@ -421,11 +395,7 @@ put (Closure st env) = put st >> put env get = Closure <$> get <*> get -#if MIN_VERSION_bytestring(0,10,0) instance NFData (Closure a) where rnf (Closure f b) = rnf f `seq` rnf b -#else -instance NFData (Closure a) where rnf (Closure f b) = rnf f `seq` BSL.length b `seq` () -#endif closure :: Static (ByteString -> a) -- ^ Decoder -> ByteString -- ^ Encoded closure environment