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 PrelBase ( Int, Bool, ($), ()(..) )
  37 import GHC      ( newArray#, readArray#, writeArray#, sameMutableArray#, sameMutableByteArray# )
  38 import Monad
  39
  40 \end{code}
  41
  42 %*********************************************************
  43 %*                                                      *
  44 \subsection{Variables}
  45 %*                                                      *
  46 %*********************************************************
  47
  48 \begin{code}
  49 -- in ArrBase: type MutableVar s a = MutableArray s Int a
  50
  51 newVar   :: a -> ST s (MutableVar s a)
  52 readVar  :: MutableVar s a -> ST s a
  53 writeVar :: MutableVar s a -> a -> ST s ()
  54 sameVar  :: MutableVar s a -> MutableVar s a -> Bool
  55
  56 newVar init = ST $ \ (S# s#) ->
  57     case (newArray# 1# init s#)     of { StateAndMutableArray# s2# arr# ->
  58     (MutableArray vAR_IXS arr#, S# s2#) }
  59   where
  60     vAR_IXS = error "newVar: Shouldn't access `bounds' of a MutableVar\n"
  61
  62 readVar (MutableArray _ var#) = ST $ \ (S# s#) ->
  63     case readArray# var# 0# s#  of { StateAndPtr# s2# r ->
  64     (r, S# s2#) }
  65
  66 writeVar (MutableArray _ var#) val = ST $ \ (S# s#) ->
  67     case writeArray# var# 0# val s# of { s2# ->
  68     ((), S# s2#) }
  69
  70 sameVar (MutableArray _ var1#) (MutableArray _ var2#)
  71   = sameMutableArray# var1# var2#
  72 \end{code}
  73
  74
  75 \begin{code}
  76 sameMutableArray     :: MutableArray s ix elt -> MutableArray s ix elt -> Bool
  77 sameMutableByteArray :: MutableByteArray s ix -> MutableByteArray s ix -> Bool
  78
  79 sameMutableArray (MutableArray _ arr1#) (MutableArray _ arr2#)
  80   = sameMutableArray# arr1# arr2#
  81
  82 sameMutableByteArray (MutableByteArray _ arr1#) (MutableByteArray _ arr2#)
  83   = sameMutableByteArray# arr1# arr2#
  84 \end{code}
  85
  86 Lazy monad combinators, the @Monad@ instance for @ST@
  87 uses the strict variant:
  88
  89 \begin{code}
  90 returnLazyST :: a -> ST s a
  91 returnLazyST a = ST (\ s -> (a, s))
  92
  93 thenLazyST :: ST s a -> (a -> ST s b) -> ST s b
  94 thenLazyST m k
  95  = ST $ \ s ->
  96    let
  97      (ST m_a) = m
  98      (r, new_s) = m_a s
  99      (ST k_a) = k r
 100    in
 101    k_a new_s
 102
 103 seqLazyST :: ST s a -> ST s b -> ST s b
 104 seqLazyST m k
 105  = ST $ \ s ->
 106    let
 107     (ST m_a) = m
 108     (_, new_s) = m_a s
 109     (ST k_a) = k
 110    in
 111    k_a new_s
 112 \end{code}