Add touch
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 20 Sep 2010 00:21:27 +0000 (00:21 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Mon, 20 Sep 2010 00:21:27 +0000 (00:21 +0000)
Control/Monad/Primitive.hs

index 2e0fc2a..f4fd670 100644 (file)
@@ -15,10 +15,11 @@ module Control.Monad.Primitive (
   PrimMonad(..), RealWorld, primitive_,
   primToPrim, primToIO, primToST,
   unsafePrimToPrim, unsafePrimToIO, unsafePrimToST,
-  unsafeInlinePrim, unsafeInlineIO, unsafeInlineST
+  unsafeInlinePrim, unsafeInlineIO, unsafeInlineST,
+  touch
 ) where
 
-import GHC.Prim   ( State#, RealWorld )
+import GHC.Prim   ( State#, RealWorld, touch# )
 import GHC.Base   ( unsafeCoerce#, realWorld# )
 import GHC.IOBase ( IO(..) )
 import GHC.ST     ( ST(..) )
@@ -90,3 +91,7 @@ unsafeInlineST :: ST s a -> a
 {-# INLINE unsafeInlineST #-}
 unsafeInlineST = unsafeInlinePrim
 
+touch :: PrimMonad m => a -> m ()
+touch x = unsafePrimToPrim
+        $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO ())
+