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         runST,
  16         unsafeInterleaveST,
  17
  18         -- ST is one, so you'll likely need some Monad bits
  19         module Monad,
  20
  21         ST.STRef,
  22         newSTRef, readSTRef, writeSTRef,
  23
  24         STArray,
  25         newSTArray, readSTArray, writeSTArray, boundsSTArray,
  26         thawSTArray, freezeSTArray, unsafeFreezeSTArray,
  27         Ix,
  28
  29         strictToLazyST, lazyToStrictST
  30     ) where
  31
  32 import qualified ST
  33 import qualified STBase
  34 import ArrBase
  35 import qualified UnsafeST   ( unsafeInterleaveST )
  36 import PrelBase ( Eq(..), Int, Bool, ($), ()(..) )
  37 import Monad
  38 import Ix
  39 import GHC
  40
  41 newtype ST s a = ST (STBase.State s -> (a,STBase.State s))
  42
  43 instance Monad (ST s) where
  44
  45         return a = ST $ \ s -> (a,s)
  46         m >> k   =  m >>= \ _ -> k
  47
  48         (ST m) >>= k
  49          = ST $ \ s ->
  50            let
  51              (r,new_s) = m s
  52              ST k_a = k r
  53            in
  54            k_a new_s
  55
  56 -- ToDo: un-inline this, it could cause problems...
  57 runST :: (All s => ST s a) -> a
  58 runST st = case st of ST st -> let (r,_) = st (STBase.S# realWorld#) in r
  59 \end{code}
  60
  61 %*********************************************************
  62 %*                                                      *
  63 \subsection{Variables}
  64 %*                                                      *
  65 %*********************************************************
  66
  67 \begin{code}
  68 newSTRef   :: a -> ST s (ST.STRef s a)
  69 readSTRef  :: ST.STRef s a -> ST s a
  70 writeSTRef :: ST.STRef s a -> a -> ST s ()
  71
  72 newSTRef   = strictToLazyST . ST.newSTRef
  73 readSTRef  = strictToLazyST . ST.readSTRef
  74 writeSTRef r a = strictToLazyST (ST.writeSTRef r a)
  75 \end{code}
  76
  77 %*********************************************************
  78 %*                                                      *
  79 \subsection{Arrays}
  80 %*                                                      *
  81 %*********************************************************
  82
  83 \begin{code}
  84 newtype STArray s ix elt = STArray (MutableArray s ix elt)
  85
  86 newSTArray          :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
  87 readSTArray         :: Ix ix => STArray s ix elt -> ix -> ST s elt
  88 writeSTArray        :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
  89 boundsSTArray       :: Ix ix => STArray s ix elt -> (ix, ix)
  90 thawSTArray         :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
  91 freezeSTArray       :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
  92 unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
  93
  94 newSTArray ixs init     =
  95            strictToLazyST (newArray ixs init) >>= \arr ->
  96            return (STArray arr)
  97
  98 readSTArray (STArray arr) ix = strictToLazyST (readArray arr ix)
  99 writeSTArray (STArray arr) ix v = strictToLazyST (writeArray arr ix v)
 100 boundsSTArray (STArray arr) = boundsOfArray arr
 101 thawSTArray arr =
 102             strictToLazyST (thawArray arr) >>= \arr ->
 103             return (STArray arr)
 104 freezeSTArray (STArray arr) = strictToLazyST (freezeArray arr)
 105 unsafeFreezeSTArray (STArray arr) = strictToLazyST (unsafeFreezeArray arr)
 106
 107 strictToLazyST :: STBase.ST s a -> ST s a
 108 strictToLazyST (STBase.ST m) = ST $ \s ->
 109         let
 110             STBase.S# s# = s
 111             STBase.STret s2# r = m s#
 112         in
 113         (r, STBase.S# s2#)
 114
 115 lazyToStrictST :: ST s a -> STBase.ST s a
 116 lazyToStrictST (ST m) = STBase.ST $ \s ->
 117         case (m (STBase.S# s)) of (a, STBase.S# s') -> STBase.STret s' a
 118
 119 unsafeInterleaveST :: ST s a -> ST s a
 120 unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
 121
 122 \end{code}