ghc/lib/exts/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.STRef,
  19         newSTRef, readSTRef, writeSTRef,
  20
  21         STArray,
  22         newSTArray, readSTArray, writeSTArray, boundsSTArray,
  23         thawSTArray, freezeSTArray, unsafeFreezeSTArray,
  24         unsafeThawSTArray,
  25
  26         ST.unsafeIOToST, ST.stToIO,
  27
  28         strictToLazyST, lazyToStrictST
  29     ) where
  30
  31 import qualified ST
  32 import qualified PrelST
  33 import PrelArr
  34 import PrelBase ( Eq(..), Int, Bool, ($), ()(..) )
  35 import Monad
  36 import Ix
  37 import PrelGHC
  38
  39 newtype ST s a = ST (State s -> (a, State s))
  40
  41 data State s = S# (State# s)
  42
  43 instance Functor (ST s) where
  44     fmap f m = ST $ \ s ->
  45       let
  46        ST m_a = m
  47        (r,new_s) = m_a s
  48       in
  49       (f r,new_s)
  50
  51 instance Monad (ST s) where
  52
  53         return a = ST $ \ s -> (a,s)
  54         m >> k   =  m >>= \ _ -> k
  55         fail s   = error s
  56
  57         (ST m) >>= k
  58          = ST $ \ s ->
  59            let
  60              (r,new_s) = m s
  61              ST k_a = k r
  62            in
  63            k_a new_s
  64
  65 {-# NOINLINE runST #-}
  66 runST :: (forall s. ST s a) -> a
  67 runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r
  68 \end{code}
  69
  70 %*********************************************************
  71 %*                                                      *
  72 \subsection{Variables}
  73 %*                                                      *
  74 %*********************************************************
  75
  76 \begin{code}
  77 newSTRef   :: a -> ST s (ST.STRef s a)
  78 readSTRef  :: ST.STRef s a -> ST s a
  79 writeSTRef :: ST.STRef s a -> a -> ST s ()
  80
  81 newSTRef   = strictToLazyST . ST.newSTRef
  82 readSTRef  = strictToLazyST . ST.readSTRef
  83 writeSTRef r a = strictToLazyST (ST.writeSTRef r a)
  84
  85 \end{code}
  86
  87 %*********************************************************
  88 %*                                                      *
  89 \subsection{Arrays}
  90 %*                                                      *
  91 %*********************************************************
  92
  93 \begin{code}
  94 newtype STArray s ix elt = STArray (MutableArray s ix elt)
  95
  96 newSTArray          :: Ix ix => (ix,ix) -> elt -> ST s (STArray s ix elt)
  97 readSTArray         :: Ix ix => STArray s ix elt -> ix -> ST s elt
  98 writeSTArray        :: Ix ix => STArray s ix elt -> ix -> elt -> ST s ()
  99 boundsSTArray       :: Ix ix => STArray s ix elt -> (ix, ix)
 100 thawSTArray         :: Ix ix => Array ix elt -> ST s (STArray s ix elt)
 101 freezeSTArray       :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
 102 unsafeFreezeSTArray :: Ix ix => STArray s ix elt -> ST s (Array ix elt)
 103
 104 newSTArray ixs init     =
 105            strictToLazyST (newArray ixs init) >>= \arr ->
 106            return (STArray arr)
 107
 108 readSTArray (STArray arr) ix = strictToLazyST (readArray arr ix)
 109 writeSTArray (STArray arr) ix v = strictToLazyST (writeArray arr ix v)
 110 boundsSTArray (STArray arr) = boundsOfArray arr
 111 thawSTArray arr =
 112             strictToLazyST (thawArray arr) >>= \ marr ->
 113             return (STArray marr)
 114
 115 freezeSTArray (STArray arr) = strictToLazyST (freezeArray arr)
 116 unsafeFreezeSTArray (STArray arr) = strictToLazyST (unsafeFreezeArray arr)
 117 unsafeThawSTArray arr =
 118             strictToLazyST (unsafeThawArray arr) >>= \ marr ->
 119             return (STArray marr)
 120
 121 strictToLazyST :: PrelST.ST s a -> ST s a
 122 strictToLazyST m = ST $ \s ->
 123         let
 124            pr = case s of { S# s# -> PrelST.liftST m s# }
 125            r  = case pr of { PrelST.STret _ v -> v }
 126            s' = case pr of { PrelST.STret s2# _ -> S# s2# }
 127         in
 128         (r, s')
 129
 130 lazyToStrictST :: ST s a -> PrelST.ST s a
 131 lazyToStrictST (ST m) = PrelST.ST $ \s ->
 132         case (m (S# s)) of (a, S# s') -> (# s', a #)
 133
 134 unsafeInterleaveST :: ST s a -> ST s a
 135 unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
 136
 137 \end{code}