{-# LANGUAGE MagicHash, UnboxedTuples #-}
module Fleet.Array.MutVar where

import GHC.Exts
import Data.Kind
import GHC.Base

import Fleet.Array.Lift

type MutVar :: UnliftedType -> Type
data MutVar a = MV (MutVar# RealWorld a)

newMutVar :: Lift a -> IO (MutVar a)
newMutVar :: forall (a :: UnliftedType). Lift a -> IO (MutVar a)
newMutVar (Lift a
x) = (State# RealWorld -> (# State# RealWorld, MutVar a #))
-> IO (MutVar a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, MutVar a #))
 -> IO (MutVar a))
-> (State# RealWorld -> (# State# RealWorld, MutVar a #))
-> IO (MutVar a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->
  case a
-> State# RealWorld -> (# State# RealWorld, MutVar# RealWorld a #)
forall a d. a -> State# d -> (# State# d, MutVar# d a #)
newMutVar# a
x State# RealWorld
s of
    (# State# RealWorld
s', MutVar# RealWorld a
v #) -> (# State# RealWorld
s', MutVar# RealWorld a -> MutVar a
forall (a :: UnliftedType). MutVar# RealWorld a -> MutVar a
MV MutVar# RealWorld a
v #)

readMutVar :: MutVar a -> IO (Lift a)
readMutVar :: forall (a :: UnliftedType). MutVar a -> IO (Lift a)
readMutVar (MV MutVar# RealWorld a
v) = (State# RealWorld -> (# State# RealWorld, Lift a #)) -> IO (Lift a)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, Lift a #))
 -> IO (Lift a))
-> (State# RealWorld -> (# State# RealWorld, Lift a #))
-> IO (Lift a)
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> case MutVar# RealWorld a
-> State# RealWorld -> (# State# RealWorld, a #)
forall d a. MutVar# d a -> State# d -> (# State# d, a #)
readMutVar# MutVar# RealWorld a
v State# RealWorld
s of (# State# RealWorld
s', a
x #) -> (# State# RealWorld
s', a -> Lift a
forall (a :: UnliftedType). a -> Lift a
Lift a
x #)

writeMutVar :: MutVar a -> Lift a -> IO ()
writeMutVar :: forall (a :: UnliftedType). MutVar a -> Lift a -> IO ()
writeMutVar (MV MutVar# RealWorld a
v) (Lift a
x) = (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s -> (# MutVar# RealWorld a -> a -> State# RealWorld -> State# RealWorld
forall d a. MutVar# d a -> a -> State# d -> State# d
writeMutVar# MutVar# RealWorld a
v a
x State# RealWorld
s, () #)

-- This module is intended to be combined with domain specific pattern synonyms
-- like this:
--
-- type ArrayData a = Lift (ArrayData# a)
-- pattern Current :: MutArray a -> ArrayData a
-- pattern Current x = Lift (Current# x)
-- pattern Diff :: Op a -> ArrayVar a -> ArrayData a
-- pattern Diff op v = Lift (Diff# op v)
-- {-# COMPLETE Current, Diff #-}
--
-- This is a zero-cost abstraction, as long as you always immediately pattern
-- match using these synonyms and you enable -O2.