diff --git a/Control/Monad/ST/Freeze.hs b/Control/Monad/ST/Freeze.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/ST/Freeze.hs @@ -0,0 +1,124 @@ +----------------------------------------------------------------------------- +-- | +-- Module: Control.Monad.ST.Freeze +-- License: BSD3 +-- Maintainer: Reiner Pope +-- Stability: experimental +-- Portability: portable +-- +-- An indexed version of the ST monad with support for safely freezing +-- multiple arrays. Compare to the usual ST monad, where the only support +-- for safely freezing arrays is runSTUArray -- only one array may be frozen. +-- +-- This version of the ST monad has two distinct stages of processing: +-- the /normal/ stage, and the /freeze/ stage. Reading and writing are +-- permitted in the normal stage; reading and freezing are permitted +-- in the freeze stage. This policy ensures that no writes occur after +-- the arrays have been frozen. +-- +-- This ST is an /indexed/ monad (see "Control.Monad.Indexed") as well +-- as a normal monad. That is, each monadic value will have an +-- \"ingoing\" state thread as well as an \"outgoing\" state +-- thread. These state threads are similar to the ST monad's state +-- thread, except that they are now annotated with a stage name: +-- either 'Normal' or 'Freeze'. +----------------------------------------------------------------------------- + +module Control.Monad.ST.Freeze ( + -- * Stage names + Normal, + Freeze, + -- * MonadST class + MonadST(..), + STNormal, + STFreeze, + STRead, + -- * ST monad + ST, + runST, + -- * ST transformer + STT, + STTBase(..), + ) where + +import Control.Applicative +import Control.Monad +import Control.Monad.Identity(Identity(..)) +import qualified Control.Monad.ST as S +import Control.Monad.Indexed(IxMonad(..),IxFunctor(..),IxPointed(..),IxApplicative(..)) +import System.IO.Unsafe + +data Normal s +data Freeze s + +-- | A computation containing some writes but no freezes: it starts +-- | and ends in the 'Normal' stage. +type STNormal st s a = st (Normal s) (Normal s) a +-- | A computation containing only reads: it starts and ends in any +-- stage, but does not change stage. (Note that there would be no loss +-- of safety in allowing the stage to change, but it may result in +-- ambiguous types, or extra type annotations being required.) +type STRead st s a = forall stg. st (stg s) (stg s) a +-- | A computation containing some freezes but no writes: it starts in +-- | any stage, but ends in the Freeze stage. +type STFreeze st s a = forall stg. st (stg s) (Freeze s) a + +class IxMonad st => MonadST st where + -- | For lifting any operations containing writes but no freezes. + liftST :: S.ST s a -> STNormal st s a + -- | For lifting any operations containing reads but no writes or freezes. + liftRead :: S.ST s a -> STRead st s a + -- | For lifting an @unsafeFreeze@ operation + liftUnsafeFreeze :: S.ST s a -> STFreeze st s a + +-- | An ST monad transformer. However, this is not a genuine monad +-- transformer, as that would be unsafe (see +-- ). To +-- retain safety, it may only act as a monad transformer over the +-- 'Identity' and 'IO' monads, enforced by the 'STTBase' typeclass. +-- +-- Defining 'STT' as a monad transformer rather than just a monad +-- allows ST arrays to be used in the 'IO' monad, bringing safe +-- freezing also to the 'IO' monad. +newtype STT m s t a = STT { unSTT :: IO a } + +class STTBase m where + -- | Runs the monad + runSTT :: (forall s. STT m (stg1 s) (stg2 s) a) -> m a + -- | A restricted analog of Control.Monad.Trans.lift. + lift :: m a -> STT m (stg s) (stg s) a + +type ST = STT Identity + +-- | @runST = 'runIdentity' . 'runSTT'@ +runST :: (forall s. STT Identity (stg1 s) (stg2 s) a) -> a +runST = runIdentity . runSTT + +instance STTBase IO where + runSTT m = unSTT m + lift = STT +instance STTBase Identity where + runSTT m = Identity (unsafePerformIO (unSTT m)) + lift = STT . return . runIdentity + +instance IxFunctor (STT m) where + imap f (STT m) = STT (fmap f m) +instance IxPointed (STT m) where + ireturn a = STT (return a) +instance IxApplicative (STT m) where + iap (STT m) (STT n) = STT (m `ap` n) +instance IxMonad (STT m) where + ibind k (STT m) = STT (m >>= (unSTT . k)) +instance MonadST (STT m) where + liftST s = STT (S.unsafeSTToIO s) + liftRead s = STT (S.unsafeSTToIO s) + liftUnsafeFreeze s = STT (S.unsafeSTToIO s) + +instance Functor (STT m s t) where + fmap f = imap f +instance Applicative (STT m s s) where + pure = ireturn + (<*>) = iap +instance Monad (STT m s s) where + (>>=) = flip ibind + return = ireturn diff --git a/Data/Array/Vector/STFreeze.hs b/Data/Array/Vector/STFreeze.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Vector/STFreeze.hs @@ -0,0 +1,236 @@ +----------------------------------------------------------------------------- +-- | +-- Module: Data.Array.Vector.Freeze +-- License: BSD3 +-- Maintainer: Reiner Pope +-- Stability: experimental +-- Portability: portable +-- +-- Support for using uvector's 'MUArr's in the new ST monad. Reexports +-- all of "Data.Array.Vector"'s API, but all the ST operations are +-- done with the new ST monad. +-- +-- Notable differences in API: +-- +-- * the former @unsafeFreezeMU@ is in fact safe, and is now named 'freezeMU'. +-- +-- * similarly for @unsafeFreezeAllMU@ +-- +-- * @newU@ is no longer required as a primitive; it can be implemented using @runSTT@ and @freezeAllMU@, mentioning no unsafe operations. +-- +-- +-- Example demonstration of using the new ST monad: +-- +-- @foo :: (UArr Int, UArr Int) +--foo = 'runST' go where +-- go :: forall s. 'ST' ('Normal' s) ('Freeze' s) (UArr Int, UArr Int) +-- go = newMU 5 >>>= \a1 -> +-- newMU 6 >>>= \a2 -> +-- writeMU a1 0 3 >>>= \() -> +-- writeMU a2 1 2 >>>= \() -> +-- freezeAllMU a1 >>>= \v1 -> +-- freezeAllMU a2 >>>= \v2 -> +-- return (v1,v2)@ +----------------------------------------------------------------------------- + +module Data.Array.Vector.STFreeze ( + + -- * Array classes + UA, + + -- (*) The pure and mutable array types + UArr, MUArr, + + -- * Streaming pure arrays + V.streamU, V.unstreamU, + + -- * Conversions to\/from lists + V.toU, V.fromU, + + -- * Basic operations on pure arrays + -- ** Introducing and eliminating UArrs + V.emptyU, + V.singletonU, + + -- ** Basic interface + V.consU, + V.snocU, + -- uncons + V.appendU, + V.headU, + V.lastU, + V.tailU, + V.initU, + V.nullU, + V.unitsU, + V.lengthU, + + -- * Transforming UArrs + V.mapU, + + -- * Reducing UArrs (folds) + V.foldU, + V.fold1U, + V.fold1MaybeU, + + V.foldlU, + V.foldl1U, + V.foldl1MaybeU, + + -- ** Logical operations + V.andU, + V.orU, + V.anyU, + V.allU, + + -- * Arithmetic operations + V.sumU, V.productU, + V.maximumU, V.minimumU, + V.maximumByU, V.minimumByU, +-- maximumIndexU, minimumIndexU, +-- maximumIndexByU, minimumIndexByU, + + -- * Building UArrs + -- ** Scans + V.scanlU, + V.scanl1U, + {-scanrU, scanr1U,-} + V.scanU, + V.scan1U, + V.scanResU, + + -- ** Accumulating UArrs + V.mapAccumLU, + + -- ** Generating UArrs + V.iterateU, + V.replicateU, + V.replicateEachU, + + -- ** Unfolding UArrs + + V.unfoldU, + + -- * Subarrays + + -- ** Breaking arrays + V.sliceU, +-- extractU, + V.takeU, + V.dropU, + V.splitAtU, + V.takeWhileU, + V.dropWhileU, + {- spanU, breakU,-} + + -- * Searching Arrays + + -- ** Searching by equality + V.elemU, + V.notElemU, + + -- ** Searching with a predicate + V.filterU, + V.findU, + V.findIndexU, + + -- * Indexing UArrs + V.indexU, + V.lookupU, + + -- * Zipping and unzipping + V.zipU, V.zip3U, + V.unzipU, V.unzip3U, + V.zipWithU, + V.zipWith3U, + V.fstU, + V.sndU, + + -- * Enumerations + V.enumFromToU, + V.enumFromToFracU, + V.enumFromThenToU, + V.enumFromStepLenU, + V.enumFromToEachU, + +{- + -- * Low level conversions + -- ** Copying arrays + -- ** Packing CStrings and pointers + -- ** Using UArrs as CStrings + -- * I\/O with UArrs + + -- creating them, generating new arrays from old ones. +-} + +------------------------------------------------------------------------ + + V.combineU, + V.packU, + V.indexedU, + V.repeatU, + +{- + -- * Permutations + -- permuteU, bpermuteU, bpermuteDftU, reverseU, updateU, + + -- * Searching + {- indexOfU,-} + + -- * Arrays of pairs + {-crossU,-} + + -- * Random arrays + -- randomU, randomRU, +-} + + -- * I\/O + V.UIO(..), + + -- * Operations on mutable arrays + V.lengthMU, newMU, readMU, writeMU, freezeMU, freezeAllMU, + copyMU, permuteMU, atomicUpdateMU, unstreamMU, + memcpyMU, memcpyOffMU, memmoveOffMU, + V.unsafeZipMU, V.unsafeUnzipMU, + + + ) where + +import Control.Monad.ST.Freeze +import qualified Data.Array.Vector as V +import Data.Array.Vector(MUArr, UArr, UA, (:*:)) + +newMU :: (UA e, MonadST st) => Int -> STNormal st s (MUArr e s) +newMU i = liftST (V.newMU i) + +readMU :: (UA e, MonadST st) => MUArr e s -> Int -> STRead st s e +readMU a i = liftRead (V.readMU a i) + +writeMU :: (UA e, MonadST st) => MUArr e s -> Int -> e -> STNormal st s () +writeMU a i e = liftST (V.writeMU a i e) + +copyMU :: (UA e, MonadST st) => MUArr e s -> Int -> UArr e -> STNormal st s () +copyMU m i a = liftST (V.copyMU m i a) + +freezeMU :: (UA e, MonadST st) => MUArr e s -> Int -> STFreeze st s (UArr e) +freezeMU m i = liftUnsafeFreeze (V.unsafeFreezeMU m i) + +memcpyMU :: (UA e, MonadST st) => MUArr e s -> MUArr e s -> Int -> STNormal st s () +memcpyMU m1 m2 i = liftST (V.memcpyMU m1 m2 i) + +memcpyOffMU :: (UA e, MonadST st) => MUArr e s -> MUArr e s -> Int -> Int -> Int -> STNormal st s () +memcpyOffMU m1 m2 i j k = liftST (V.memcpyOffMU m1 m2 i j k) + +memmoveOffMU :: (UA e, MonadST st) => MUArr e s -> MUArr e s -> Int -> Int -> Int -> STNormal st s () +memmoveOffMU m1 m2 i j k = liftST (V.memmoveOffMU m1 m2 i j k) + +freezeAllMU :: (UA e, MonadST st) => MUArr e s -> STFreeze st s (UArr e) +freezeAllMU m = liftUnsafeFreeze (V.unsafeFreezeAllMU m) + +permuteMU :: (UA e, MonadST st) => MUArr e s -> UArr e -> UArr Int -> STNormal st s () +permuteMU m a b = liftST (V.permuteMU m a b) + +atomicUpdateMU :: (UA e, MonadST st) => MUArr e s -> UArr (Int :*: e) -> STNormal st s () +atomicUpdateMU m a = liftST (V.atomicUpdateMU m a) + +unstreamMU m s = liftST (V.unstreamMU m s) diff --git a/Data/STRef/Freeze.hs b/Data/STRef/Freeze.hs new file mode 100644 --- /dev/null +++ b/Data/STRef/Freeze.hs @@ -0,0 +1,34 @@ +----------------------------------------------------------------------------- +-- | +-- Module: Data.STRef.Freeze +-- License: BSD3 +-- Maintainer: Reiner Pope +-- Stability: experimental +-- Portability: portable +-- +-- Description of this module goes here. +----------------------------------------------------------------------------- + + +module Data.STRef.Freeze ( + ST.STRef, + newSTRef, + readSTRef, + writeSTRef, + modifySTRef, + ) where + +import Control.Monad.ST.Freeze +import qualified Data.STRef as ST + +newSTRef :: (MonadST st) => a -> STNormal st s (ST.STRef s a) +newSTRef a = liftST (ST.newSTRef a) + +readSTRef :: (MonadST st) => ST.STRef s a -> STRead st s a +readSTRef r = liftRead (ST.readSTRef r) + +writeSTRef :: (MonadST st) => ST.STRef s a -> a -> STNormal st s () +writeSTRef r a = liftST (ST.writeSTRef r a) + +modifySTRef :: (MonadST st) => ST.STRef s a -> (a -> a) -> STNormal st s () +modifySTRef r f = liftST (ST.modifySTRef r f) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/safe-freeze.cabal b/safe-freeze.cabal new file mode 100644 --- /dev/null +++ b/safe-freeze.cabal @@ -0,0 +1,32 @@ +Name: safe-freeze +Version: 0.0 +Synopsis: Support for safely freezing multiple arrays in the ST monad. +License: BSD3 +Author: Reiner Pope +Maintainer: Reiner Pope +Stability: experimental +Description: + + Support for safely freezing multiple arrays in the ST + monad. Developed in + . + . + The new monad is defined in Control.Monad.ST.Freeze. An example + of its use is given in Data.Array.Vector.STFreeze. The modules + Data.Array.Vector.STFreeze and Data.STRef.Freeze are reexports of + Data.Array.Vector and Data.STRef but lifted to the new ST monad. + +Category: Data +Tested-with: +Cabal-Version: >= 1.6 +Build-type: Simple + +Library + Exposed-Modules: Control.Monad.ST.Freeze + Data.STRef.Freeze + Data.Array.Vector.STFreeze + Other-Modules: + Extensions: EmptyDataDecls, Rank2Types, KindSignatures, FlexibleInstances, TypeOperators + Build-Depends: base<4.2, category-extras>=0.44.4 && <0.54, transformers<0.2, uvector>=0.1.0.4 && <0.2 + +