413659e8294e319be0fb4ed8d8265db58d017fea
[packages/old-time.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/ (in
13 -- the sense that (@_|_ >> a@ is not necessarily equal to @_|_@).
14 --
15 -----------------------------------------------------------------------------
16
17 module Control.Monad.ST.Lazy (
18 -- * The 'ST' monad
19 ST,
20 runST,
21 fixST,
22
23 -- * Unsafe operations
24 unsafeInterleaveST,
25 unsafeIOToST,
26
27 -- * Converting 'ST' To 'IO'
28 RealWorld,
29 stToIO,
30
31 -- * Converting between strict and lazy 'ST'
32 strictToLazyST, lazyToStrictST
33 ) where
34
35 import Prelude
36
37 import Control.Monad.Fix
38
39 import Control.Monad.ST (RealWorld)
40 import qualified Control.Monad.ST as ST
41
42 #ifdef __GLASGOW_HASKELL__
43 import qualified GHC.ST
44 import GHC.Base
45 import Control.Monad
46 #endif
47
48 #ifdef __HUGS__
49 import Hugs.LazyST
50 #endif
51
52 #ifdef __GLASGOW_HASKELL__
53 newtype ST s a = ST (State s -> (a, State s))
54 data State s = S# (State# s)
55
56 instance Functor (ST s) where
57 fmap f m = ST $ \ s ->
58 let
59 ST m_a = m
60 (r,new_s) = m_a s
61 in
62 (f r,new_s)
63
64 instance Monad (ST s) where
65
66 return a = ST $ \ s -> (a,s)
67 m >> k = m >>= \ _ -> k
68 fail s = error s
69
70 (ST m) >>= k
71 = ST $ \ s ->
72 let
73 (r,new_s) = m s
74 ST k_a = k r
75 in
76 k_a new_s
77
78 {-# NOINLINE runST #-}
79 runST :: (forall s. ST s a) -> a
80 runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r
81
82 fixST :: (a -> ST s a) -> ST s a
83 fixST m = ST (\ s ->
84 let
85 ST m_r = m r
86 (r,s') = m_r s
87 in
88 (r,s'))
89 #endif
90
91 instance MonadFix (ST s) where
92 mfix = fixST
93
94 -- ---------------------------------------------------------------------------
95 -- Strict <--> Lazy
96
97 #ifdef __GLASGOW_HASKELL__
98 {-|
99 Convert a strict 'ST' computation into a lazy one. The strict state
100 thread passed to 'strictToLazyST' is not performed until the result of
101 the lazy state thread it returns is demanded.
102 -}
103 strictToLazyST :: ST.ST s a -> ST s a
104 strictToLazyST m = ST $ \s ->
105 let
106 pr = case s of { S# s# -> GHC.ST.liftST m s# }
107 r = case pr of { GHC.ST.STret _ v -> v }
108 s' = case pr of { GHC.ST.STret s2# _ -> S# s2# }
109 in
110 (r, s')
111
112 {-|
113 Convert a lazy 'ST' computation into a strict one.
114 -}
115 lazyToStrictST :: ST s a -> ST.ST s a
116 lazyToStrictST (ST m) = GHC.ST.ST $ \s ->
117 case (m (S# s)) of (a, S# s') -> (# s', a #)
118
119 unsafeInterleaveST :: ST s a -> ST s a
120 unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST
121 #endif
122
123 unsafeIOToST :: IO a -> ST s a
124 unsafeIOToST = strictToLazyST . ST.unsafeIOToST
125
126 stToIO :: ST RealWorld a -> IO a
127 stToIO = ST.stToIO . lazyToStrictST