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