From 185c1f9e85fd0a2d3bb5f0531a652fa4787fba25 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Tue, 23 Oct 2018 19:40:28 -0400
Subject: Converted ST use to generic PrimMonad instead.

---
 haskell/Data/BA.hs      | 17 +++++++++++++++++
 haskell/Data/XDelta.hsc | 32 +++++++++++++++++---------------
 2 files changed, 34 insertions(+), 15 deletions(-)
 create mode 100644 haskell/Data/BA.hs

diff --git a/haskell/Data/BA.hs b/haskell/Data/BA.hs
new file mode 100644
index 0000000..60b1136
--- /dev/null
+++ b/haskell/Data/BA.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE MagicHash           #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Data.BA where
+
+import GHC.Exts
+import Control.Monad.Primitive
+import Data.Primitive.Types
+import Data.Primitive.ByteArray
+
+-- | WARNING: Unsafe to use this on packed C structs.
+writeAtByte :: (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> a -> m ()
+writeAtByte buf offset a = writeByteArray buf (div offset $ I# (sizeOf# a)) a
+{-# INLINE writeAtByte #-}
+
+readAtByte :: forall a m. (Prim a, PrimMonad m) => MutableByteArray (PrimState m) -> Int -> m a
+readAtByte buf offset = readByteArray buf (div offset $ I# (sizeOf# (undefined :: a)))
+{-# INLINE readAtByte #-}
diff --git a/haskell/Data/XDelta.hsc b/haskell/Data/XDelta.hsc
index 11a8579..09f5523 100644
--- a/haskell/Data/XDelta.hsc
+++ b/haskell/Data/XDelta.hsc
@@ -17,6 +17,7 @@ import qualified Data.ByteString.Internal as B
 import Data.Coerce
 import Data.Primitive.Addr
 import Data.Primitive.ByteArray
+import Data.Primitive.MutVar
 import Data.STRef
 import qualified Data.Text as T
 import Data.Text.Encoding
@@ -39,10 +40,10 @@ import XDelta.Types
 #endif
 #include <xdelta3.h>
 
-data Stream s = Stream
-    { streamArray :: MutableByteArray (PrimState (ST s))
-    , streamPtr :: ForeignPtr Xd3Stream
-    , streamSource :: STRef s (Maybe (MutableByteArray (PrimState (ST s))))
+data Stream m = Stream
+    { streamArray  :: MutableByteArray (PrimState m)
+    , streamPtr    :: ForeignPtr Xd3Stream
+    , streamSource :: MutVar (PrimState m) (Maybe (MutableByteArray (PrimState m)))
     }
 
 foreign import ccall "xdelta3.h xd3_config_stream" xd3_config_stream :: Ptr Xd3Stream -> Ptr Config -> IO ErrorCode
@@ -76,7 +77,7 @@ adr (Ptr a) = Addr a
 -- The xd3_config structure is used to initialize a stream - all data
 -- is copied into stream so config may be a temporary variable.  See
 -- the [documentation] or comments on the xd3_config structure.
-config_stream :: Config -> ST s (Either ErrorCode (Stream s))
+config_stream :: PrimMonad m => Config -> m (Either ErrorCode (Stream m))
 config_stream cfg = do
     let (len,n) = case smatch_cfg cfg of
             Left  m -> let n = encodeUtf8 $ T.pack $ smName m
@@ -112,8 +113,8 @@ config_stream cfg = do
                 writeMatcher c o matcher
         unsafeFreezeByteArray c
     let cptr = ptr (byteArrayContents c) :: Ptr Config
-    srcvar <- newSTRef Nothing
-    stream <- unsafeIOToST $ do
+    srcvar <- newMutVar Nothing
+    stream <- unsafeIOToPrim $ do
         let finalize = do
                 -- freeHaskellFunPtr: aloc,free,getblk
                 xd3_abort_stream sptr
@@ -125,12 +126,12 @@ config_stream cfg = do
             , streamPtr    = fp
             , streamSource = srcvar
             }
-    unsafeIOToST (xd3_config_stream sptr cptr) >>= \case
+    unsafeIOToPrim (xd3_config_stream sptr cptr) >>= \case
         XD3_SUCCESS -> return $ c `seq` Right stream
         ecode       -> return $ Left ecode
 
 writeStringAt src o bsname = do
-            (p,cnt) <- unsafeIOToST $ B.unsafeUseAsCStringLen bsname return
+            (p,cnt) <- unsafeIOToPrim $ B.unsafeUseAsCStringLen bsname return
             let nptr = ptr (mutableByteArrayContents src) `plusPtr` o
             copyAddr (adr nptr) (adr p) cnt
             writeOffAddr (adr nptr) cnt (0 :: Word8)
@@ -140,10 +141,11 @@ data Xd3Source
 
 foreign import ccall "xdelta3.h xd3_set_source" xd3_set_source :: Ptr Xd3Stream -> Ptr Xd3Source -> IO ErrorCode
 
-set_source :: Stream s -> String  -- ^ name for debug/print purposes.
+set_source :: PrimMonad m =>
+                    Stream m -> String  -- ^ name for debug/print purposes.
                        -> Usize_t -- ^ block size
                        -> Xoff_t  -- ^ maximum visible buffer
-                       -> ST s ()
+                       -> m ()
 set_source stream nm blksz maxwinsz = do
     let bsname = encodeUtf8 $ T.pack nm
     src <- newPinnedByteArray $ 1 + B.length bsname + #{const sizeof(xd3_source)}
@@ -159,8 +161,8 @@ set_source stream nm blksz maxwinsz = do
     -}
     let strm = ptr (mutableByteArrayContents $ streamArray stream)
         srcptr = ptr (mutableByteArrayContents src)
-    unsafeIOToST (xd3_set_source strm srcptr)
-    writeSTRef (streamSource stream) (Just src)
+    unsafeIOToPrim (xd3_set_source strm srcptr)
+    writeMutVar (streamSource stream) (Just src)
 
 data XDeltaMethods m = XDeltaMethods
     { xConfig    :: Config
@@ -173,10 +175,10 @@ data XDeltaMethods m = XDeltaMethods
 -- | Checks for legal flag changes.
 foreign import ccall "xdelta3.h xd3_set_flags" xd3_set_flags :: Ptr Xd3Stream -> Flags -> IO ()
 
-setFlush :: Stream s -> Bool -> ST s ()
+setFlush :: PrimMonad m => Stream m -> Bool -> m ()
 setFlush stream wantFlush = return () -- todo
 
-setSkipWindow :: Stream s -> Bool -> ST s ()
+setSkipWindow :: PrimMonad m => Stream m -> Bool -> m ()
 setSkipWindow stream wantSkipWin = return () -- todo
 
 {-
-- 
cgit v1.2.3