Merge pull request #25 from purescript/rec

Use MonadRec to avoid blowing the stack

Author: paf31

README.md

@@ -212,44 +212,41 @@ injC :: forall f g a. (Inject f g) => FreeC f a -> FreeC g a
 ```
 
 
-#### `iterM`
+#### `runFree`
 
 ``` purescript
-iterM :: forall f m a. (Functor f, Monad m) => (forall a. f (m a) -> m a) -> Free f a -> m a
+runFree :: forall f a. (Functor f) => (f (Free f a) -> Free f a) -> Free f a -> a
 ```
 
-#### `goM`
+`runFree` runs a computation of type `Free f a`, using a function which unwraps a single layer of
+the functor `f` at a time.
 
-``` purescript
-goM :: forall f m a. (Functor f, Monad m) => (f (Free f a) -> m (Free f a)) -> Free f a -> m a
-```
-
-#### `go`
+#### `runFreeM`
 
 ``` purescript
-go :: forall f a. (Functor f) => (f (Free f a) -> Free f a) -> Free f a -> a
+runFreeM :: forall f m a. (Functor f, MonadRec m) => (f (Free f a) -> m (Free f a)) -> Free f a -> m a
 ```
 
+`runFreeM` runs a compuation of type `Free f a` in any `Monad` which supports tail recursion.
+See the `MonadRec` type class for more details.
 
-#### `goEff`
+#### `runFreeC`
 
 ``` purescript
-goEff :: forall e f a. (Functor f) => (f (Free f a) -> Eff e (Free f a)) -> Free f a -> Eff e a
+runFreeC :: forall f a. (forall a. f a -> a) -> FreeC f a -> a
 ```
 
+`runFreeC` is the equivalent of `runFree` for type constructors transformed with `Coyoneda`,
+hence we have no requirement that `f` be a `Functor`.
 
-#### `goMC`
-
-``` purescript
-goMC :: forall f m a. (Monad m) => Natural f m -> FreeC f a -> m a
-```
-
-#### `goEffC`
+#### `runFreeCM`
 
 ``` purescript
-goEffC :: forall e f a. Natural f (Eff e) -> FreeC f a -> Eff e a
+runFreeCM :: forall f m a. (MonadRec m) => Natural f m -> FreeC f a -> m a
 ```
 
+`runFreeCM` is the equivalent of `runFreeM` for type constructors transformed with `Coyoneda`,
+hence we have no requirement that `f` be a `Functor`.
 
 
 ## Module Control.Monad.Trampoline

bower.json

@@ -31,6 +31,7 @@
     "purescript-lazy": "~0.3.0",
     "purescript-foldable-traversable": "~0.3.0",
     "purescript-coproducts": "~0.3.0",
-    "purescript-inject": "~0.2.0"
+    "purescript-inject": "~0.2.0",
+    "purescript-tailrec": "~0.2.0"
   }
 }

examples/Teletype.purs

@@ -20,7 +20,7 @@ teletypeN (PutStrLn s a) = const a <$> trace s
 teletypeN (GetLine k) = return $ k "fake input"
 
 run :: forall a. Teletype a -> Eff (trace :: Trace) a
-run = goEffC teletypeN
+run = runFreeCM teletypeN
 
 echo = do
   a <- getLine

examples/TeletypeCoproduct.purs

@@ -3,7 +3,7 @@ module TeletypeCoproduct where
 import Control.Apply ((*>))
 import Control.Alt ((<|>))
 import Control.Monad.Eff (Eff())
-import Control.Monad.Free (FreeC(), liftFC, injC, goEffC)
+import Control.Monad.Free (FreeC(), liftFC, injC, runFreeCM)
 import Data.Coyoneda (Natural())
 import Data.Inject (prj)
 import Data.Functor.Coproduct (Coproduct())
@@ -62,6 +62,6 @@ tN fa = fromJust $ (teletype1N <$> prj fa) <|>
                    (teletype3N <$> prj fa)
 
 run :: forall a. T a -> Eff (trace :: Trace) a
-run = goEffC tN
+run = runFreeCM tN
 
 main = run u

src/Control/Monad/Free.purs

@@ -5,14 +5,17 @@ module Control.Monad.Free
   , liftF, liftFC
   , pureF, pureFC
   , mapF, injC
-  , iterM
-  , goM, goMC
-  , go
-  , goEff, goEffC
+  , runFree
+  , runFreeM
+  , runFreeC
+  , runFreeCM
   ) where
 
 import Control.Monad.Trans
 import Control.Monad.Eff
+import Control.Monad.Rec.Class
+
+import Data.Identity
 import Data.Coyoneda
 import Data.Either
 import Data.Function
@@ -69,69 +72,42 @@ mapF t fa = either (\s -> Free <<< t $ mapF t <$> s) Pure (resume fa)
 injC :: forall f g a. (Inject f g) => FreeC f a -> FreeC g a
 injC = mapF (liftCoyonedaT inj)
 
--- Note: can blow the stack!
-iterM :: forall f m a. (Functor f, Monad m) => (forall a. f (m a) -> m a) -> Free f a -> m a
-iterM _ (Pure a) = return a
-iterM k (Free f) = k $ iterM k <$> f
-iterM k (Gosub f) = f (\req recv -> iterM k (req unit) >>= (iterM k <<< recv))
-
--- Note: can blow the stack!
-goM :: forall f m a. (Functor f, Monad m) => (f (Free f a) -> m (Free f a)) -> Free f a -> m a
-goM k f = case resume f of
-            Left s -> k s >>= goM k
-            Right a -> return a
-
-resumeGosub :: forall f a. (Functor f) => Free f a -> Either (f (Free f a)) (Free f a)
-resumeGosub (Gosub f) = f (\a g ->
-  case a unit of
-    Pure a -> Right (g a)
-    Free t -> Left ((\h -> h >>= g) <$> t)
-    Gosub h -> Right (h (\b i -> b unit >>= (\x -> i x >>= g)))
-  )
-
-unsafeLeft :: forall a b. Either a b -> a
-unsafeLeft (Left x) = x
-
-unsafeRight :: forall a b. Either a b -> b
-unsafeRight (Right x) = x
-
 resume :: forall f a. (Functor f) => Free f a -> Either (f (Free f a)) a
 resume f = case f of
   Pure x -> Right x
   Free x -> Left x
   g -> case resumeGosub g of
     Left l -> Left l
     Right r -> resume r
+  where
+  resumeGosub :: Free f a -> Either (f (Free f a)) (Free f a)
+  resumeGosub (Gosub f) = f (\a g ->
+    case a unit of
+      Pure a -> Right (g a)
+      Free t -> Left ((\h -> h >>= g) <$> t)
+      Gosub h -> Right (h (\b i -> b unit >>= (\x -> i x >>= g)))
+    )
+
+-- | `runFree` runs a computation of type `Free f a`, using a function which unwraps a single layer of
+-- | the functor `f` at a time.
+runFree :: forall f a. (Functor f) => (f (Free f a) -> Free f a) -> Free f a -> a
+runFree fn = runIdentity <<< runFreeM (Identity <<< fn)
+
+-- | `runFreeM` runs a compuation of type `Free f a` in any `Monad` which supports tail recursion.
+-- | See the `MonadRec` type class for more details.
+runFreeM :: forall f m a. (Functor f, MonadRec m) => (f (Free f a) -> m (Free f a)) -> Free f a -> m a
+runFreeM fn = tailRecM \f -> 
+  case resume f of
+    Left fs -> Left <$> fn fs
+    Right a -> return (Right a)
+
+-- | `runFreeC` is the equivalent of `runFree` for type constructors transformed with `Coyoneda`,
+-- | hence we have no requirement that `f` be a `Functor`.
+runFreeC :: forall f a. (forall a. f a -> a) -> FreeC f a -> a
+runFreeC nat = runIdentity <<< runFreeCM (Identity <<< nat)
+
+-- | `runFreeCM` is the equivalent of `runFreeM` for type constructors transformed with `Coyoneda`,
+-- | hence we have no requirement that `f` be a `Functor`.
+runFreeCM :: forall f m a. (MonadRec m) => Natural f m -> FreeC f a -> m a
+runFreeCM nat = runFreeM (liftCoyonedaTF nat)
 
-go :: forall f a. (Functor f) => (f (Free f a) -> Free f a) -> Free f a -> a
-go fn f = case resume f of
-  Left l -> go fn (fn l)
-  Right r -> r
-
-foreign import goEffImpl """
-  function goEffImpl(resume, isRight, fromLeft, fromRight, fn, value) {
-    return function(){
-      while (true) {
-        var r = resume(value);
-        if (isRight(r)) return fromRight(r);
-        value = fn(fromLeft(r))();
-      }
-    };
-  }""" :: forall e f a. Fn6
-          (Free f a -> Either (f (Free f a)) a)
-          (Either (f (Free f a)) a -> Boolean)
-          (Either (f (Free f a)) a -> (f (Free f a)))
-          (Either (f (Free f a)) a -> a)
-          (f (Free f a) -> Eff e (Free f a))
-          (Free f a)
-          (Eff e a)
-
-goEff :: forall e f a. (Functor f) => (f (Free f a) -> Eff e (Free f a)) -> Free f a -> Eff e a
-goEff fn f = runFn6 goEffImpl resume isRight unsafeLeft unsafeRight fn f
-
--- Note: can blow the stack!
-goMC :: forall f m a. (Monad m) => Natural f m -> FreeC f a -> m a
-goMC nat = goM (liftCoyonedaTF nat)
-
-goEffC :: forall e f a. Natural f (Eff e) -> FreeC f a -> Eff e a
-goEffC nat = goEff (liftCoyonedaTF nat)

src/Control/Monad/Trampoline.purs

@@ -28,4 +28,4 @@ delay :: forall a. (Unit -> a) -> Trampoline a
 delay = delay' <<< defer
 
 runTrampoline :: forall a. Trampoline a -> a
-runTrampoline = go force
+runTrampoline = runFree force