[project @ 2002-05-09 13:16:29 by simonmar]
[packages/base.git] / Control / Monad / ST / Lazy.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Control.Monad.ST.Lazy
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : non-portable (requires universal quantification for runST)
10 --
11 -- This module presents an identical interface to Control.Monad.ST,
12 -- but the underlying implementation of the state thread is lazy.
13 --
14 -----------------------------------------------------------------------------
15
16 module Control.Monad.ST.Lazy (
17 ST,
18
19 runST,
20 unsafeInterleaveST,
21 fixST,
22
23 ST.unsafeIOToST, ST.stToIO,
24
25 strictToLazyST, lazyToStrictST
26 ) where
27
28 import Prelude
29
30 #ifdef __GLASGOW_HASKELL__
31 import qualified Control.Monad.ST as ST
32 import qualified GHC.ST
33 import GHC.Base
34 import Control.Monad
35 #endif
36
37 #ifdef __GLASGOW_HASKELL__
38 newtype ST s a = ST (State s -> (a, State s))
39 data State s = S# (State# s)
40 #endif
41
42 instance Functor (ST s) where
43 fmap f m = ST $ \ s ->
44 let
45 ST m_a = m
46 (r,new_s) = m_a s
47 in
48 (f r,new_s)
49
50 instance Monad (ST s) where
51
52 return a = ST $ \ s -> (a,s)
53 m >> k = m >>= \ _ -> k
54 fail s = error s
55
56 (ST m) >>= k
57 = ST $ \ s ->
58 let
59 (r,new_s) = m s
60 ST k_a = k r
61 in
62 k_a new_s
63
64
65 #ifdef __GLASGOW_HASKELL__
66 {-# NOINLINE runST #-}
67 runST :: (forall s. ST s a) -> a
68 runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r
69
70 fixST :: (a -> ST s a) -> ST s a
71 fixST m = ST (\ s ->
72 let
73 ST m_r = m r
74 (r,s') = m_r s
75 in
76 (r,s'))
77 #endif
78
79 -- ---------------------------------------------------------------------------
80 -- Strict <--> Lazy
81
82 #ifdef __GLASGOW_HASKELL__
83 strictToLazyST :: ST.ST s a -> ST s a
84 strictToLazyST m = ST $ \s ->
85 let
86 pr = case s of { S# s# -> GHC.ST.liftST m s# }
87 r = case pr of { GHC.ST.STret _ v -> v }
88 s' = case pr of { GHC.ST.STret s2# _ -> S# s2# }
89 in
90 (r, s')
91
92 lazyToStrictST :: ST s a -> ST.ST s a
93 lazyToStrictST (ST m) = GHC.ST.ST $ \s ->
94 case (m (S# s)) of (a, S# s') -> (# s', a #)
95 #endif
96
97 unsafeInterleaveST :: ST s a -> ST s a
98 unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST