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