diff --git a/Control/Monad/Trans/Goto.hs b/Control/Monad/Trans/Goto.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/Trans/Goto.hs @@ -0,0 +1,102 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Trans.Goto +-- Copyright : (c) Gregory Crosswhite 2001 +-- License : BSD3 +-- Maintainer : gcross@phys.washington.edu +-- Stability : provisional +-- Portability : portable +-- +-- This module provides a monad and a monad transformer that allow the +-- user to transfer the flow of execution from an arbitrary point of a +-- monadic computation to another monadic computation. +----------------------------------------------------------------------------- + + +module Control.Monad.Trans.Goto ( + -- * The Goto monad + Goto, + runGoto, + -- * The GotoT monad transformer + GotoT(..), + runGotoT, + -- * Goto operations + goto + ) where + +import Control.Applicative (Applicative(..),(<*>)) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Trans.Class (MonadTrans(..)) + +import Data.Functor +import Data.Functor.Identity + +-- --------------------------------------------------------------------------- +-- | A goto monad, parameterized by the type @r@ of the value to return. +type Goto r = GotoT r Identity + +-- | Execute the goto monad computation and return the resulting value. +runGoto :: Goto r r -- ^ the monadic computation to run + -> r -- ^ the result of the computation +runGoto = runIdentity . runGotoT + +-- --------------------------------------------------------------------------- +-- | A goto monad transformer parameterized by +-- +-- * @r@ - the value that will ultimately be returned; and +-- +-- * @m@ - the inner monad. +-- +-- The 'GotoT' type wraps a monadic value that contains either a pure value or +-- the next place at which the flow of execution should be continued. +newtype GotoT r m a = GotoT { unwrapGotoT :: m (Either (GotoT r m r) a) } + +instance Applicative m => Applicative (GotoT r m) where + pure = GotoT . fmap Right . pure + (GotoT m) <*> (GotoT x) = GotoT ((fmap h m) <*> x) + where + h (Left g) = const (Left g) + h (Right f) = either Left (Right . f) +instance Functor m => Functor (GotoT r m) where + fmap f = GotoT . fmap (either Left (Right . f)) . unwrapGotoT +instance Monad m => Monad (GotoT r m) where + return = GotoT . return . Right + (GotoT m) >>= f = GotoT $ m >>= either (return . Left) (unwrapGotoT . f) +instance MonadIO m => MonadIO (GotoT r m) where + liftIO = lift . liftIO +instance MonadTrans (GotoT r) where + lift = GotoT . (>>= return . Right) + +-- | Execute the goto monad computation and return the resulting value. +-- +-- 'runGotoT' is implemented by using a ''trampoline'' approach. It +-- looks at the monadic value and checks whether it is either a 'Left' +-- containing a continuation or a 'Right' containing the result. As +-- long as it sees a 'Left' it executes the continuation and then +-- feeds the result back into itself. Thus the computation bounces +-- back to this function (hence the ''trampoline'') as long as the +-- user keeps calling 'goto' until the final result has been obtained. +runGotoT :: Monad m + => GotoT r m r -- ^ the monadic computation to run + -> m r -- ^ the result of the computation +runGotoT (GotoT m) = m >>= either runGotoT return + +-- --------------------------------------------------------------------------- +-- | Transfer the flow of executation from an arbitrary point in the current +-- monadic computation to another monadic computation. +-- +-- Note that the destination computation must promise to produce the +-- same value that was promised to be returned by the origin +-- computation. Also, since control is being transferred away from +-- the origin computation, the goto function returns a monadic value that +-- can have an arbitrary type, since the monadic value will never +-- be used by the originating computation. +goto :: Monad m + => GotoT r m r -- ^ the destination to which to transfer the flow + -- of execution + -> GotoT r m a -- ^ a monadic value that has the effect of + -- transferring the flow of execution to the + -- specified destination; note that value can + -- have an arbitrary type since it will never + -- actually be accessed +goto = GotoT . return . Left diff --git a/GotoT-transformers.cabal b/GotoT-transformers.cabal new file mode 100644 --- /dev/null +++ b/GotoT-transformers.cabal @@ -0,0 +1,18 @@ +Name: GotoT-transformers +Version: 1.0 +License: BSD3 +License-file: LICENSE +Author: Gregory Crosswhite +Maintainer: Gregory Crosswhite +Stability: Provisional +Homepage: http://github.com/gcross/GotoT-transformers +Synopsis: A monad and monadic transformer providing "goto" functionality +Description: This module provides a monad and a monad transformer that allow the user to transfer the flow of execution from an arbitrary point of a monadic computation to another monadic computation. +Cabal-version: >=1.2.3 +Build-type: Simple +Category: Control + +Library + Build-depends: base >= 3 && < 5, + transformers >= 0.2 && <0.3 + Exposed-modules: Control.Monad.Trans.Goto diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +Copyright (c) 2010, Gregory Crosswhite +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain