ghc/lib/ghc/STBase.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[STBase]{The @ST@ and @PrimIO@ monads}
   5
   6 \begin{code}
   7 module STBase where
   8
   9 import Prelude ()
  10 import Monad
  11 import PrelBase
  12 import GHC
  13 \end{code}
  14
  15 %*********************************************************
  16 %*                                                      *
  17 \subsection{The @ST@ monad}
  18 %*                                                      *
  19 %*********************************************************
  20
  21 The state-transformer monad proper.  By default the monad is strict;
  22 too many people got bitten by space leaks when it was lazy.
  23
  24 \begin{code}
  25 data State a   = S# (State# a)
  26 newtype ST s a = ST (State s -> (a, State s))
  27
  28 runST (ST m)
  29   = case m (S# realWorld#) of
  30       (r,_) -> r
  31
  32 instance Monad (ST s) where
  33     {-# INLINE return #-}
  34     {-# INLINE (>>)   #-}
  35     {-# INLINE (>>=)  #-}
  36     return x = ST $ \ s@(S# _) -> (x, s)
  37     m >> k   =  m >>= \ _ -> k
  38
  39     (ST m) >>= k
  40       = ST $ \ s ->
  41         case (m s) of {(r, new_s) ->
  42         case (k r) of { ST k2 ->
  43         (k2 new_s) }}
  44
  45 {-# INLINE returnST #-}
  46
  47 -- here for backward compatibility:
  48 returnST :: a -> ST s a
  49 thenST   :: ST s a -> (a -> ST s b) -> ST s b
  50 seqST    :: ST s a -> ST s b -> ST s b
  51
  52 returnST = return
  53 thenST   = (>>=)
  54 seqST    = (>>)
  55
  56 -- not sure whether to 1.3-ize these or what...
  57 {-# INLINE returnStrictlyST #-}
  58 {-# INLINE thenStrictlyST #-}
  59 {-# INLINE seqStrictlyST #-}
  60
  61 {-# GENERATE_SPECS returnStrictlyST a #-}
  62 returnStrictlyST :: a -> ST s a
  63
  64 {-# GENERATE_SPECS thenStrictlyST a b #-}
  65 thenStrictlyST :: ST s a -> (a -> ST s b) -> ST s b
  66
  67 {-# GENERATE_SPECS seqStrictlyST a b #-}
  68 seqStrictlyST :: ST s a -> ST s b -> ST s b
  69
  70 returnStrictlyST a = ST $ \ s@(S# _) -> (a, s)
  71
  72 thenStrictlyST (ST m) k = ST $ \ s ->   -- @(S# _)   Omitted SLPJ [May95] no need to evaluate the state
  73     case (m s) of { (r, new_s) ->
  74     case (k r) of { ST k2     ->
  75     (k2 new_s) }}
  76
  77 seqStrictlyST (ST m) (ST k) = ST $ \ s ->       -- @(S# _)   Omitted SLPJ [May95] no need to evaluate the state
  78     case (m s) of { (_, new_s) ->
  79     (k new_s) }
  80
  81 -- BUILT-IN: runST (see Builtin.hs)
  82
  83 unsafeInterleaveST :: ST s a -> ST s a    -- ToDo: put in state-interface.tex
  84 unsafeInterleaveST (ST m) = ST $ \ s ->
  85     let
  86         (r, new_s) = m s
  87     in
  88     (r, s)
  89
  90 fixST :: (a -> ST s a) -> ST s a
  91 fixST k = ST $ \ s ->
  92     let (ST k_r)  = k r
  93         ans       = k_r s
  94         (r,new_s) = ans
  95     in
  96     ans
  97
  98 -- more backward compatibility stuff:
  99 listST          :: [ST s a] -> ST s [a]
 100 mapST           :: (a -> ST s b) -> [a] -> ST s [b]
 101 mapAndUnzipST   :: (a -> ST s (b,c)) -> [a] -> ST s ([b],[c])
 102
 103 listST          = accumulate
 104 mapST           = mapM
 105 mapAndUnzipST   = mapAndUnzipM
 106
 107 \end{code}
 108
 109
 110 %*********************************************************
 111 %*                                                      *
 112 \subsection{The @PrimIO@ monad}
 113 %*                                                      *
 114 %*********************************************************
 115
 116 \begin{code}
 117 type PrimIO a = ST RealWorld a
 118
 119 fixPrimIO :: (a -> PrimIO a) -> PrimIO a
 120 fixPrimIO = fixST
 121
 122 {-# GENERATE_SPECS unsafePerformPrimIO a #-}
 123 unsafePerformPrimIO     :: PrimIO a -> a
 124 unsafeInterleavePrimIO  :: PrimIO a -> PrimIO a
 125
 126 unsafePerformPrimIO     = runST
 127 unsafeInterleavePrimIO  = unsafeInterleaveST
 128
 129 -- the following functions are now there for backward compatibility mostly:
 130
 131 {-# GENERATE_SPECS returnPrimIO a #-}
 132 returnPrimIO    :: a -> PrimIO a
 133
 134 {-# GENERATE_SPECS thenPrimIO b #-}
 135 thenPrimIO      :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
 136
 137 {-# GENERATE_SPECS seqPrimIO b #-}
 138 seqPrimIO       :: PrimIO a -> PrimIO b -> PrimIO b
 139
 140 listPrimIO      :: [PrimIO a] -> PrimIO [a]
 141 mapPrimIO       :: (a -> PrimIO b) -> [a] -> PrimIO [b]
 142 mapAndUnzipPrimIO :: (a -> PrimIO (b,c)) -> [a] -> PrimIO ([b],[c])
 143
 144 {-# INLINE returnPrimIO #-}
 145 {-# INLINE thenPrimIO   #-}
 146 {-# INLINE seqPrimIO  #-}
 147
 148 returnPrimIO      = return
 149 thenPrimIO        = (>>=)
 150 seqPrimIO         = (>>)
 151 listPrimIO        = accumulate
 152 mapPrimIO         = mapM
 153 mapAndUnzipPrimIO = mapAndUnzipM
 154 \end{code}
 155
 156
 157 %*********************************************************
 158 %*                                                      *
 159 \subsection{Ghastly return types}
 160 %*                                                      *
 161 %*********************************************************
 162
 163 \begin{code}
 164 data StateAndPtr#    s elt = StateAndPtr#    (State# s) elt
 165
 166 data StateAndChar#   s     = StateAndChar#   (State# s) Char#
 167 data StateAndInt#    s     = StateAndInt#    (State# s) Int#
 168 data StateAndWord#   s     = StateAndWord#   (State# s) Word#
 169 data StateAndFloat#  s     = StateAndFloat#  (State# s) Float#
 170 data StateAndDouble# s     = StateAndDouble# (State# s) Double#
 171 data StateAndAddr#   s     = StateAndAddr#   (State# s) Addr#
 172 \end{code}