63 lines
2 KiB
Diff
63 lines
2 KiB
Diff
|
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)
|