diff --git a/CC-delcont.cabal b/CC-delcont.cabal new file mode 100644 --- /dev/null +++ b/CC-delcont.cabal @@ -0,0 +1,37 @@ +Name: CC-delcont +Version: 0.1 +Description: An implementation of multi-prompt delimited continuations based + on the paper, /A Monadic Framework for Delimited Continuations/, + by R. Kent Dybvig, Simon Peyton Jones and Amr Sabry + (). + It also includes a corresponding implementation of dynamically + scoped variables, as implemented in the paper, + /Delimited Dynamic Binding/, by Oleg Kiselyov, Chung-chieh Shan + and Amr Sabry + (), + adapted from the original haskell code, + (). +Synopsis: Delimited continuations and dynamically scoped variables +Category: Control +License: OtherLicense +License-File: LICENSE +Copyright: Copyright (c) 2005--2007, R. Kent Dybvig, Simon Peyton Jones, + Amr Sabry, Oleg Kiselyov, Chung-chieh Shan +Author: R. Kent Dybvig, Simon Peyton Jones, Amr Sabry, Oleg Kiselyov, + Chung-chieh Shan +Maintainer: dan.doel@gmail.com +Homepage: http://code.haskell.org/~dolio/CC-delcont +Stability: Experimental +Tested-With: GHC +Build-Depends: base, mtl +Exposed-Modules: Control.Monad.CC, + Control.Monad.CC.Dynvar, + Control.Monad.CC.Seq, + Control.Monad.CC.Prompt +Extensions: MultiParamTypeClasses, + UndecidableInstances, + FunctionalDependencies, + Rank2Types, + GeneralizedNewtypeDeriving +GHC-Options: -O2 + diff --git a/Control/Monad/CC.hs b/Control/Monad/CC.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/CC.hs @@ -0,0 +1,326 @@ +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FunctionalDependencies #-} + +-------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.CC +-- Copyright : (c) R. Kent Dybvig, Simon L. Peyton Jones and Amr Sabry +-- License : MIT +-- +-- Maintainer : Dan Doel +-- Stability : Experimental +-- Portability : Non-portable (rank-2 types, multi-parameter type classes, +-- functional dependencies) +-- +-- A monadic treatment of delimited continuations. +-- +-- Adapted from the paper +-- /A Monadic Framework for Delimited Continuations/, +-- by R. Kent Dybvig, Simon Peyton Jones and Amr Sabry +-- () +-- +-- This module implements the delimited continuation monad and transformer, +-- using the sequence-of-frames implementation from the original paper. +module Control.Monad.CC ( + -- * The CC monad + CC(), + runCC, + -- * The CCT monad transformer + CCT(), + runCCT, + SubCont(), + Prompt, + MonadDelimitedCont(..), + -- * Assorted useful control operators + reset, + shift, + control, + shift0, + control0, + abort + -- * examples + -- $examples + ) where + +import Control.Monad.Identity +import Control.Monad.State +import Control.Monad.Reader +import Control.Monad.Trans + +import Control.Monad.CC.Seq +import Control.Monad.CC.Prompt + +newtype Frame m ans a b = Frame (a -> CCT ans m b) + +type Cont ans m a = Seq (Frame m) ans a +newtype SubCont ans m a b = SC (SubSeq (Frame m) ans a b) + +-- | The CCT monad transformer allows you to layer delimited control +-- effects over an arbitrary monad. +-- +-- The CCT transformer is parameterized by the following types +-- +-- * ans : A region parameter, so that prompts and subcontinuations +-- may only be used in the same region they are created. +-- +-- * m : the underlying monad +-- +-- * a : The contained value. A value of type CCT ans m a can be though +-- of as a computation that calls its continuation with a value of +-- type 'a' +newtype CCT ans m a = CCT { unCCT :: Cont ans m a -> P ans m ans } + +instance (Monad m) => Monad (CCT ans m) where + return v = CCT $ \k -> appk k v + (CCT e1) >>= e2 = CCT $ \k -> e1 (PushSeg (Frame e2) k) + +instance MonadTrans (CCT ans) where + lift m = CCT $ \k -> lift m >>= appk k + +instance (MonadReader r m) => MonadReader r (CCT ans m) where + ask = lift ask + local f m = CCT $ \k -> local f (unCCT m k) + +instance (MonadState s m) => MonadState s (CCT ans m) where + get = lift get + put = lift . put + +instance (MonadIO m) => MonadIO (CCT ans m) where + liftIO = lift . liftIO + +-- Applies a continuation to a value. +appk :: Monad m => Cont ans m a -> a -> P ans m ans +appk EmptyS a = return a +appk (PushP _ k) a = appk k a +appk (PushSeg (Frame f) k) a = unCCT (f a) k + +-- | Executes a CCT computation, yielding a value in the underlying monad +runCCT :: (Monad m) => (forall ans. CCT ans m a) -> m a +runCCT c = runP (unCCT c EmptyS) + +-- | The CC monad may be used to execute computations with delimited control. +newtype CC ans a = CC { unCC :: CCT ans Identity a } + deriving (Monad, MonadDelimitedCont (Prompt ans) (SubCont ans Identity)) + +-- | Executes a CC computation, yielding a resulting value. +runCC :: (forall ans. CC ans a) -> a +runCC c = runIdentity (runCCT (unCC c)) + +-- | A typeclass for monads that support delimited control operators. +-- The type varibles represent the following: +-- +-- m : The monad itself +-- +-- p : The associated type of prompts that may delimit computations in the monad +-- +-- s : The associated type of sub-continuations that may be captured +class (Monad m) => MonadDelimitedCont p s m | m -> p s where + -- | Creates a new, unique prompt. + newPrompt :: m (p a) + -- | Delimits a computation with a given prompt. + pushPrompt :: p a -> m a -> m a + -- | Abortively capture the sub-continuation delimited by the given + -- prompt, and call the given function with it. The prompt does not appear + -- delimiting the sub-continuation, nor the resulting computation. + withSubCont :: p b -> (s a b -> m b) -> m a + -- | Pushes a sub-continuation, reinstating it as part of the continuation. + pushSubCont :: s a b -> m a -> m b + +instance (Monad m) => MonadDelimitedCont (Prompt ans) (SubCont ans m) (CCT ans m) where + newPrompt = CCT $ \k -> newPromptName >>= appk k + pushPrompt p (CCT e) = CCT $ \k -> e (PushP p k) + withSubCont p f = CCT $ \k -> let (subk, k') = splitSeq p k + in unCCT (f (SC subk)) k' + pushSubCont (SC subk) (CCT e) = CCT $ \k -> e (pushSeq subk k) + +-- | An approximation of the traditional /reset/ operator. Creates a new prompt, +-- calls the given function with it, and delimits the resulting computation +-- with said prompt. +reset :: (MonadDelimitedCont p s m) => (p a -> m a) -> m a +reset e = newPrompt >>= \p -> pushPrompt p (e p) + +-- ----- +-- These originally had types like: +-- +-- ((a -> m b) -> m b) -> m a +-- +-- but I came to the conclusion that it would be convenient to be able to pass +-- in monadically typed values. +-- As a specific example, this makes the difference between +-- +-- > shift q (\f -> f (dref p)) +-- +-- and +-- +-- > join $ shift q (\f -> f (dref p)) +-- +-- In other words, one can expressed in terms of the other (I think), but +-- the fact that one has to insert a 'join' /outside/ the shift, and not +-- anywhere near where the sub-continuation is actually used is rather +-- odd, and difficult to remember compared to the difference between: +-- +-- > shift q (\f -> f (return pureValue)) +-- +-- and +-- +-- > shift q (\f -> f pureValue) +-- ----- + +-- | The traditional /shift/ counterpart to the above 'reset'. Reifies the +-- subcontinuation into a function, keeping both the subcontinuation, and +-- the resulting computation delimited by the given prompt. +shift :: (MonadDelimitedCont p s m) => p b -> ((m a -> m b) -> m b) -> m a +shift p f = withSubCont p $ \sk -> pushPrompt p $ + f (\a -> pushPrompt p $ pushSubCont sk a) + +-- | The /control/ operator, traditionally the counterpart of /prompt/. It does +-- not delimit the reified subcontinuation, so control effects therein can +-- escape. The corresponding prompt is performed equally well by 'reset' above. +control :: (MonadDelimitedCont p s m) => p b -> ((m a -> m b) -> m b) -> m a +control p f = withSubCont p $ \sk -> pushPrompt p $ + f (\a -> pushSubCont sk a) + +-- | Abortively captures the current subcontinuation, delimiting it in a reified +-- function. The resulting computation, however, is undelimited. +shift0 :: (MonadDelimitedCont p s m) => p b -> ((m a -> m b) -> m b) -> m a +shift0 p f = withSubCont p $ \sk -> f (\a -> pushPrompt p $ pushSubCont sk a) + +-- | Abortively captures the current subcontinuation, delimiting neither it nor +-- the resulting computation. +control0 :: (MonadDelimitedCont p s m) => p b -> ((m a -> m b) -> m b) -> m a +control0 p f = withSubCont p $ \sk -> f (\a -> pushSubCont sk a) + +-- | Aborts the current continuation up to the given prompt. +abort :: (MonadDelimitedCont p s m) => p b -> m b -> m a +abort p e = withSubCont p (\_ -> e) + +------------------------------------------------------------------------------- +-- $examples +-- +-- This module provides many different control operators, so hopefully the +-- examples herein can help in selecting the right ones. The most raw are the +-- four contained in the 'MonadDelimitedCont' type class. The first, of course, +-- is 'newPrompt', which should be straight forward enough. Next comes +-- 'pushPromp't, which is the basic operation that delimits a computation. +-- In the absense of other control operators, it's simply a no-op, so +-- +-- > pushPrompt p (return v) == return v +-- +-- 'withSubCont' is the primitive that allows the capture of sub-continuations. +-- Unlike callCC, 'withSubCont' aborts the delimited continuation it captures, +-- so: +-- +-- > pushPrompt p ((1:) `liftM` (2:) `liftM` withSubCont p (\k -> return [])) +-- +-- will yield a value of [] on running, not [1, 2]. +-- +-- The final primitive control operator is 'pushSubCont', which allows the use +-- of the sub-continuations captured using 'withSubCont'. So: +-- +-- > pushPrompt p ((1:) `liftM1 (2:) `liftM` +-- > withSubCont p (\k -> pushSubCont k (return []))) +-- +-- will yield the answer [1, 2]. /However/, Capturing a sub-continuation and +-- immediately pusshing it /is not/ a no-op, because the sub-continuation +-- does not contain the delimiting prompt (and, of course, pushSubCont does +-- not re-instate it, as it doesn't know what prompt was originally used). +-- Thus, capturing and pushing a sub-continuation results in the net loss of +-- one delimiter, and said delimiter will need to be re-pushed to negate that +-- effect, if desired. +-- +-- Out of these four primitive operators have been built various functional +-- abstractions that incorporate one or more operations. On the delimiting +-- side is 'reset', which combines both prompt creation and delimiting. In +-- some papers on the subject (such as /Shift to Control/), each capture +-- operator would be paired with a corresponding delimiter operator (and +-- indeed, a separate CPS transform). However, since prompts are explicitly +-- passed in this implementation, a single delimiter suffices for supporting +-- all capture operators (although 'pushPrompt' will need to be used if one +-- wishes to explicitly push a prompt more than once). +-- +-- The simplest control flow operator is 'abort', which, as its name suggests, +-- simply aborts a given sub-continuation. For instance, the second example +-- above can be written: +-- +-- > pushPrompt p ((1:) `liftM` (2:) `liftM` abort p (return [])) +-- +-- The rest of the functions reify the sub-continuation into a function, +-- so that it can be used. The shift/control operators all have similar +-- effects in this regard, but differ as to where they delimit various +-- parts of the resulting computation. Some names may help a bit for the +-- following explanation, so consider: +-- +-- > shift p (\f -> e) +-- +-- /p/ is, obviously, the prompt; /f/ is the reified continuation, and /e/ +-- is the computation that will be run in the aborted context. With these +-- names in mind, the control operators work as follows: +-- +-- * 'shift' delimits both /e/ and every invocation of /f/. So, effectively, +-- when using 'shift', control effects can never escape a delimiter, and +-- computations of the form: +-- +-- > reset (\p -> ) +-- +-- /look/ pure from the outside. +-- +-- * 'control' delimits /e/, but not the sub-continuation in /f/. Thus, if +-- the sub-continuation contains other 'control' invocations, the effects +-- may escape an enclosing delimiter. So, for example: +-- +-- > reset (\p -> shift p (\f -> (1:) `liftM` f (return [])) +-- >>= \y -> shift p (\_ -> return y)) +-- +-- yields a value of [1], while replacing the 'shift's with 'control' +-- yields a value of []. +-- +-- * 'shift0' delimits /f/, but not /e/. So: +-- +-- > reset (\p -> (1:) `liftM` pushPrompt p +-- > (shift0 p (\_ -> shift0 p (\_ -> return [])))) +-- +-- yields [], whereas using 'shift' would yield [1]. +-- +-- * 'control0' delimits neither /e/ nor /f/, and is, in effect, the reified +-- analogue to using withSubCont and pushSubCont directly. +-- +-- For a more complete and in-depth discussion of these four control operators, +-- see /Shift to Control/, by Chung-chieh Shan. +-- +-- A small example program follows. It uses delimited continuations to reify a +-- monadic loop into an iterator object. Saving references to old iterators +-- allows one to effecively store references to various points in the traversal. +-- Effectively, this is a simple, restricted case of a generalized zipper. +-- +-- > data Iterator r a = I a (CC r (Iterator r a)) | Done +-- > +-- > current :: Iterator r a -> Maybe a +-- > current (I a _) = Just a +-- > current Done = Nothing +-- > +-- > next :: Iterator r a -> CC r (Iterator r a) +-- > next (I _ m) = m +-- > next Done = return Done +-- > +-- > iterator :: ((a -> CC r ()) -> CC r ()) -> CC r (Iterator r a) +-- > iterator loop = reset $ \p -> +-- > loop (\a -> +-- > shift p $ \k -> +-- > return $ I a (k $ return ())) >> return Done +-- > +-- > test = do i <- iterator $ forM_ [1..5] +-- > go [] i +-- > where +-- > go l Done = return l +-- > go l i = do let (Just a) = current i +-- > l' = replicate a a ++ l +-- > i' <- next i +-- > go l' i' +-- +-- The results are what one might expect from such an iterator object: +-- +-- > *Test> runCC test +-- > [5,5,5,5,5,4,4,4,4,3,3,3,2,2,1] diff --git a/Control/Monad/CC/Dynvar.hs b/Control/Monad/CC/Dynvar.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/CC/Dynvar.hs @@ -0,0 +1,160 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.CC.Dynvar +-- Copyright : (c) Amr Sabry, Chung-chieh Shan and Oleg Kiselyov +-- License : MIT +-- +-- Maintainer : Dan Doel +-- Stability : Experimental +-- Portability : Non-portable (generalized algebraic datatypes) +-- +-- An implementation of dynamically scoped variables using multi-prompt +-- delimited control operators. This implementation follows that of the +-- paper /Delimited Dynamic Binding/, by Oleg Kiselyov, Chung-chieh Shan and +-- Amr Sabry (), adapting the +-- Haskell implementation (available at +-- ) to any delimited control +-- monad (in practice, this is likely just CC and CCT m). +-- +-- See below for usage examples. +module Control.Monad.CC.Dynvar ( + -- * The Dynvar type + Dynvar(), + dnew, + dref, + dset, + dmod, + dupp, + dlet, + module Control.Monad.CC + -- * examples + -- $examples + ) where + +import Control.Monad + +import Control.Monad.CC + +-- | The type of dynamically scoped variables in a given monad +data Dynvar m a where + Dynvar :: MonadDelimitedCont p s m => p (a -> m a) -> Dynvar m a + +-- | Creates a new dynamically scoped variable +dnew :: MonadDelimitedCont p s m => m (Dynvar m a) +dnew = Dynvar `liftM` newPrompt + +-- | Reads the value of a dynamically scoped variable +dref :: Dynvar m a -> m a +dref (Dynvar p) = shift p (\f -> return $ \v -> f (return v) >>= ($ v)) + +-- | Assigns a value to a dynamically scoped variable +dset :: Dynvar m a -> a -> m a +dset (Dynvar p) newv = shift p (\f -> return $ \v -> f (return v) >>= ($ newv)) + +-- | Modifies the value of a dynamically scoped variable +dmod :: Dynvar m a -> (a -> a) -> m a +dmod p@(Dynvar _) f = dref p >>= dset p . f + +-- | Calls the function, g, with the value of the given Dynvar +dupp :: Dynvar m a -> (a -> m b) -> m b +dupp p@(Dynvar _) g = dref p >>= g + +-- | Introduces a new value to the dynamic variable over a block +dlet :: Dynvar m a -> a -> m b -> m b +dlet (Dynvar p) v body = reset (\q -> + pushPrompt p (body >>= (\z -> abort q (return z))) + >>= ($ v) >>= undefined) + +------------------------------------------------------------------------------- +-- $examples +-- The referenced paper provides a full treatment of the behavior of +-- dynamically scoped variables and their interaction with delimited control. +-- However, some examples might provide some intuition. First, a dynamic +-- scoping example: +-- +-- > dscope = do p <- dnew +-- > x <- dlet p 1 $ f p +-- > y <- dlet p 2 $ f p +-- > z <- dlet p 3 $ do z1 <- (dlet p 4 $ f p) +-- > z2 <- f p +-- > return $ z1 + z2 +-- > return $ x + y + z +-- > where +-- > f p = dref p +-- +-- > *Test> runCC dscope +-- > 10 +-- +-- In this example, x = 1, y = 2, z1 = 4 and z2 = 3, even though +-- all come are from reading the same dynamically scoped variable. dlet +-- introduces a scope in which references of the given variable take on a +-- given value. As can be seen, shadowing works properly when writing code +-- in this fashion. In many ways, this is like using the reader monad, with +-- 'dref p' == 'ask', and 'dlet p v' == 'local (const v)'. The immediate +-- difference, of course, is that you can have multiple dynamic variables +-- instead of the single threaded environment of the reader monad. +-- +-- Of course, one can also use Dynvars mutably, as in the state monad: +-- +-- > settest = do p <- dnew +-- > x <- dlet p 1 $ do x1 <- f p +-- > dset p 2 +-- > x2 <- f p +-- > return $ [x1, x2] +-- > y <- dlet p 0 $ do y1 <- f p +-- > y2 <- dlet p 1 $ do dset p 3 +-- > f p +-- > y3 <- f p +-- > return [y1, y2, y3] +-- > return $ x ++ y +-- > where +-- > f p = dupp p return +-- > +-- > *Test> runCC settest +-- > [1,2,0,3,0] +-- +-- So, with analogy to the state monad, 'dref p' == get, and +-- 'dset p v' == 'put v'. Also, as one might expect, such mutations have +-- effects only within the enclosing 'dlet' (and, in fact, an error will +-- result from trying to 'dset' in a scope in which the dynamic var is not +-- bound with 'dlet'). This example also demonstrates the use of the 'dupp' +-- function, to implement the same 'f' function as the first example. +-- Essentially 'dupp p f' = 'dref p >>= f'. +-- +-- Now, a bit on the interaction between delimited control and dynamic +-- variables. Consider: +-- +-- > test = do p <- dnew +-- > dlet p 5 (reset (\q -> dlet p 6 (shift q (\f -> dref p)))) +-- > +-- > *Test> runCC test +-- > 5 +-- +-- In this example, '... reset (\q ...' introduces a new delimited context, +-- and '... shift q (\f ...' captures that context abortively. This results +-- in the value of 'dref p' being 5, as the 'dlet p 6' resides in the aborted +-- context. Now, consider a slightly more complex example: +-- +-- > test1 = do p <- dnew +-- > dlet p 5 (reset (\q -> +-- > dlet p 6 (shift q (\f -> +-- > liftM2 (+) (dref p) (f (dref p)))))) +-- > +-- > *Test> runCC test1 +-- > 11 +-- +-- Here we use 'dref p' twice. Once as before, after we have abortively captured +-- the context, and thus, the outer binding of p is showing. However, the term +-- 'f (dref p)' reinstitutes the captured context for its arguments, and thus, +-- there, 'dref p' takes on a value of 6. +-- +-- Thus, to sum up, capturing a delimited context captures the dynamic variable +-- bindings *within* that context, but leaves the dynamic bindings *outside* +-- untouched. Similarly, if a context is put back pushed somewhere (for instance, +-- by invoking the function returned by 'shift', it will put the captured +-- dynamic bindings back in place, but will not restore those dynamic bindings +-- outside of the delimited context (it will, instead, use those visible where +-- the context is invoked. + diff --git a/Control/Monad/CC/Prompt.hs b/Control/Monad/CC/Prompt.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/CC/Prompt.hs @@ -0,0 +1,78 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.CC.Prompt +-- Copyright : (c) R. Kent Dybvig, Simon L. Peyton Jones and Amr Sabry +-- License : MIT +-- +-- Maintainer : Dan Doel +-- Stability : Experimental +-- Portability : Non-portable (rank-2 types, generalized algebraic datatypes) +-- +-- A monadic treatment of delimited continuations. +-- +-- Adapted from the paper +-- /A Monadic Framework for Delimited Continuations/, +-- by R. Kent Dybvig, Simon Peyton Jones and Amr Sabry +-- () +-- +-- This module implements the generation of unique prompt names to be used +-- as delimiters. +module Control.Monad.CC.Prompt ( + -- * P, The prompt generation monad + P, + -- * The Prompt type + Prompt, + runP, + newPromptName, + eqPrompt, + -- * A type equality datatype + Equal(..) + ) where + +import Control.Monad.State +import Control.Monad.Reader +import Control.Monad.Trans + +import Unsafe.Coerce + +-- | The prompt type, parameterized by two types: +-- * ans : The region identifier, used to ensure that prompts are only used +-- within the same context in which they are created. +-- +-- * a : The type of values that may be returned 'through' a given prompt. +-- For instance, only prompts of type 'Prompt r a' may be pushed onto a +-- computation of type 'CC r a'. +newtype Prompt ans a = Prompt Int + +-- | The prompt generation monad. Represents the type of computations that +-- make use of a supply of unique prompts. +newtype P ans m a = P { unP :: StateT Int m a } + deriving (Functor, Monad, MonadTrans, MonadState Int, MonadReader r) + +-- | Runs a computation that makes use of prompts, yielding a result in the +-- underlying monad. +runP :: (Monad m) => P ans m ans -> m ans +runP p = evalStateT (unP p) 0 + +-- | Generates a new, unique prompt +newPromptName :: (Monad m) => P ans m (Prompt ans a) +newPromptName = do i <- get ; put (succ i) ; return (Prompt i) + +-- | A datatype representing type equality. The EQU constructor can +-- be used to provide evidence that two types are equivalent. +data Equal a b where + EQU :: Equal a a + NEQ :: Equal a b + +-- Unfortunately, the type system cannot check that the value of two prompts being +-- equal ensures the equality of their types, so unsafeCoerce must be used. + +-- | Tests to determine if two prompts are equal. If so, it provides +-- evidence of that fact, in the form of an /Equal/. +eqPrompt :: Prompt ans a -> Prompt ans b -> Equal a b +eqPrompt (Prompt p1) (Prompt p2) + | p1 == p2 = unsafeCoerce EQU + | otherwise = NEQ + diff --git a/Control/Monad/CC/Seq.hs b/Control/Monad/CC/Seq.hs new file mode 100644 --- /dev/null +++ b/Control/Monad/CC/Seq.hs @@ -0,0 +1,76 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.CC.Seq +-- Copyright : (c) R. Kent Dybvig, Simon L. Peyton Jones and Amr Sabry +-- License : MIT +-- +-- Maintainer : Dan Doel +-- Stability : Experimental +-- Portability : Non-portable (generalized algebraic datatypes) +-- +-- A monadic treatment of delimited continuations. +-- +-- Adapted from the paper +-- /A Monadic Framework for Delimited Continuations/, +-- by R. Kent Dybvig, Simon Peyton Jones and Amr Sabry +-- () +-- +-- This module implements the generalized sequence type used as a stack of +-- frames representation of the delimited continuations. +module Control.Monad.CC.Seq ( + -- * Sequence datatype + Seq(..), + -- * Sub-sequences + SubSeq, + appendSubSeq, + pushSeq, + splitSeq, + ) where + +import Control.Monad.CC.Prompt + +-- | This is a generalized sequence datatype, parameterized by three types: +-- seg : A constructor for segments of the sequence. +-- +-- ans : the type resulting from applying all the segments of the sequence. +-- Also used as a region parameter. +-- +-- a : The type expected as input to the sequence of segments. +data Seq seg ans a where + EmptyS :: Seq seg ans ans + PushP :: Prompt ans a -> Seq seg ans a -> Seq seg ans a + PushSeg :: seg ans a b -> Seq seg ans b -> Seq seg ans a + +-- | A type representing a sub-sequence, which may be appended to a sequence +-- of appropriate type. It represents a sequence that takes values of type +-- a to values of type b, and may be pushed onto a sequence that takes values +-- of type b to values of type ans. +type SubSeq seg ans a b = Seq seg ans b -> Seq seg ans a + +-- | The null sub-sequence +emptySubSeq :: SubSeq seg ans a a +emptySubSeq = id + +-- | Concatenate two subsequences +appendSubSeq :: SubSeq seg ans a b -> SubSeq seg ans b c -> SubSeq seg ans a c +appendSubSeq = (.) + +-- | Push a sub-sequence onto the front of a sequence +pushSeq :: SubSeq seg ans a b -> Seq seg ans b -> Seq seg ans a +pushSeq = ($) + +-- | Splits a sequence at the given prompt into a sub-sequence, and +-- the rest of the sequence +splitSeq :: Prompt ans b -> Seq seg ans a -> (SubSeq seg ans a b, Seq seg ans b) +splitSeq p EmptyS = error "Prompt was not found on the stack." +splitSeq p (PushP p' sk) = + case eqPrompt p' p of + EQU -> (emptySubSeq, sk) + NEQ -> case splitSeq p sk of + (subk, sk') -> (appendSubSeq (PushP p') subk, sk') +splitSeq p (PushSeg seg sk) = + case splitSeq p sk of + (subk, sk') -> (appendSubSeq (PushSeg seg) subk, sk') + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,67 @@ +The code in this library is derived from several sources: + + * Code for the implementation of delimited continuations (Control.Monad.CC, + Control.Monad.CC.Prompt, Control.Monad.CC.Seq) is derived from work + (c) R. Kent Dybvig, Simon L. Peyton Jones and Amr Sabry. + + * Code for dynamically scoped variables (Control.Monad.CC.Dynvar) is derived + from work (c) Amr Sabry, Chung-chieh Shan and Oleg Kiselyov. + + * Additional modifications and improvements (c) Dan Doel and Oleg Kiselyov + +All code is available under the MIT license. The text of the licenses from the +original sources is reproduced below. + +------------------------------------------------------------------------------- + +Code derived from "A Monadic Framework for Delimited Continuations" is +distributed under the following license: + +Copyright (c) 2005, R. Kent Dybvig, Simon L. Peyton Jones, and Amr Sabry + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +------------------------------------------------------------------------------- + +Code derived from "Delimited Dynamic Binding" and its implementation is +distributed under the following license: + +Copyright (c) 2006, Amr Sabry, Chung-chieh Shan, and Oleg Kiselyov + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +------------------------------------------------------------------------------- diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain