Skip to content

Update benchmarks #103

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Oct 18, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -5,3 +5,4 @@
/node_modules/
/output/
package-lock.json
/tmp/
1 change: 1 addition & 0 deletions .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ script:
- bower install --production
- npm run -s build
- bower install
- npm run -s build:benchmark
- npm -s test
after_success:
- >-
Expand Down
2 changes: 1 addition & 1 deletion README.md
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ Module documentation is [published on Pursuit](http://pursuit.purescript.org/pac

## Benchmarks

The following benchmarks compare the current implementation with the implementation at `v0.6.1` (purescript/purescript-free@0df59c5d459fed983131856886fc3a4b43234f1f), which used the `Gosub` technique to defer monadic binds.
The following benchmarks compare the implementation at `v5.2.0` (commit f686f5fc07766f3ca9abc83b47b6ad3da326759a) with the implementation at `v0.6.1` (commit 0df59c5d459fed983131856886fc3a4b43234f1f), which used the `Gosub` technique to defer monadic binds.

![left-bind-small](benchmark/left-bind-small.png)

Expand Down
116 changes: 61 additions & 55 deletions benchmark/Benchmark/Free0df59c5.purs
Original file line number Diff line number Diff line change
@@ -1,13 +1,22 @@
module Benchmark.Free0df59c5
( Free(..), GosubF()
( Free(..)
, GosubF
, FreeC(..)
, MonadFree, wrap
, Natural()
, liftF, liftFI, liftFC, liftFCI
, pureF, pureFC
, mapF, mapFC
, bindF, bindFC
, injF, injFC
, class MonadFree
, wrap
, Natural
, liftF
, liftFI
, liftFC
, liftFCI
, pureF
, pureFC
, mapF
, mapFC
, bindF
, bindFC
, injF
, injFC
, runFree
, runFreeM
, runFreeC
Expand All @@ -16,18 +25,15 @@ module Benchmark.Free0df59c5

import Prelude

import Data.Exists

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
import Data.Maybe
import Data.Inject (Inject, inj)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
import Control.Monad.Trans.Class (class MonadTrans)
import Data.Coyoneda (Coyoneda, hoistCoyoneda, liftCoyoneda, lowerCoyoneda)
import Data.Either (Either(..), either)
import Data.Exists (Exists, mkExists, runExists)
import Data.Functor.Coproduct.Inject (class Inject, inj)
import Data.Identity (Identity(..))
import Data.Newtype (unwrap)
import Partial.Unsafe (unsafePartialBecause)

type Natural f g = forall a. f a -> g a

Expand All @@ -54,43 +60,43 @@ type FreeC f = Free (Coyoneda f)
class MonadFree f m where
wrap :: forall a. f (m a) -> m a

instance functorFree :: (Functor f) => Functor (Free f) where
instance functorFree :: Functor f => Functor (Free f) where
map f (Pure a) = Pure (f a)
map f g = liftA1 f g

instance applyFree :: (Functor f) => Apply (Free f) where
instance applyFree :: Functor f => Apply (Free f) where
apply = ap

instance applicativeFree :: (Functor f) => Applicative (Free f) where
instance applicativeFree :: Functor f => Applicative (Free f) where
pure = Pure

instance bindFree :: (Functor f) => Bind (Free f) where
instance bindFree :: Functor f => Bind (Free f) where
bind (Gosub g) k = runExists (\(GosubF v) -> gosub v.a (\x -> gosub (\unit -> v.f x) k)) g
bind a k = gosub (\unit -> a) k

instance monadFree :: (Functor f) => Monad (Free f)
instance monadFree :: Functor f => Monad (Free f)

instance monadTransFree :: MonadTrans Free where
lift f = Free $ do
a <- f
return (Pure a)
pure (Pure a)

instance monadFreeFree :: (Functor f) => MonadFree f (Free f) where
instance monadFreeFree :: Functor f => MonadFree f (Free f) where
wrap = Free

instance monadRecFree :: (Functor f) => MonadRec (Free f) where
instance monadRecFree :: Functor f => MonadRec (Free f) where
tailRecM f u = f u >>= \o -> case o of
Left a -> tailRecM f a
Right b -> pure b
Loop a -> tailRecM f a
Done b -> pure b

-- | Lift an action described by the generating functor `f` into the monad `m`
-- | (usually `Free f`).
liftF :: forall f m a. (Functor f, Monad m, MonadFree f m) => f a -> m a
liftF :: forall f m a. Functor f => Monad m => MonadFree f m => f a -> m a
liftF = wrap <<< map pure

-- | Lift an action described by the generating type constructor `f` into
-- | `Free g` using `Inject` to go from `f` to `g`.
liftFI :: forall f g a. (Inject f g, Functor g) => f a -> Free g a
liftFI :: forall f g a. Inject f g => Functor g => f a -> Free g a
liftFI fa = liftF (inj fa :: g a)

-- | Lift an action described by the generating type constructor `f` into the monad
Expand All @@ -100,42 +106,42 @@ liftFC = liftF <<< liftCoyoneda

-- | Lift an action described by the generating type constructor `f` into
-- | `FreeC g` using `Inject` to go from `f` to `g`.
liftFCI :: forall f g a. (Inject f g) => f a -> FreeC g a
liftFCI :: forall f g a. Inject f g => f a -> FreeC g a
liftFCI fa = liftFC (inj fa :: g a)

-- | An implementation of `pure` for the `Free` monad.
pureF :: forall f a. (Applicative f) => a -> Free f a
pureF :: forall f a. Applicative f => a -> Free f a
pureF = Free <<< pure <<< Pure

-- | An implementation of `pure` for the `FreeC` monad.
pureFC :: forall f a. (Applicative f) => a -> FreeC f a
pureFC :: forall f a. Applicative f => a -> FreeC f a
pureFC = liftFC <<< pure

-- | Use a natural transformation to change the generating functor of a `Free` monad.
mapF :: forall f g a. (Functor f, Functor g) => Natural f g -> Free f a -> Free g a
mapF :: forall f g a. Functor f => Functor g => Natural f g -> Free f a -> Free g a
mapF t fa = either (\s -> Free <<< t $ mapF t <$> s) Pure (resume fa)

-- | Use a natural transformation to change the generating type constructor of
-- | a `FreeC` monad to another functor.
mapFC :: forall f g a. (Functor g) => Natural f g -> FreeC f a -> Free g a
mapFC t = mapF (liftCoyonedaTF t)
mapFC :: forall f g a. Functor g => Natural f g -> FreeC f a -> Free g a
mapFC t = mapF (lowerCoyoneda <<< hoistCoyoneda t)

-- | Use a natural transformation to interpret one `Free` monad as another.
bindF :: forall f g a. (Functor f, Functor g) => Free f a -> Natural f (Free g) -> Free g a
bindF :: forall f g a. Functor f => Functor g => Free f a -> Natural f (Free g) -> Free g a
bindF fa t = either (\m -> t m >>= \fa' -> bindF fa' t) Pure (resume fa)

-- | Use a natural transformation to interpret a `FreeC` monad as a different
-- | `Free` monad.
bindFC :: forall f g a. (Functor g) => FreeC f a -> Natural f (Free g) -> Free g a
bindFC fa t = bindF fa (liftCoyonedaTF t)
bindFC :: forall f g a. Functor g => FreeC f a -> Natural f (Free g) -> Free g a
bindFC fa t = bindF fa (lowerCoyoneda <<< hoistCoyoneda t)

-- | Embed computations in one `Free` monad as computations in the `Free` monad for
-- | a coproduct type constructor.
-- |
-- | This construction allows us to write computations which are polymorphic in the
-- | particular `Free` monad we use, allowing us to extend the functionality of
-- | our monad later.
injF :: forall f g a. (Functor f, Functor g, Inject f g) => Free f a -> Free g a
injF :: forall f g a. Functor f => Functor g => Inject f g => Free f a -> Free g a
injF = mapF inj

-- | Embed computations in one `FreeC` monad as computations in the `FreeC` monad for
Expand All @@ -144,18 +150,18 @@ injF = mapF inj
-- | This construction allows us to write computations which are polymorphic in the
-- | particular `Free` monad we use, allowing us to extend the functionality of
-- | our monad later.
injFC :: forall f g a. (Inject f g) => FreeC f a -> FreeC g a
injFC = mapF (liftCoyonedaT inj)
injFC :: forall f g a. Inject f g => FreeC f a -> FreeC g a
injFC = mapF (hoistCoyoneda inj)

resume :: forall f a. (Functor f) => Free f a -> Either (f (Free f a)) a
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
g -> unsafePartialBecause "Existing implementation." 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 :: Partial => Free f a -> Either (f (Free f a)) (Free f a)
resumeGosub (Gosub g) =
runExists (\(GosubF v) -> case v.a unit of
Pure a -> Right (v.f a)
Expand All @@ -164,23 +170,23 @@ resume f = case f of

-- | `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)
runFree :: forall f a. Functor f => (f (Free f a) -> Free f a) -> Free f a -> a
runFree fn = unwrap <<< 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 :: 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)
Left fs -> Loop <$> fn fs
Right a -> pure (Done 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)
runFreeC :: forall f a. (forall b. f b -> b) -> FreeC f a -> a
runFreeC nat = unwrap <<< 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)
runFreeCM nat = runFreeM (lowerCoyoneda <<< hoistCoyoneda nat)
Loading