5 files changed, 276 insertions(+), 0 deletions(-)

A src/Effectful/ST/Primitive.hs
A src/Effectful/ST/Primitive/MVar.hs
A src/Effectful/ST/Primitive/MutVar.hs
A src/Effectful/ST/Primitive/Ptr.hs
A src/Effectful/ST/Primitive/SmallArray.hs

@@ 0,0 1,16 @@
+module Effectful.ST.Primitive
+  ( module Data.Primitive.Types
+  , module Effectful.ST.Primitive.Array
+  , Effectful.ST.Primitive.ByteArray
+  , Effectful.ST.Primitive.SmallArray
+  , Effectful.ST.Primitive.PrimArray
+  , Effectful.ST.Primitive.MutVar
+  )
+  where
+
+import Data.Primitive.Types
+import Effectful.ST.Primitive.Array
+import Effectful.ST.Primitive.ByteArray
+import Effectful.ST.Primitive.SmallArray
+import Effectful.ST.Primitive.PrimArray
+import Effectful.ST.Primitive.MutVar

@@ 0,0 1,46 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Effectful.ST.Primitive.MVar
+  ( P.MVar(..)
+  , newMVar
+  , isEmptyMVar
+  , newEmptyMVar
+  , putMVar
+  , readMVar
+  , takeMVar
+  , tryPutMVar
+  , tryReadMVar
+  , tryTakeMVar
+  )
+  where
+
+import Effectful ( type (:>), Eff )
+import Effectful.ST ( STE, stToSTE )
+import qualified Data.Primitive.MVar as P
+
+newMVar :: STE s :> es => a -> Eff es (P.MVar s a)
+newMVar = stToSTE . P.newMVar
+
+isEmptyMVar :: STE s :> es => P.MVar s a -> Eff es Bool
+isEmptyMVar = stToSTE . P.isEmptyMVar
+
+newEmptyMVar :: STE s :> es => Eff es (P.MVar s a)
+newEmptyMVar = stToSTE P.newEmptyMVar
+
+putMVar :: STE s :> es => P.MVar s a -> a -> Eff es ()
+putMVar = (stToSTE .) . P.putMVar
+
+readMVar :: STE s :> es => P.MVar s a -> Eff es a
+readMVar = stToSTE . P.readMVar
+
+takeMVar :: STE s :> es => P.MVar s a -> Eff es a
+takeMVar = stToSTE . P.takeMVar
+
+tryPutMVar :: STE s :> es => P.MVar s a -> a -> Eff es Bool
+tryPutMVar = (stToSTE .) . P.tryPutMVar
+
+tryReadMVar :: STE s :> es => P.MVar s a -> Eff es (Maybe a)
+tryReadMVar = stToSTE . P.tryReadMVar
+
+tryTakeMVar :: STE s :> es => P.MVar s a -> Eff es (Maybe a)
+tryTakeMVar = stToSTE . P.tryTakeMVar

@@ 0,0 1,38 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Effectful.ST.Primitive.MutVar
+  ( P.MutVar(..)
+  , newMutVar
+  , readMutVar
+  , writeMutVar
+  , atomicModifyMutVar
+  , atomicModifyMutVar'
+  , modifyMutVar
+  , modifyMutVar'
+  )
+  where
+
+import Effectful ( type (:>), Eff )
+import Effectful.ST ( STE, stToSTE )
+import qualified Data.Primitive as P
+
+newMutVar :: STE s :> es => a -> Eff es (P.MutVar s a)
+newMutVar = stToSTE . P.newMutVar
+
+readMutVar :: STE s :> es => P.MutVar s a -> Eff es a
+readMutVar = stToSTE . P.readMutVar
+
+writeMutVar :: STE s :> es => P.MutVar s a -> a -> Eff es ()
+writeMutVar = (stToSTE .) . P.writeMutVar
+
+atomicModifyMutVar :: STE s :> es => P.MutVar s a -> (a -> (a, b)) -> Eff es b
+atomicModifyMutVar = (stToSTE .) . P.atomicModifyMutVar
+
+atomicModifyMutVar' :: STE s :> es => P.MutVar s a -> (a -> (a, b)) -> Eff es b
+atomicModifyMutVar' = (stToSTE .) . P.atomicModifyMutVar'
+
+modifyMutVar :: STE s :> es => P.MutVar s a -> (a -> a) -> Eff es ()
+modifyMutVar = (stToSTE .) . P.modifyMutVar
+
+modifyMutVar' :: STE s :> es => P.MutVar s a -> (a -> a) -> Eff es ()
+modifyMutVar' = (stToSTE .) . P.modifyMutVar'

@@ 0,0 1,66 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+module Effectful.ST.Primitive.Ptr
+  ( P.Ptr(..)
+  , P.nullPtr
+  , P.advancePtr
+  , P.subtractPtr
+  , P.indexOffPtr
+  , readOffPtr
+  , writeOffPtr
+  , copyPtr
+  , movePtr
+  , setPtr
+  , copyPtrToMutablePrimArray
+  , copyPtrToMutableByteArray
+  )
+  where
+
+import Effectful ( type (:>), Eff )
+import Effectful.ST ( STE, stToSTE )
+import qualified Data.Primitive as P
+import qualified Data.Primitive.Ptr as P
+
+readOffPtr :: forall s a es. (STE s :> es, P.Prim a) => P.Ptr a -> Int -> Eff es a
+readOffPtr p ix = stToSTE @s $ P.readOffPtr p ix
+
+writeOffPtr :: forall s a es. (STE s :> es, P.Prim a) => P.Ptr a -> Int -> a -> Eff es ()
+writeOffPtr p ix a = stToSTE @s $ P.writeOffPtr p ix a
+
+copyPtr :: forall s a es. (STE s :> es, P.Prim a) => P.Ptr a -> P.Ptr a -> Int -> Eff es ()
+copyPtr dst src cnt = stToSTE @s $ P.copyPtr dst src cnt
+
+movePtr :: forall s a es. (STE s :> es, P.Prim a) => P.Ptr a -> P.Ptr a -> Int -> Eff es ()
+movePtr dst src cnt = stToSTE @s $ P.movePtr dst src cnt
+
+setPtr :: forall s a es. (STE s :> es, P.Prim a) => P.Ptr a -> Int -> a -> Eff es ()
+setPtr p cnt a = stToSTE @s $ P.setPtr p cnt a
+
+copyPtrToMutablePrimArray
+  :: (STE s :> es, P.Prim a)
+  => P.MutablePrimArray s a
+  -> Int
+  -> P.Ptr a
+  -> Int
+  -> Eff es ()
+copyPtrToMutablePrimArray
+  arr dst src cnt =
+    stToSTE $
+      P.copyPtrToMutablePrimArray
+        arr dst src cnt
+
+copyPtrToMutableByteArray
+  :: (STE s :> es, P.Prim a)
+  => P.MutableByteArray s
+  -> Int
+  -> P.Ptr a
+  -> Int
+  -> Eff es ()
+copyPtrToMutableByteArray
+  arr dst src cnt =
+    stToSTE $
+      P.copyPtrToMutableByteArray
+        arr dst src cnt

@@ 0,0 1,110 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+module Effectful.ST.Primitive.SmallArray
+  ( P.SmallArray(..)
+  , P.SmallMutableArray(..)
+  , newSmallArray
+  , readSmallArray
+  , writeSmallArray
+  , copySmallMutableArray
+  , P.indexSmallArray
+  , P.indexSmallArrayM
+  , P.indexSmallArray##
+  , P.cloneSmallArray
+  , cloneSmallMutableArray
+  , freezeSmallArray
+  , unsafeFreezeSmallArray
+  , thawSmallArray
+  , unsafeThawSmallArray
+  , P.runSmallArray
+  , P.createSmallArray
+  , P.sizeofSmallArray
+  , P.sizeofSmallMutableArray
+  , shrinkSmallMutableArray
+  , P.emptySmallArray
+  , P.smallArrayFromList
+  , P.smallArrayFromListN
+  , P.mapSmallArray'
+  , traverseSmallArrayP
+  , runArrayEff
+  , createArrayEff
+  ) where
+
+import Effectful ( type (:>), Eff )
+import Effectful.ST ( STE, stToSTE, runSTE, TEff (..) )
+import qualified Data.Primitive as P
+
+newSmallArray :: STE s :> es => Int -> a -> Eff es (P.MutableArray s a)
+-- ^ `P.newSmallArray` wrapper.
+newSmallArray n a = stToSTE $ P.newSmallArray n a
+
+readSmallArray :: STE s :> es => P.MutableArray s a -> Int -> Eff es a
+-- ^ `P.readSmallArray` wrapper.
+readSmallArray arr ix = stToSTE $ P.readSmallArray arr ix
+
+writeSmallArray :: STE s :> es => P.MutableArray s a -> Int -> a -> Eff es ()
+-- ^ `P.writeSmallArray` wrapper.
+writeSmallArray arr ix a = stToSTE $ P.writeSmallArray arr ix a
+
+freezeSmallArray :: STE s :> es => P.MutableArray s a -> Int -> Int -> Eff es (P.Array a)
+-- ^ `P.freezeSmallArray` wrapper.
+freezeSmallArray arr off len = stToSTE $ P.freezeSmallArray arr off len
+
+thawSmallArray :: STE s :> es => P.Array a -> Int -> Int -> Eff es (P.MutableArray s a)
+-- ^ `P.thawSmallArray` wrapper.
+thawSmallArray arr off len = stToSTE $ P.thawSmallArray arr off len
+
+runArrayEff
+  :: (forall s. Eff (STE s : es) (P.MutableArray s a))
+  -> Eff es (P.Array a)
+-- ^ `P.runArray`, but in `Eff`.
+runArrayEff m = runSTE $ unsafeFreezeSmallArray =<< m
+
+createArrayEff
+  :: Int
+  -> a
+  -> (forall s. P.MutableArray s a -> Eff (STE s : es) ())
+  -> Eff es (P.Array a)
+-- ^ `P.createArray`, but in `Eff`.
+createArrayEff 0 _ _ = pure P.emptyArray
+createArrayEff n a k = runArrayEff $ do
+  marr <- newSmallArray n a
+  k marr
+  pure marr
+
+unsafeFreezeSmallArray :: STE s :> es => P.MutableArray s a -> Eff es (P.Array a)
+-- ^ `P.unsafeFreezeSmallArray` wrapper.
+unsafeFreezeSmallArray = stToSTE . P.unsafeFreezeSmallArray
+
+unsafeThawSmallArray :: STE s :> es => P.Array a -> Eff es (P.MutableArray s a)
+-- ^ `P.unsafeThawSmallArray` wrapper.
+unsafeThawSmallArray = stToSTE . P.unsafeThawSmallArray
+
+copyArray :: STE s :> es => P.MutableArray s a -> Int -> P.Array a -> Int -> Int -> Eff es ()
+-- ^ `P.newSmallArray` wrapper.
+copyArray marr doff arr off len = stToSTE $
+  P.copyArray marr doff arr off len
+
+copySmallMutableArray :: STE s :> es => P.MutableArray s a -> Int -> P.MutableArray s a -> Int -> Int -> Eff es ()
+-- ^ `P.copySmallMutableArray` wrapper.
+copySmallMutableArray marr doff arr off len = stToSTE $
+  P.copySmallMutableArray marr doff arr off len
+
+cloneSmallMutableArray :: STE s :> es => P.MutableArray s a -> Int -> Int -> Eff es (P.MutableArray s a)
+-- ^ `P.cloneSmallMutableArray` wrapper.
+cloneSmallMutableArray marr off len = stToSTE $
+  P.cloneSmallMutableArray marr off len
+
+traverseArrayP :: forall s a b es. STE s :> es => (a -> Eff es b) -> P.Array a -> Eff es (P.Array b)
+-- ^ `P.traverseArrayP` wrapper.
+traverseArrayP f = \ !arr ->
+  case P.traverseArrayP (TEff @s . f) arr of
+    (TEff eff) -> eff