[project @ 1997-08-25 22:43:11 by sof]
[ghc-hetmet.git] / 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
47
48 -- here for backward compatibility:
49
50 {-# INLINE returnST #-}
51 returnST :: a -> ST s a
52 thenST   :: ST s a -> (a -> ST s b) -> ST s b
53 seqST    :: ST s a -> ST s b -> ST s b
54
55 returnST = return
56 thenST   = (>>=)
57 seqST    = (>>)
58
59 fixST :: (a -> ST s a) -> ST s a
60 fixST k = ST $ \ s ->
61     let (ST k_r)  = k r
62         ans       = k_r s
63         (r,new_s) = ans
64     in
65     ans
66
67 -- more backward compatibility stuff:
68 listST          :: [ST s a] -> ST s [a]
69 mapST           :: (a -> ST s b) -> [a] -> ST s [b]
70 mapAndUnzipST   :: (a -> ST s (b,c)) -> [a] -> ST s ([b],[c])
71
72 listST          = accumulate
73 mapST           = mapM
74 mapAndUnzipST   = mapAndUnzipM
75
76 \end{code}
77
78
79 %*********************************************************
80 %*                                                      *
81 \subsection{The @PrimIO@ monad}
82 %*                                                      *
83 %*********************************************************
84
85 \begin{code}
86 type PrimIO a = ST RealWorld a
87
88 fixPrimIO :: (a -> PrimIO a) -> PrimIO a
89 fixPrimIO = fixST
90
91 -- the following functions are now there for backward compatibility mostly:
92
93 {-# GENERATE_SPECS returnPrimIO a #-}
94 returnPrimIO    :: a -> PrimIO a
95
96 {-# GENERATE_SPECS thenPrimIO b #-}
97 thenPrimIO      :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
98
99 {-# GENERATE_SPECS seqPrimIO b #-}
100 seqPrimIO       :: PrimIO a -> PrimIO b -> PrimIO b
101
102 listPrimIO      :: [PrimIO a] -> PrimIO [a]
103 mapPrimIO       :: (a -> PrimIO b) -> [a] -> PrimIO [b]
104 mapAndUnzipPrimIO :: (a -> PrimIO (b,c)) -> [a] -> PrimIO ([b],[c])
105
106 {-# INLINE returnPrimIO #-}
107 {-# INLINE thenPrimIO   #-}
108 {-# INLINE seqPrimIO  #-}
109
110 returnPrimIO      = return
111 thenPrimIO        = (>>=)
112 seqPrimIO         = (>>)
113 listPrimIO        = accumulate
114 mapPrimIO         = mapM
115 mapAndUnzipPrimIO = mapAndUnzipM
116 \end{code}
117
118
119 %*********************************************************
120 %*                                                      *
121 \subsection{Ghastly return types}
122 %*                                                      *
123 %*********************************************************
124
125 \begin{code}
126 data StateAndPtr#    s elt = StateAndPtr#    (State# s) elt 
127
128 data StateAndChar#   s     = StateAndChar#   (State# s) Char# 
129 data StateAndInt#    s     = StateAndInt#    (State# s) Int# 
130 data StateAndWord#   s     = StateAndWord#   (State# s) Word#
131 data StateAndFloat#  s     = StateAndFloat#  (State# s) Float# 
132 data StateAndDouble# s     = StateAndDouble# (State# s) Double#  
133 data StateAndAddr#   s     = StateAndAddr#   (State# s) Addr#
134 \end{code}