diff --git a/patching/patches/primitive-0.5.3.0.patch b/patching/patches/primitive-0.5.3.0.patch new file mode 100644 index 00000000..592313e7 --- /dev/null +++ b/patching/patches/primitive-0.5.3.0.patch @@ -0,0 +1,62 @@ +diff -ruN orig/Control/Monad/Primitive.hs new/Control/Monad/Primitive.hs +--- orig/Control/Monad/Primitive.hs 2014-08-01 14:49:04.175318972 +0300 ++++ new/Control/Monad/Primitive.hs 2014-08-01 14:49:03.000000000 +0300 +@@ -44,7 +44,9 @@ + primitive_ :: PrimMonad m + => (State# (PrimState m) -> State# (PrimState m)) -> m () + {-# INLINE primitive_ #-} +-primitive_ f = primitive (\s# -> (# f s#, () #)) ++primitive_ f = primitive (\s# -> ++ case f s# of ++ s'# -> (# s'#, () #)) + + instance PrimMonad IO where + type PrimState IO = RealWorld +diff -ruN orig/primitive.cabal new/primitive.cabal +--- orig/primitive.cabal 2014-08-01 14:49:04.175318972 +0300 ++++ new/primitive.cabal 2014-08-01 14:49:03.000000000 +0300 +@@ -50,6 +50,16 @@ + if arch(i386) || arch(x86_64) + cc-options: -msse2 + ++test-suite test ++ Default-Language: Haskell2010 ++ hs-source-dirs: test ++ main-is: main.hs ++ type: exitcode-stdio-1.0 ++ build-depends: base ++ , ghc-prim ++ , primitive ++ ghc-options: -O2 ++ + source-repository head + type: git + location: https://github.com/haskell/primitive +diff -ruN orig/test/main.hs new/test/main.hs +--- orig/test/main.hs 1970-01-01 02:00:00.000000000 +0200 ++++ new/test/main.hs 2014-08-01 14:49:03.000000000 +0300 +@@ -0,0 +1,24 @@ ++{-# LANGUAGE MagicHash, UnboxedTuples #-} ++import Control.Monad.Primitive ++import Data.Primitive.Array ++import GHC.IO ++import GHC.Prim ++ ++-- Since we only have a single test case right now, I'm going to avoid the ++-- issue of choosing a test framework for the moment. This also keeps the ++-- package as a whole light on dependencies. ++ ++main :: IO () ++main = do ++ arr <- newArray 1 'A' ++ let unit = ++ case writeArray arr 0 'B' of ++ IO f -> ++ case f realWorld# of ++ _ -> () ++ c1 <- readArray arr 0 ++ return $! unit ++ c2 <- readArray arr 0 ++ if c1 == 'A' && c2 == 'B' ++ then return () ++ else error $ "Expected AB, got: " ++ show (c1, c2)