ST.hs

-- | This is an approximate re-implementation of "Control.Monad.ST" and "Data.STRef" using open witnesses.
module Data.OpenWitness.ST
(
    -- * The @ST@ Monad
    ST,runST,fixST,
    -- * Converting @ST@ to @OW@ and @IO@
    stToOW,RealWorld,stToIO,
    -- * STRefs
    STRef,newSTRef,readSTRef,writeSTRef,modifySTRef
) where
{
    import Data.OpenWitness;
    import Data.Witness.WitnessDict;
    import Control.Monad.Trans.State;
    import Control.Monad.Trans.Class;
    import Control.Monad.Fix;

    type ST s = StateT (WitnessDict (OpenWitness s)) (OW s);

    stToOW :: ST s a -> OW s a;
    stToOW st = evalStateT st emptyWitnessDict;

    runST :: (forall s . ST s a) -> a;
    runST st = runOW (stToOW st);

    fixST :: (a -> ST s a) -> ST s a;
    fixST = mfix;

    type STRef = OpenWitness;

    newSTRef :: a -> ST s (STRef s a);
    newSTRef a = do
    {
        wit <- lift newOpenWitnessOW;
        dict <- get;
        put (witnessDictAdd wit a dict);
        return wit;
    };

    readSTRef :: STRef s a -> ST s a;
    readSTRef key = do
    {
        dict <- get;
        case witnessDictLookup key dict of
        {
            Just a -> return a;
            _ -> fail "ref not found";
        };
    };

    writeSTRef :: forall s a. STRef s a -> a -> ST s ();
    writeSTRef key newa = modify (witnessDictReplace key newa);

    modifySTRef :: forall s a. STRef s a -> (a -> a) -> ST s ();
    modifySTRef key amap = modify (witnessDictModify key amap);

    stToIO :: ST RealWorld a -> IO a;
    stToIO = owToIO . stToOW;
}