explicit-sharing 0.8 → 0.9

raw patch · 12 files changed

+163/−374 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Monad/Sharing.hs +34/−4
• Control/Monad/Sharing/Classes.hs +34/−3
• Control/Monad/Sharing/FirstOrder.hs +0/−29
• Control/Monad/Sharing/Implementation/CPS.hs +18/−37
• Control/Monad/Sharing/Implementation/FirstOrder.hs +0/−120
• Control/Monad/Sharing/Implementation/SlowState.hs +0/−55
• Control/Monad/Sharing/Implementation/SlowStateCPS.hs +0/−60
• Test.hs +38/−28
• explicit-sharing.cabal +8/−8
• last.hs +12/−9
• permsort.hs +8/−12
• reverse.hs +11/−9

@@ -1,3 +1,7 @@+{-# LANGUAGE RankNTypes,+             FlexibleInstances+  #-}+ -- |  -- Module      : Control.Monad.Sharing -- Copyright   : Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer@@ -16,14 +20,40 @@    Sharing(..), Shareable(..), Convertible(..), -  -- * Monad transformer+  -- * Observation functions -  Lazy, evalLazy, runSharing+  collect, hasResult, results, resultDist, +  resultList, unsafeResults+  ) where  import Control.Monad import Control.Monad.Sharing.Classes import Control.Monad.Sharing.Implementation.CPS--- import Control.Monad.Sharing.Implementation.SlowState--- import Control.Monad.Sharing.Implementation.SlowStateCPS++import qualified Data.Set as Set+import qualified Data.Map as Map++hasResult :: (forall s . Sharing s => s a) -> Bool+hasResult a = collect (liftM (const True) a)++results :: Ord a => (forall s . Sharing s => s a) -> Set.Set a+results a = collect (liftM Set.singleton a)++resultDist :: Ord a => (forall s . Sharing s => s a) -> Map.Map a Rational+resultDist a = collect (liftM (`Map.singleton`1) a)++newtype UnsafeResults a = Unsafe { unsafe :: [a] }++instance Nondet (UnsafeResults a) where+  failure = Unsafe []++  -- does not satisfy required laws+  a ? b = Unsafe (unsafe a ++ unsafe b)++unsafeResults :: (forall s . Sharing s => s a) -> [a]+unsafeResults a = unsafe (collect (liftM (Unsafe . (:[])) a))++resultList :: (forall s . Sharing s => s a) -> IO [a]+resultList a = return (unsafeResults a)

@@ -19,21 +19,26 @@ -- sharing. module Control.Monad.Sharing.Classes ( -  Sharing(..), Shareable(..), Convertible(..),+  Sharing(..), Shareable(..), Convertible(..), Nondet(..),    MInt, MChar, MBool   ) where +import Control.Monad ( MonadPlus )++import qualified Data.Set as Set+import qualified Data.Map as Map+ -- | Interface of monads that support explicit sharing.-class Sharing m+class MonadPlus s => Sharing s  where   -- |    -- Yields an action that returns the same results as the given   -- action but whose effects are only executed once. Especially, when   -- the resulting action is duplicated it returns the same result at   -- every occurrence.-  share :: Shareable m a => m a -> m (m a)+  share :: Shareable s a => s a -> s (s a)  -- | -- Interface of shareable nested monadic data types. The provided@@ -185,3 +190,29 @@ instance (Monad m, Convertible m a b) => Convertible m [m a] [b]  where   convert = mapM (>>=convert)++-- |++-- Instances of this class can be used to observe non-deterministic+-- computations with sharing. The function '?' must satisfy the+-- following laws:+--+-- @+--                 a ? a  =  a+--     (a ? b) ? (c ? d)  =  (a ? c) ? (b ? d)+-- @+class Nondet n where+  failure :: n+  (?)     :: n -> n -> n++instance Nondet Bool where+  failure = False+  (?)     = (||)++instance Ord a => Nondet (Set.Set a) where+  failure = Set.empty+  (?)     = Set.union++instance Ord a => Nondet (Map.Map a Rational) where+  failure = Map.empty+  d1 ? d2 = Map.map (/2) $ Map.unionWith (+) d1 d2

@@ -1,29 +0,0 @@--- | --- Module      : Control.Monad.Sharing.FirstOrder--- Copyright   : Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer--- License     : PublicDomain--- Maintainer  : Sebastian Fischer <mailto:sebf@informatik.uni-kiel.de>--- Stability   : experimental--- --- This library provides an interface to monads that support explicit--- sharing based on two-level types. This implementation is not as--- efficient as the default implementation but supports a restricted--- form of sharing across non-determinism if a first-order data type--- is used as underlying monad.-module Control.Monad.Sharing.FirstOrder (--  module Control.Monad,--  -- * Classes--  Sharing(..), Shareable(..), Convertible(..),--  -- * Monad transformer--  Lazy, evalLazy-- ) where--import Control.Monad-import Control.Monad.Sharing.Classes-import Control.Monad.Sharing.Implementation.FirstOrder

@@ -19,7 +19,7 @@ -- performance. module Control.Monad.Sharing.Implementation.CPS ( -  Lazy, runLazy, evalLazy, runSharing,+  collect,    Store, emptyStore, freshLabel, lookupValue, storeValue, @@ -29,7 +29,6 @@  import Control.Monad       ( MonadPlus(..) ) import Control.Monad.State ( MonadState(..), gets, modify )-import Control.Monad.Trans ( MonadTrans(..), MonadIO(..) )  import Control.Monad.Sharing.Classes @@ -42,32 +41,24 @@  -- | -- Continuation-based, store-passing implementation of explicit--- sharing. It is an inlined version of @ContT (ReaderT Store m)@--- where the result type of continuations is polymorphic.-newtype Lazy m a = Lazy {+-- sharing. It is an inlined version of @ContT n (Reader Store)@.+newtype Lazy n a = Lazy {    -- |-  -- Runs a computation of type @Lazy m a@ with given continuation and+  -- Runs a computation of type @Lazy n a@ with given continuation and   -- store.-  fromLazy :: forall w . (a -> Store -> m w) -> Store -> m w+  fromLazy :: (a -> Store -> n) -> Store -> n  } -runSharing :: MonadPlus m => (forall s.(MonadPlus s,Sharing s) => s a) -> m a-runSharing a = runLazy a---- |--- Lifts all monadic effects to the top-level and unwraps the monad--- transformer for explicit sharing.-evalLazy :: (Monad m, Convertible (Lazy m) a b) => Lazy m a -> m b-evalLazy m = runLazy (m >>= convert)-{-# DEPRECATED evalLazy "Please use runSharing instead" #-}+collect :: Nondet n => (forall s. Sharing s => s n) -> n+collect a = runLazy a  -- private declarations -runLazy :: Monad m => Lazy m a -> m a-runLazy m = fromLazy m (\a _ -> return a) emptyStore+runLazy :: Nondet n => Lazy n n -> n+runLazy m = fromLazy m (\a _ -> a) emptyStore --   fromLazy m---     (\a s -> trace ("used refs: "++show (nextLabel s-1)) (return a))+--     (\a s -> trace ("used refs: "++show (nextLabel s-1)) a) --     emptyStore  -- Stores consist of a fresh-reference counter and a heap represented@@ -90,36 +81,26 @@  -- The monad instance is an inlined version of the instances for -- continuation and reader monads.-instance Monad m => Monad (Lazy m)+instance Nondet n => Monad (Lazy n)  where   return x = Lazy (\c -> c x)   a >>= k  = Lazy (\c s -> fromLazy a (\x -> fromLazy (k x) c) s)-  fail err = Lazy (\_ _ -> fail err)+  fail _   = Lazy (\_ _ -> failure)  -- The 'MonadPlus' instance reuses corresponding operations of the--- base monad.-instance MonadPlus m => MonadPlus (Lazy m)+-- underlying 'Nondet' instance.+instance Nondet n => MonadPlus (Lazy n)  where-  mzero       = Lazy (\_ _ -> mzero)-  a `mplus` b = Lazy (\c s -> fromLazy a c s `mplus` fromLazy b c s)+  mzero       = Lazy (\_ _ -> failure)+  a `mplus` b = Lazy (\c s -> fromLazy a c s ? fromLazy b c s)  -- A Cont/Reader monad is an instance of MonadState-instance Monad m => MonadState Store (Lazy m)+instance Nondet n => MonadState Store (Lazy n)  where   get   = Lazy (\c s -> c s s)   put s = Lazy (\c _ -> c () s) --- 'Lazy' is a monad transformer.-instance MonadTrans Lazy- where-  lift a = Lazy (\c s -> a >>= flip c s)---- If the underlying monad supports IO we can lift this functionality.-instance MonadIO m => MonadIO (Lazy m)- where-  liftIO = lift . liftIO--instance Monad m => Sharing (Lazy m)+instance Nondet n => Sharing (Lazy n)  where   share a = memo (a >>= shareArgs share) 

@@ -1,120 +0,0 @@-{-# LANGUAGE ExistentialQuantification, -             MultiParamTypeClasses,-             FlexibleContexts,-             RelaxedPolyRec-  #-}---- | --- Module      : Control.Monad.Sharing.Implementation.FirstOrder--- Copyright   : Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer--- License     : PublicDomain--- Maintainer  : Sebastian Fischer <mailto:sebf@informatik.uni-kiel.de>--- Stability   : experimental--- --- Implements a monad transformer for explicit sharing.-module Control.Monad.Sharing.Implementation.FirstOrder (--  Lazy, evalLazy-- ) where--import Control.Monad       ( MonadPlus(..), liftM )--- import Control.Monad.State ( MonadState(..), StateT, evalStateT )-import Control.Monad.Trans ( MonadTrans(..), MonadIO(..) )--import Control.Monad.Sharing.Classes--import qualified Control.Monad.Sharing.Implementation.CPS as CPS-import Control.Monad.Sharing.Implementation.CPS- ( -- Store, emptyStore, -   freshLabel, lookupValue, storeValue )---- | --- Monad transformer that adds explicit sharing capability to every--- monad.-newtype Lazy m a = Lazy { fromLazy :: m (Labeled m a) }---- |--- Lifts all monadic effects to the top-level and unwraps the monad--- transformer for explicit sharing.-evalLazy :: (Monad m, Shareable (Lazy m) a, Convertible (Lazy m) a b)-         => Lazy m a -> m b-evalLazy m = do Lifted a <- fromLazy (evalS (gnf m) >>= convert)-                return a---- type S m a = StateT Store m a-type S m a = CPS.Lazy m a--evalS :: Monad m => S m a -> m a--- evalS m = evalStateT m emptyStore-evalS = CPS.runLazy---- using 'CPS.Lazy' instead of 'StateT Store' is almost twice as fast.---- private declarations             --data Labeled m a-  = Lifted a-  | WithFresh (Int -> Lazy m a)-  | forall b . Shareable (Lazy m) b => Labeled Int (Lazy m b) (b -> Lazy m a)---gnf :: (Monad m, Shareable (Lazy m) a) => Lazy m a -> S (Lazy m) a-gnf a = hnf a >>= shareArgs (liftM return . gnf)--hnf :: Monad m => Lazy m a -> S (Lazy m) a-hnf m = run =<< lift (lift (fromLazy m))--run :: Monad m => Labeled m a -> S (Lazy m) a-run (Lifted a)      = return a-run (WithFresh f)   = hnf . f =<< freshLabel-run (Labeled n a f) = do thunk <- lookupValue n-                         case thunk of-                           Just c  -> hnf (f c)-                           Nothing -> do x <- labelArgs a-                                         storeValue n x-                                         hnf (f x)--labelArgs :: (Monad m, Shareable (Lazy m) a) => Lazy m a -> S (Lazy m) a-labelArgs a = hnf a >>= shareArgs (\x -> do n <- freshLabel-                                            return (setLabel n x.:a))---- some type trickery to identify monads-(.:) :: Lazy m a -> Lazy m b -> Lazy m a-(.:) = const--setLabel :: (Monad m, Shareable (Lazy m) a) => Int -> Lazy m a -> Lazy m a-setLabel n x = Lazy (return (Labeled n x return))--instance Monad m => Monad (Lazy m)- where-  return  = Lazy . return . Lifted-  a >>= k = Lazy (fromLazy a >>= bind k)-  fail    = Lazy . fail--bind :: Monad m => (a -> Lazy m b) -> Labeled m a -> m (Labeled m b)-bind k (Lifted a)      = fromLazy (k a)-bind k (WithFresh f)   = return (WithFresh (\n -> f n >>= k))-bind k (Labeled n m f) = return (Labeled n m (\x -> f x >>= k))---- The 'MonadPlus' instance reuses corresponding operations of the--- base monad.-instance MonadPlus m => MonadPlus (Lazy m)- where-  mzero       = Lazy mzero-  a `mplus` b = Lazy (fromLazy a `mplus` fromLazy b)---- 'Lazy t' is a monad transformer.-instance MonadTrans Lazy- where-  lift = Lazy . liftM Lifted---- If the underlying monad supports IO we can lift this functionality.-instance MonadIO m => MonadIO (Lazy m)- where-  liftIO = lift . liftIO---- The @Sharing@ instance introduces the internal sharing constructors.-instance Monad m => Sharing (Lazy m)- where-  share a = Lazy (return (WithFresh (\n -> return (setLabel n a))))

@@ -1,55 +0,0 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}--module Control.Monad.Sharing.Implementation.SlowState (--  Lazy, evalLazy,--  ThunkStore, Thunk(..), emptyThunks, getFreshKey, lookupThunk, insertThunk-- ) where--import Data.Maybe ( fromJust )-import Control.Monad.State--import qualified Data.IntMap as M--import Control.Monad.Sharing.Classes-import Control.Monad.Sharing.Implementation.CPS ( Untyped(..), typed )--type Lazy m = StateT ThunkStore m--evalLazy :: (Monad m, Convertible (Lazy m) a b) => Lazy m a -> m b-evalLazy m = evalStateT (m >>= convert) emptyThunks--instance Monad m => Sharing (StateT ThunkStore m)- where-  share a = memo (a >>= shareArgs share)--memo :: MonadState ThunkStore m => m a -> m (m a)-memo a = do key <- getFreshKey-            insertThunk key (Uneval a)-            return $ do thunk <- lookupThunk key-                        case thunk of-                          Eval x   -> return x-                          Uneval b -> do x <- b-                                         insertThunk key (Eval x)-                                         return x--data ThunkStore = ThunkStore { nextLabel :: Int, heap :: M.IntMap Untyped }--data Thunk m a = Uneval (m a) | Eval a--emptyThunks :: ThunkStore-emptyThunks = ThunkStore 1 M.empty--getFreshKey :: MonadState ThunkStore m => m Int-getFreshKey = do s <- get-                 put (s { nextLabel = nextLabel s + 1 })-                 return (nextLabel s)--lookupThunk :: MonadState ThunkStore m => Int -> m (Thunk m a)-lookupThunk k = gets (typed . fromJust . M.lookup k . heap)--insertThunk :: MonadState ThunkStore m => Int -> a -> m ()-insertThunk k v = modify (\s -> s { heap = M.insert k (Untyped v) (heap s) })-

@@ -1,60 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, Rank2Types #-}--module Control.Monad.Sharing.Implementation.SlowStateCPS (--  Lazy, evalLazy-- ) where--import Control.Monad.State--import Control.Monad.Sharing.Classes-import Control.Monad.Sharing.Implementation.SlowState hiding ( Lazy, evalLazy )--newtype Lazy m a = Lazy {-  fromLazy :: forall w . (a -> ThunkStore -> m w) -> ThunkStore -> m w- }--evalLazy :: (Monad m, Convertible (Lazy m) a b) => Lazy m a -> m b-evalLazy m = runLazy (m >>= convert)--runLazy :: Monad m => Lazy m a -> m a-runLazy m = fromLazy m (\a _ -> return a) emptyThunks--instance Monad m => Monad (Lazy m)- where-  return x = Lazy (\c -> c x)-  a >>= k  = Lazy (\c s -> fromLazy a (\x -> fromLazy (k x) c) s)-  fail err = Lazy (\_ _ -> fail err)--instance MonadPlus m => MonadPlus (Lazy m)- where-  mzero       = Lazy (\_ _ -> mzero)-  a `mplus` b = Lazy (\c s -> fromLazy a c s `mplus` fromLazy b c s)--instance Monad m => MonadState ThunkStore (Lazy m)- where-  get   = Lazy (\c s -> c s s)-  put s = Lazy (\c _ -> c () s)--instance MonadTrans Lazy- where-  lift a = Lazy (\c s -> a >>= flip c s)--instance MonadIO m => MonadIO (Lazy m)- where-  liftIO = lift . liftIO--instance Monad m => Sharing (Lazy m)- where-  share a = memo (a >>= shareArgs share)--memo :: MonadState ThunkStore m => m a -> m (m a)-memo a = do key <- getFreshKey-            insertThunk key (Uneval a)-            return $ do thunk <- lookupThunk key-                        case thunk of-                          Eval x   -> return x-                          Uneval b -> do x <- b-                                         insertThunk key (Eval x)-                                         return x

@@ -2,8 +2,10 @@      NoMonomorphismRestriction,      MultiParamTypeClasses,      OverlappingInstances,+     IncoherentInstances,      FlexibleInstances,-     FlexibleContexts+     FlexibleContexts,+     RankNTypes   #-}  import Control.Monad.Sharing@@ -46,9 +48,10 @@  where   convert (x,y) = return (,) `ap` (x >>= convert) `ap` (y >>= convert) -assertEqual :: (Shareable (Lazy []) a, Convertible (Lazy []) a b, Eq b)-            => [b] -> Lazy [] a -> Bool-assertEqual res test = zipEq (evalLazy test) res+-- assertEqual :: (Shareable (Lazy []) a, Convertible (Lazy []) a b, Eq b)+--             => [b] -> Lazy [] a -> Bool+assertEqual :: Eq a => [a] -> (forall s . Sharing s => s a) -> Bool+assertEqual res test = zipEq (unsafeResults test) res  where   zipEq [] [] = True   zipEq [] _  = False@@ -79,42 +82,47 @@ --      duplicate (const (return 2) (return x))  lazy_share = assertEqual [(2::Int,2::Int)] $-  do x <- share (undefined :: Lazy [] Int)+  do x <- share undef      duplicate (const (return (2::Int)) x) +undef :: Monad m => m Int+undef = undefined+ dupl :: Monad m => m a -> m (List m a) dupl x = cons x (cons x nil)  heads_bind = assertEqual [[0,0::Int],[0,1],[1,0],[1,1]] $ do                x <- cons coin undefined-	       dupl (first (return x))+	       dupl (first (return x)) >>= convert  heads_share = assertEqual [[0,0::Int],[1,1]] $ do                 x <- share (cons coin undefined)-                dupl (first x)+                dupl (first x) >>= convert  coins :: MonadPlus m => m (List m Int) coins = nil `mplus` cons coin coins  dup_first_coin = assertEqual [[0::Int,0],[1,1]] $ do                    cs <- share coins-                   dupl (first cs)+                   dupl (first cs) >>= convert  -- other examples  one_coin = assertEqual [0,1::Int] coin  two_coins = assertEqual [(0,0),(0::Int,1::Int),(1,0),(1,1)] $-              return (coin :: Lazy [] Int, coin :: Lazy [] Int)+              return (coin, coin) >>= convertPair+  where+    convertPair (a,b) = do x <- a; y <- b; return (x,y) -dup_coin = assertEqual [(0::Int,0::Int),(1,1)] $ dup coin+dup_coin = assertEqual [(0::Int,0::Int),(1,1)] $ dup coin >>= convert  dup :: (Monad m, Sharing m, Shareable m a) => m a -> m (m a, m a) dup a = do   x <- share a   return (x,x) -dupnot_coin = assertEqual [(1::Int,1::Int),(0,0)] $ dupnot coin+dupnot_coin = assertEqual [(1::Int,1::Int),(0,0)] $ dupnot coin >>= convert  dupnot a = do   x <- share a@@ -129,52 +137,54 @@  rep_coin = assertEqual [(0::Int,0::Int),(1,1)] $ do              Cons x xs <- rep coin-             return (x, first xs)+             convert (x, first xs)  dup_list = assertEqual [([],[])                        ,([0::Int],[0::Int])                        ,([0,0],[0,0])                        ,([0,0,0],[0,0,0])] $-             dup coins+             dup coins >>= convert -ignore_shared = assertEqual [(0::Int,1::Int)] $ ign_pair mzero+ignore_shared = assertEqual [(0::Int,1::Int)] $ ign_pair mzero >>= convertPair+  where+    convertPair (a,b) = do x <- a; y <- b; return (x,y) -ign_pair :: Lazy [] Int -> Lazy [] (Lazy [] Int,Lazy [] Int)+ign_pair :: Sharing m => m Int -> m (m Int, m Int) ign_pair a = do-  x <- share (a :: Lazy [] Int)+  x <- share a   return (const (return 0) x, const (return 1) x) -empty_rep = assertEqual [False] $ isEmpty (rep (undefined::Lazy [] Int))+empty_rep = assertEqual [False] $ isEmpty (rep undef)  nest_lazy = assertEqual [42::Int] $ do   x <- share (cons (return 42) mzero)-  first x :: Lazy [] Int+  first x  nest_share1 = assertEqual [(0::Int,0::Int),(1,1)] $ do   x <- share (share (return True) >> coin)-  return (x,x)+  convert (x,x)  nest_share2 = assertEqual [(0::Int,0::Int),(1,1)] $ do   x <- share (share coin >>= id)-  return (x,x)+  convert (x,x) -dup_dup = assertEqual [((0::Int,0::Int),(0::Int,0::Int)),((1,1),(1,1))]-            (dup (dup coin :: Lazy [] (Lazy [] Int,Lazy [] Int))-              :: Lazy [] (Lazy [] (Lazy [] Int,Lazy [] Int),-                          Lazy [] (Lazy [] Int,Lazy [] Int)))+dup_dup = assertEqual [((0::Int,0::Int),(0::Int,0::Int)),((1,1),(1,1))] $+            (dup (dup coin)) >>= convert  dup_two_coins = assertEqual [((0::Int,0::Int),(0::Int,0::Int)),((0,1),(0,1))                             ,((1,0),(1,0)),((1,1),(1,1))] $ do   x <- share coin   y <- share coin-  return ( return (x,y) :: Lazy [] (Lazy [] Int, Lazy [] Int)-         , return (x,y) :: Lazy [] (Lazy [] Int, Lazy [] Int))+  convertPair (return (x,y),return (x,y))+ where+  convertPair (a,b) = do x <- a >>= convert; y <- b >>= convert; return (x,y) -dup_head = assertEqual [(0::Int,0::Int),(1,1)] $ heads (cons coin nil)+dup_head = assertEqual [(0::Int,0::Int),(1,1)] $+             heads (cons coin nil) >>= convert  heads l = do   xs <- share l   return (first xs, first xs)  dup_head_lazy = assertEqual [(0::Int,0::Int),(1,1)] $-                  heads (cons coin undefined)+                  heads (cons coin undefined) >>= convert

@@ -1,11 +1,11 @@ Name:          explicit-sharing-Version:       0.8+Version:       0.9 Cabal-Version: >= 1.6 Synopsis:      Explicit Sharing of Monadic Effects Description:    -  This package implements a monad transformer for sharing monadic-  effects.+  This package implements a monad for non-deterministic computations+  with sharing.  Category:      Control, Monads License:       PublicDomain@@ -25,13 +25,9 @@                     derive >= 2.3.0.1 && < 2.5   Exposed-Modules:  Control.Monad.Sharing,                     Control.Monad.Sharing.Classes,-                    Control.Monad.Sharing.FirstOrder,                     Data.Monadic.Derive,                     Data.Monadic.List-  Other-Modules:    Control.Monad.Sharing.Implementation.CPS,-                    Control.Monad.Sharing.Implementation.FirstOrder,-                    Control.Monad.Sharing.Implementation.SlowState,-                    Control.Monad.Sharing.Implementation.SlowStateCPS+  Other-Modules:    Control.Monad.Sharing.Implementation.CPS   Ghc-Options:      -Wall -fno-warn-name-shadowing   Extensions:       ExistentialQuantification,                     MultiParamTypeClasses,@@ -39,3 +35,7 @@                     FlexibleContexts,                     RelaxedPolyRec,                     Rank2Types++Source-Repository head+  type:     git+  location: git://github.com/sebfisch/explicit-sharing.git

@@ -1,19 +1,22 @@ {-# LANGUAGE NoMonomorphismRestriction #-}  -- to compile, run:--- ghc -O2 --make last+-- ghc -rtsopts -O2 --make last --- $ time ./last 1000000 +RTS -H1000M -K20M+-- $ time ./last 1000000 +RTS -H2000M -K50M -- True--- user	0m1.154s+-- real 0m2.898s+-- user 0m2.050s --- $ time ./last 10000000 +RTS -H1000M -K20M+-- $ time ./last 10000000 +RTS -H2000M -K50M -- True--- user	0m9.263s+-- real 0m20.585s+-- user 0m19.470s --- $ time ./last.mcc 1000000 +RTS -h1000m -k20m+-- $ time ./last.mcc 1000000 +RTS -h2000m -k50m -- 1000000--- user	0m6.370s+-- real 0m4.895s+-- user 0m3.960s  -- $ time ./last.mcc 10000000 +RTS -h2000m -k50m -- Not enough free memory after garbage collection@@ -26,8 +29,8 @@  main =  do n <- liftM (read.head) getArgs-    let result = runSharing(last(convert(replicate n True))>>=convert)::[Bool]-    mapM_ print result+    result <- resultList (last(convert(replicate n True))>>=convert)+    mapM_ print (result :: [Bool])  last :: (MonadPlus m, Sharing m) => m (List m Bool) -> m Bool last l = do x <- share freeBool

@@ -4,26 +4,22 @@ -- ghc -O2 --make permsort.hs  -- $ time ./permsort 20--- user	0m8.909s+-- real 0m14.049s+-- user 0m13.990s  -- time ./permsort.mcc 20--- user	0m25.067s---- Comparing different implementations using GHC 6.12.1+-- real 0m13.121s+-- user 0m10.900s --- standard StateT with unevaluated thunks in store--- user	1m41.645s+-- Other implementations using GHC 7.0.3 --- continition monad with unevaluated thunks in store+-- continuation monad with unevaluated thunks in store -- user	0m37.073s  -- continuation monad with fewer store operations -- user	0m29.517s --- additionally with hand optimized memo function--- user	0m8.909s - import Control.Monad.Sharing import Data.Monadic.List @@ -31,8 +27,8 @@  main = do   n <- liftM (read.head) getArgs-  let result = runSharing (sort (convert [(1::Int)..n]) >>= convert) :: [[Int]]-  mapM_ print result+  result <- resultList (sort (convert [(1::Int)..n]) >>= convert)+  mapM_ print (result :: [[Int]])   

@@ -6,14 +6,17 @@ -- to compile, run: -- ghc -O2 -o reverse.mon --make reverse.hs --- $ time ./reverse.fun 20000--- user	0m8.804s+-- $ time ./reverse.fun 10000+-- real 0m1.942s+-- user 0m1.920s --- $ time ./reverse.mon 20000--- user	0m10.522s+-- $ time ./reverse.mon 10000+-- real 0m10.774s+-- user 0m10.730s --- $ time ./reverse.mcc 20000--- user	0m14.530s+-- $ time ./reverse.mcc 10000+-- real 0m1.945s+-- user 0m1.410s   import Control.Monad.Sharing@@ -32,9 +35,8 @@  main_mon =  do n <- liftM (read.head) getArgs-    let result =-          runSharing(convert=<<(length'=<<rev'=<<convert[(1::Int)..n]))::[Int]-    mapM_ print result+    result <- resultList (convert=<<(length'=<<rev'=<<convert[(1::Int)..n]))+    mapM_ print (result :: [Int])  length' :: Monad m => List m a -> m Int length' Nil         = return 0