From 5a2f3a0f2aead0efb13c4e68d5b28b36547b1155 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Wed, 3 Sep 2008 20:19:08 +0000 Subject: [PATCH] Remerge concurrent,unique,timeout,st,getopt into base --- Control/Monad/ST.hs | 65 +++++++++++++++++++ Control/Monad/ST/Lazy.hs | 152 ++++++++++++++++++++++++++++++++++++++++++++ Control/Monad/ST/Strict.hs | 20 ++++++ Data/STRef.hs | 41 ++++++++++++ Data/STRef/Lazy.hs | 34 ++++++++++ Data/STRef/Strict.hs | 20 ++++++ base.cabal | 17 ++++- 7 files changed, 348 insertions(+), 1 deletion(-) create mode 100644 Control/Monad/ST.hs create mode 100644 Control/Monad/ST/Lazy.hs create mode 100644 Control/Monad/ST/Strict.hs create mode 100644 Data/STRef.hs create mode 100644 Data/STRef/Lazy.hs create mode 100644 Data/STRef/Strict.hs diff --git a/Control/Monad/ST.hs b/Control/Monad/ST.hs new file mode 100644 index 0000000..b779664 --- /dev/null +++ b/Control/Monad/ST.hs @@ -0,0 +1,65 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.ST +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (requires universal quantification for runST) +-- +-- This library provides support for /strict/ state threads, as +-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton +-- Jones /Lazy Functional State Threads/. +-- +----------------------------------------------------------------------------- + +module Control.Monad.ST + ( + -- * The 'ST' Monad + ST, -- abstract, instance of Functor, Monad, Typeable. + runST, -- :: (forall s. ST s a) -> a + fixST, -- :: (a -> ST s a) -> ST s a + + -- * Converting 'ST' to 'IO' + RealWorld, -- abstract + stToIO, -- :: ST RealWorld a -> IO a + + -- * Unsafe operations + unsafeInterleaveST, -- :: ST s a -> ST s a + unsafeIOToST, -- :: IO a -> ST s a + unsafeSTToIO -- :: ST s a -> IO a + ) where + +import Prelude + +import Control.Monad.Fix + +#include "Typeable.h" + +#ifdef __HUGS__ +import Data.Typeable +import Hugs.ST +import qualified Hugs.LazyST as LazyST + +INSTANCE_TYPEABLE2(ST,sTTc,"ST") +INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld") + +fixST :: (a -> ST s a) -> ST s a +fixST f = LazyST.lazyToStrictST (LazyST.fixST (LazyST.strictToLazyST . f)) + +unsafeInterleaveST :: ST s a -> ST s a +unsafeInterleaveST = + LazyST.lazyToStrictST . LazyST.unsafeInterleaveST . LazyST.strictToLazyST +#endif + +#ifdef __GLASGOW_HASKELL__ +import GHC.ST ( ST, runST, fixST, unsafeInterleaveST ) +import GHC.Base ( RealWorld ) +import GHC.IOBase ( stToIO, unsafeIOToST, unsafeSTToIO ) +#endif + +instance MonadFix (ST s) where + mfix = fixST + diff --git a/Control/Monad/ST/Lazy.hs b/Control/Monad/ST/Lazy.hs new file mode 100644 index 0000000..00aa4f0 --- /dev/null +++ b/Control/Monad/ST/Lazy.hs @@ -0,0 +1,152 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.ST.Lazy +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : non-portable (requires universal quantification for runST) +-- +-- This module presents an identical interface to "Control.Monad.ST", +-- except that the monad delays evaluation of state operations until +-- a value depending on them is required. +-- +----------------------------------------------------------------------------- + +module Control.Monad.ST.Lazy ( + -- * The 'ST' monad + ST, + runST, + fixST, + + -- * Converting between strict and lazy 'ST' + strictToLazyST, lazyToStrictST, + + -- * Converting 'ST' To 'IO' + RealWorld, + stToIO, + + -- * Unsafe operations + unsafeInterleaveST, + unsafeIOToST + ) where + +import Prelude + +import Control.Monad.Fix + +import Control.Monad.ST (RealWorld) +import qualified Control.Monad.ST as ST + +#ifdef __GLASGOW_HASKELL__ +import qualified GHC.ST +import GHC.Base +import Control.Monad +#endif + +#ifdef __HUGS__ +import Hugs.LazyST +#endif + +#ifdef __GLASGOW_HASKELL__ +-- | The lazy state-transformer monad. +-- A computation of type @'ST' s a@ transforms an internal state indexed +-- by @s@, and returns a value of type @a@. +-- The @s@ parameter is either +-- +-- * an unstantiated type variable (inside invocations of 'runST'), or +-- +-- * 'RealWorld' (inside invocations of 'stToIO'). +-- +-- It serves to keep the internal states of different invocations of +-- 'runST' separate from each other and from invocations of 'stToIO'. +-- +-- The '>>=' and '>>' operations are not strict in the state. For example, +-- +-- @'runST' (writeSTRef _|_ v >>= readSTRef _|_ >> return 2) = 2@ +newtype ST s a = ST (State s -> (a, State s)) +data State s = S# (State# s) + +instance Functor (ST s) where + fmap f m = ST $ \ s -> + let + ST m_a = m + (r,new_s) = m_a s + in + (f r,new_s) + +instance Monad (ST s) where + + return a = ST $ \ s -> (a,s) + m >> k = m >>= \ _ -> k + fail s = error s + + (ST m) >>= k + = ST $ \ s -> + let + (r,new_s) = m s + ST k_a = k r + in + k_a new_s + +{-# NOINLINE runST #-} +-- | Return the value computed by a state transformer computation. +-- The @forall@ ensures that the internal state used by the 'ST' +-- computation is inaccessible to the rest of the program. +runST :: (forall s. ST s a) -> a +runST st = case st of ST the_st -> let (r,_) = the_st (S# realWorld#) in r + +-- | Allow the result of a state transformer computation to be used (lazily) +-- inside the computation. +-- Note that if @f@ is strict, @'fixST' f = _|_@. +fixST :: (a -> ST s a) -> ST s a +fixST m = ST (\ s -> + let + ST m_r = m r + (r,s') = m_r s + in + (r,s')) +#endif + +instance MonadFix (ST s) where + mfix = fixST + +-- --------------------------------------------------------------------------- +-- Strict <--> Lazy + +#ifdef __GLASGOW_HASKELL__ +{-| +Convert a strict 'ST' computation into a lazy one. The strict state +thread passed to 'strictToLazyST' is not performed until the result of +the lazy state thread it returns is demanded. +-} +strictToLazyST :: ST.ST s a -> ST s a +strictToLazyST m = ST $ \s -> + let + pr = case s of { S# s# -> GHC.ST.liftST m s# } + r = case pr of { GHC.ST.STret _ v -> v } + s' = case pr of { GHC.ST.STret s2# _ -> S# s2# } + in + (r, s') + +{-| +Convert a lazy 'ST' computation into a strict one. +-} +lazyToStrictST :: ST s a -> ST.ST s a +lazyToStrictST (ST m) = GHC.ST.ST $ \s -> + case (m (S# s)) of (a, S# s') -> (# s', a #) + +unsafeInterleaveST :: ST s a -> ST s a +unsafeInterleaveST = strictToLazyST . ST.unsafeInterleaveST . lazyToStrictST +#endif + +unsafeIOToST :: IO a -> ST s a +unsafeIOToST = strictToLazyST . ST.unsafeIOToST + +-- | A monad transformer embedding lazy state transformers in the 'IO' +-- monad. The 'RealWorld' parameter indicates that the internal state +-- used by the 'ST' computation is a special one supplied by the 'IO' +-- monad, and thus distinct from those used by invocations of 'runST'. +stToIO :: ST RealWorld a -> IO a +stToIO = ST.stToIO . lazyToStrictST diff --git a/Control/Monad/ST/Strict.hs b/Control/Monad/ST/Strict.hs new file mode 100644 index 0000000..a899616 --- /dev/null +++ b/Control/Monad/ST/Strict.hs @@ -0,0 +1,20 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.ST.Strict +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : non-portable (requires universal quantification for runST) +-- +-- The strict ST monad (re-export of "Control.Monad.ST") +-- +----------------------------------------------------------------------------- + +module Control.Monad.ST.Strict ( + module Control.Monad.ST + ) where + +import Prelude +import Control.Monad.ST diff --git a/Data/STRef.hs b/Data/STRef.hs new file mode 100644 index 0000000..288cbe7 --- /dev/null +++ b/Data/STRef.hs @@ -0,0 +1,41 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.STRef +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (uses Control.Monad.ST) +-- +-- Mutable references in the (strict) ST monad. +-- +----------------------------------------------------------------------------- + +module Data.STRef ( + -- * STRefs + STRef, -- abstract, instance Eq + newSTRef, -- :: a -> ST s (STRef s a) + readSTRef, -- :: STRef s a -> ST s a + writeSTRef, -- :: STRef s a -> a -> ST s () + modifySTRef -- :: STRef s a -> (a -> a) -> ST s () + ) where + +import Prelude + +#ifdef __GLASGOW_HASKELL__ +import GHC.ST +import GHC.STRef +#endif + +#ifdef __HUGS__ +import Hugs.ST +import Data.Typeable + +#include "Typeable.h" +INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef") +#endif + +-- |Mutate the contents of an 'STRef' +modifySTRef :: STRef s a -> (a -> a) -> ST s () +modifySTRef ref f = writeSTRef ref . f =<< readSTRef ref diff --git a/Data/STRef/Lazy.hs b/Data/STRef/Lazy.hs new file mode 100644 index 0000000..3218310 --- /dev/null +++ b/Data/STRef/Lazy.hs @@ -0,0 +1,34 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.STRef.Lazy +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (uses Control.Monad.ST.Lazy) +-- +-- Mutable references in the lazy ST monad. +-- +----------------------------------------------------------------------------- +module Data.STRef.Lazy ( + -- * STRefs + ST.STRef, -- abstract, instance Eq + newSTRef, -- :: a -> ST s (STRef s a) + readSTRef, -- :: STRef s a -> ST s a + writeSTRef, -- :: STRef s a -> a -> ST s () + modifySTRef -- :: STRef s a -> (a -> a) -> ST s () + ) where + +import Control.Monad.ST.Lazy +import qualified Data.STRef as ST + +newSTRef :: a -> ST s (ST.STRef s a) +readSTRef :: ST.STRef s a -> ST s a +writeSTRef :: ST.STRef s a -> a -> ST s () +modifySTRef :: ST.STRef s a -> (a -> a) -> ST s () + +newSTRef = strictToLazyST . ST.newSTRef +readSTRef = strictToLazyST . ST.readSTRef +writeSTRef r a = strictToLazyST (ST.writeSTRef r a) +modifySTRef r f = strictToLazyST (ST.modifySTRef r f) diff --git a/Data/STRef/Strict.hs b/Data/STRef/Strict.hs new file mode 100644 index 0000000..61ac9b8 --- /dev/null +++ b/Data/STRef/Strict.hs @@ -0,0 +1,20 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.STRef.Strict +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : non-portable (uses Control.Monad.ST.Strict) +-- +-- Mutable references in the (strict) ST monad (re-export of "Data.STRef") +-- +----------------------------------------------------------------------------- + +module Data.STRef.Strict ( + module Data.STRef + ) where + +import Prelude +import Data.STRef diff --git a/base.cabal b/base.cabal index d222d58..6a1553a 100644 --- a/base.cabal +++ b/base.cabal @@ -55,7 +55,8 @@ Library { GHC.TopHandler, GHC.Unicode, GHC.Weak, - GHC.Word + GHC.Word, + System.Timeout extensions: MagicHash, ExistentialQuantification, Rank2Types, ScopedTypeVariables, UnboxedTuples, ForeignFunctionInterface, UnliftedFFITypes, @@ -67,12 +68,21 @@ Library { Control.Applicative, Control.Arrow, Control.Category, + Control.Concurrent, + Control.Concurrent.Chan, + Control.Concurrent.MVar, + Control.Concurrent.QSem, + Control.Concurrent.QSemN, + Control.Concurrent.SampleVar, Control.Exception, Control.Exception.Base Control.OldException, Control.Monad, Control.Monad.Fix, Control.Monad.Instances, + Control.Monad.ST + Control.Monad.ST.Lazy + Control.Monad.ST.Strict Data.Bits, Data.Bool, Data.Char, @@ -92,10 +102,14 @@ Library { Data.Monoid, Data.Ord, Data.Ratio, + Data.STRef + Data.STRef.Lazy + Data.STRef.Strict Data.String, Data.Traversable Data.Tuple, Data.Typeable, + Data.Unique, Data.Version, Data.Word, Debug.Trace, @@ -116,6 +130,7 @@ Library { Foreign.Storable, Numeric, Prelude, + System.Console.GetOpt System.CPUTime, System.Environment, System.Exit, -- 1.7.10.4