ghc/lib/glaExts/LazyST.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
   3 %
   4
   5 \section[LazyST]{The Lazy State Transformer Monad, @LazyST@}
   6
   7 This module presents an identical interface to ST, but the underlying
   8 implementation of the state thread is lazy.
   9
  10 \begin{code}
  11 module LazyST (
  12
  13         ST,
  14
  15         unsafeInterleaveST,
  16
  17         -- ST is one, so you'll likely need some Monad bits
  18         module Monad,
  19
  20         ST.STRef,
  21         newSTRef, readSTRef, writeSTRef,
  22
  23         ST.STArray,
  24         newSTArray, readSTArray, writeSTArray, Ix,
  25
  26         strictToLazyST, lazyToStrictST
  27     ) where
  28
  29 import qualified ST
  30 import qualified STBase
  31 import ArrBase
  32 import qualified Unsafe   ( unsafeInterleaveST )
  33 import PrelBase ( Eq(..), Int, Bool, ($), ()(..) )
  34 import Monad
  35 import Ix
  36
  37 newtype ST s a = ST (STBase.State s -> (a,STBase.State s))
  38
  39 instance Monad (ST s) where
  40
  41         return a = ST $ \ s -> (a,s)
  42         m >> k   =  m >>= \ _ -> k
  43
  44         (ST m) >>= k
  45          = ST $ \ s ->
  46            let
  47              (r,new_s) = m s
  48              ST k_a = k r
  49            in
  50            k_a new_s
  51 \end{code}
  52
  53 %*********************************************************
  54 %*                                                      *
  55 \subsection{Variables}
  56 %*                                                      *
  57 %*********************************************************
  58
  59 \begin{code}
  60 newSTRef   :: a -> ST s (ST.STRef s a)
  61 readSTRef  :: ST.STRef s a -> ST s a
  62 writeSTRef :: ST.STRef s a -> a -> ST s ()
  63
  64 newSTRef   = strictToLazyST . ST.newSTRef
  65 readSTRef  = strictToLazyST . ST.readSTRef
  66 writeSTRef r a = strictToLazyST (ST.writeSTRef r a)
  67 \end{code}
  68
  69 %*********************************************************
  70 %*                                                      *
  71 \subsection{Arrays}
  72 %*                                                      *
  73 %*********************************************************
  74
  75 \begin{code}
  76 newtype STArray s ix elt = STArray (MutableArray s ix elt)
  77
  78 newSTArray          :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
  79 readSTArray         :: Ix ix => STArray s ix elt -> ix -> ST s elt
  80 writeSTArray        :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
  81 boundsSTArray       :: Ix ix => STArray s ix elt -> (ix, ix)
  82 thawSTArray         :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
  83 freezeSTArray       :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
  84 unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
  85
  86 newSTArray ixs init     =
  87            strictToLazyST (newArray ixs init) >>= \arr ->
  88            return (STArray arr)
  89
  90 readSTArray (STArray arr) ix = strictToLazyST (readArray arr ix)
  91 writeSTArray (STArray arr) ix v = strictToLazyST (writeArray arr ix v)
  92 boundsSTArray (STArray arr) = boundsOfArray arr
  93 thawSTArray arr =
  94             strictToLazyST (thawArray arr) >>= \arr ->
  95             return (STArray arr)
  96 freezeSTArray (STArray arr) = strictToLazyST (freezeArray arr)
  97 unsafeFreezeSTArray (STArray arr) = strictToLazyST (unsafeFreezeArray arr)
  98
  99 strictToLazyST :: STBase.ST s a -> ST s a
 100 strictToLazyST (STBase.ST m) = ST $ \s ->
 101         let STBase.S# s# = s in
 102         case m s# of { STBase.STret s2# r -> (r, STBase.S# s2#) }
 103
 104 lazyToStrictST :: ST s a -> STBase.ST s a
 105 lazyToStrictST (ST m) = STBase.ST $ \s ->
 106         case (m (STBase.S# s)) of (a, STBase.S# s') -> STBase.STret s' a
 107
 108 unsafeInterleaveST :: ST s a -> ST s a
 109 unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
 110
 111 \end{code}