ghc/lib/glaExts/ST.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[module_ST]{The State Transformer Monad, @ST@}
   5
   6 \begin{code}
   7 {-# OPTIONS -fno-implicit-prelude #-}
   8
   9 module ST (
  10
  11         -- ToDo: review this interface; I'm avoiding gratuitous changes for now
  12         --                      SLPJ Jan 97
  13
  14
  15         ST,
  16
  17         -- ST is one, so you'll likely need some Monad bits
  18         module Monad,
  19
  20         thenST, seqST, returnST, listST, fixST, runST, unsafeInterleaveST,
  21         mapST, mapAndUnzipST,
  22          -- the lazy variant
  23         returnLazyST, thenLazyST, seqLazyST,
  24
  25         MutableVar,
  26         newVar, readVar, writeVar, sameVar,
  27
  28         MutableArray,
  29         newArray, readArray, writeArray, sameMutableArray
  30
  31     ) where
  32
  33 import IOBase   ( error )       -- [Source not needed]
  34 import ArrBase
  35 import STBase
  36 import UnsafeST ( unsafeInterleaveST )
  37 import PrelBase ( Int, Bool, ($), ()(..) )
  38 import GHC      ( newArray#, readArray#, writeArray#, sameMutableArray#, sameMutableByteArray# )
  39 import Monad
  40
  41 \end{code}
  42
  43 %*********************************************************
  44 %*                                                      *
  45 \subsection{Variables}
  46 %*                                                      *
  47 %*********************************************************
  48
  49 \begin{code}
  50 -- in ArrBase: type MutableVar s a = MutableArray s Int a
  51
  52 newVar   :: a -> ST s (MutableVar s a)
  53 readVar  :: MutableVar s a -> ST s a
  54 writeVar :: MutableVar s a -> a -> ST s ()
  55 sameVar  :: MutableVar s a -> MutableVar s a -> Bool
  56
  57 newVar init = ST $ \ (S# s#) ->
  58     case (newArray# 1# init s#)     of { StateAndMutableArray# s2# arr# ->
  59     (MutableArray vAR_IXS arr#, S# s2#) }
  60   where
  61     vAR_IXS = error "newVar: Shouldn't access `bounds' of a MutableVar\n"
  62
  63 readVar (MutableArray _ var#) = ST $ \ (S# s#) ->
  64     case readArray# var# 0# s#  of { StateAndPtr# s2# r ->
  65     (r, S# s2#) }
  66
  67 writeVar (MutableArray _ var#) val = ST $ \ (S# s#) ->
  68     case writeArray# var# 0# val s# of { s2# ->
  69     ((), S# s2#) }
  70
  71 sameVar (MutableArray _ var1#) (MutableArray _ var2#)
  72   = sameMutableArray# var1# var2#
  73 \end{code}
  74
  75
  76 \begin{code}
  77 sameMutableArray     :: MutableArray s ix elt -> MutableArray s ix elt -> Bool
  78 sameMutableByteArray :: MutableByteArray s ix -> MutableByteArray s ix -> Bool
  79
  80 sameMutableArray (MutableArray _ arr1#) (MutableArray _ arr2#)
  81   = sameMutableArray# arr1# arr2#
  82
  83 sameMutableByteArray (MutableByteArray _ arr1#) (MutableByteArray _ arr2#)
  84   = sameMutableByteArray# arr1# arr2#
  85 \end{code}
  86
  87 Lazy monad combinators, the @Monad@ instance for @ST@
  88 uses the strict variant:
  89
  90 \begin{code}
  91 returnLazyST :: a -> ST s a
  92 returnLazyST a = ST (\ s -> (a, s))
  93
  94 thenLazyST :: ST s a -> (a -> ST s b) -> ST s b
  95 thenLazyST m k
  96  = ST $ \ s ->
  97    let
  98      (ST m_a) = m
  99      (r, new_s) = m_a s
 100      (ST k_a) = k r
 101    in
 102    k_a new_s
 103
 104 seqLazyST :: ST s a -> ST s b -> ST s b
 105 seqLazyST m k
 106  = ST $ \ s ->
 107    let
 108     (ST m_a) = m
 109     (_, new_s) = m_a s
 110     (ST k_a) = k
 111    in
 112    k_a new_s
 113 \end{code}