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