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.5 2002/04/24 16:31:39 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