packages feed

CC-delcont 0.1 → 0.2

raw patch · 6 files changed

+185/−23 lines, 6 files

Files

CC-delcont.cabal view
@@ -1,5 +1,5 @@ Name:                   CC-delcont-Version:                0.1+Version:                0.2 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@@ -15,23 +15,29 @@ Category:               Control License:                OtherLicense License-File:           LICENSE-Copyright:              Copyright (c) 2005--2007, R. Kent Dybvig, Simon Peyton Jones,+Copyright:              Copyright (c) 2005--2008, 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+Build-Type:             Simple+ Exposed-Modules:        Control.Monad.CC,                         Control.Monad.CC.Dynvar,                         Control.Monad.CC.Seq,-                        Control.Monad.CC.Prompt+                        Control.Monad.CC.Prompt,+                        Control.Monad.CC.Cursor Extensions:             MultiParamTypeClasses,                         UndecidableInstances,                         FunctionalDependencies,                         Rank2Types,-                        GeneralizedNewtypeDeriving-GHC-Options:            -O2+                        GeneralizedNewtypeDeriving,+                        FlexibleInstances,+                        GADTs+GHC-Options:            -O2 -Wall
Control/Monad/CC.hs view
@@ -1,8 +1,5 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE Rank2Types, GeneralizedNewtypeDeriving, MultiParamTypeClasses,+    UndecidableInstances, FunctionalDependencies, FlexibleInstances, GADTs #-}  -------------------------------------------------------------------------- -- |@@ -41,10 +38,12 @@         shift0,         control0,         abort-        -- * examples-        -- $examples+        -- * Examples+        -- $Examples     ) where +import Control.Applicative+ import Control.Monad.Identity import Control.Monad.State import Control.Monad.Reader@@ -53,7 +52,9 @@ import Control.Monad.CC.Seq import Control.Monad.CC.Prompt -newtype Frame m ans a b = Frame (a -> CCT ans m b)+-- newtype Frame m ans a b = Frame (a -> CCT ans m b)+data Frame m ans a b = FFrame (a -> b)+                     | MFrame (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)@@ -73,9 +74,16 @@ --         type 'a' newtype CCT ans m a = CCT { unCCT :: Cont ans m a -> P ans m ans } +instance (Monad m) => Functor (CCT ans m) where+    fmap f (CCT e) = CCT $ \k -> e (PushSeg (FFrame f) k)++instance (Monad m) => Applicative (CCT ans m) where+    pure  = return+    (<*>) = ap+ 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)+    (CCT e1) >>= e2 = CCT $ \k -> e1 (PushSeg (MFrame e2) k)  instance MonadTrans (CCT ans) where     lift m = CCT $ \k -> lift m >>= appk k@@ -93,9 +101,12 @@  -- 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+appk EmptyS        a = return a+appk (PushP _ k)   a = appk k a+appk (PushSeg f k) a = appFrame f a k+ where+ appFrame (MFrame g) b l = unCCT (g b) l+ appFrame (FFrame g) b l = appk l (g b)  -- | Executes a CCT computation, yielding a value in the underlying monad runCCT :: (Monad m) => (forall ans. CCT ans m a) -> m a@@ -103,7 +114,8 @@  -- | 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))+    deriving (Functor, Monad, Applicative, +                MonadDelimitedCont (Prompt ans) (SubCont ans Identity))  -- | Executes a CC computation, yielding a resulting value. runCC  :: (forall ans. CC ans a) -> a@@ -198,7 +210,7 @@ abort p e = withSubCont p (\_ -> e)  ---------------------------------------------------------------------------------- $examples+-- $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
+ Control/Monad/CC/Cursor.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE GADTs, MultiParamTypeClasses, FunctionalDependencies  #-}++-------------------------------------------------------------------------------+-- |+-- Module      : Control.Monad.CC.Cursor+-- Copyright   : (c) Dan Doel+-- License     : MIT+--+-- Maintainer  : Dan Doel+-- Stability   : Experimental+-- Portability : Non-portable (Generalized algebraic data types,+--                             Functional Dependencies)+--+-- Implements various cursor datatypes for iterating over collections+module Control.Monad.CC.Cursor (+        Cursor(..),+        Iterator,+        generator,+        iterator,+        current,+        next,+        open,+        update,+--        Walkable(..),+--        Zipper,+--        zipper,+--        previousDir,+--        currentTerm,+--        move+    ) where++import Prelude hiding (zip, mapM, mapM_)+import Control.Monad hiding (mapM, mapM_)+import Control.Monad.CC++import Data.Maybe+import Data.Foldable+import Data.Traversable hiding (traverse)++-- | A generalized type that represents a reified data structure traversal.+-- The other traversal data types in this module are special cases of this+-- general type. Cursor is parameterized by four types:+--+-- m : The monad in which the Cursor object is usable.+--+-- r : The result type, which will be stored in the cursor once the traversal+--     has been completed.+--+-- b : The type that the cursor expects to receive before moving on to the+--     next element in the traversal.+--+-- a : The element type to which the Cursor provides access at each step in+--     the traversal.+data Cursor m r b a where+   Current :: Monad m => a -> (b -> m (Cursor m r b a)) -> Cursor m r b a+   Done    :: Monad m => r -> Cursor m r b a++-- | A simple iterator, which provides a way to view each of the elements of+-- a data structure in order.+type Iterator m a = Cursor m () () a++-- | A function for making a cursor out of a free form generator, similar to+-- using 'yield' in Ruby or Python. For example:+--+-- > generator $ \yield -> do a <- yield 1 ; yield 2 ; b <- yield 3 ; return [a,b]+generator :: MonadDelimitedCont p s m => ((a -> m b) -> m r) -> m (Cursor m r b a)+generator f = reset (\p -> Done `liftM` f (yield p))+ where yield p a = shift p (\k -> return $ Current a (k . return))++-- A general cursor builder; takes the traversal function, a data structure, and+-- returns a corresponding cursor. Currently not exported, just used internally.+makeCursor :: (MonadDelimitedCont p s m) =>+                ((a -> m b) -> t -> m r) -> t -> m (Cursor m r b a)+makeCursor iter t = generator $ flip iter t++-- | Creates an Iterator that will yield each of the elements of a Foldable in+-- order.+iterator :: (Foldable t, MonadDelimitedCont p s m) => t a -> m (Iterator m a)+iterator = makeCursor mapM_++-- | Advances an Iterator to the next element (has no effect on a finished Iterator).+next :: Iterator m a -> m (Iterator m a)+next = update ()++-- | Extracts the current element from a cursor, if applicable.+current :: Cursor m r b a -> Maybe a+current (Done _)      = Nothing+current (Current a _) = Just a++-- | Begins an updating traversal over a Traversable structure. At each step,+-- the cursor will hold an element of type a, and providing an element of type+-- b will move on to the next step. When done, a new Traversable object holding+-- elements of type b will be available.+open :: (Traversable t, MonadDelimitedCont p s m) => t a -> m (Cursor m (t b) b a)+open = makeCursor mapM++-- | Provides an item to a Cursor, moving on to the next step in the traversal.+-- (has no effect on a finished Cursor).+update :: b -> Cursor m r b a -> m (Cursor m r b a)+update _ c@(Done _)    = return c+update b (Current _ k) = k b++-- Removing for now. This isn't remotely done, and I need to reread ccshan's+-- stuff on zippers and such before I can begin to get it right.+{-+class Direction d where+    nextD :: d -> d++class Direction d => Walkable t d | t -> d where+    walk :: Monad m => (d -> t -> m (Maybe t, d)) -> t -> m t++data ListDir = LLeft | LRight++instance Direction ListDir where+    nextD = id++instance Walkable [a] ListDir where+    walk tr ll = fromMaybe ll `liftM` traverse LRight ll+     where+     traverse d l = do (ml, d') <- tr d l+                       let l' = fromMaybe l ml+                       maybe ml Just `liftM` select l' d'+     select _        LLeft  = return Nothing+     select l@(x:xs) LRight = do l' <- liftM (x:) `liftM` traverse LRight xs+                                 maybe l' Just `liftM` traverse LLeft (fromMaybe l l')+     select []       LRight = maybe Nothing Just `liftM` traverse LLeft []++type Zipper m t d = Cursor m t (Maybe t, d) (d,t)++zipper :: (MonadDelimitedCont p s m, Walkable t d) => t -> m (Zipper m t d)+zipper = makeCursor $ walk . curry++previousDir :: Zipper m t d -> Maybe d+previousDir (Done _)          = Nothing+previousDir (Current (d,_) _) = Just d++currentTerm :: Zipper m t d -> t+currentTerm (Done t)          = t+currentTerm (Current (_,t) _) = t++move :: d -> Zipper m t d -> m (Zipper m t d)+move _ z@(Done _) = return z+move d (Current _ k) = k (Nothing, d)+-}
Control/Monad/CC/Dynvar.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE GADTs #-}  ------------------------------------------------------------------------------- -- |
Control/Monad/CC/Prompt.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving #-}  ------------------------------------------------------------------------------- -- |
Control/Monad/CC/Seq.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE GADTs #-}  ------------------------------------------------------------------------------- -- |@@ -64,7 +64,7 @@ -- | 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 _ EmptyS = error "Prompt was not found on the stack." splitSeq p (PushP p' sk) =     case eqPrompt p' p of          EQU -> (emptySubSeq, sk)