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