primitive patch haskell/primitive#11
This commit is contained in:
parent
73cde7e841
commit
fb85a3c7d2
1 changed files with 62 additions and 0 deletions
62
patching/patches/primitive-0.5.3.0.patch
Normal file
62
patching/patches/primitive-0.5.3.0.patch
Normal file
|
@ -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)
|
Loading…
Reference in a new issue