From 8be2c78beeaea84fd43bee8776af265e393b7b3c Mon Sep 17 00:00:00 2001 From: Asad Saeeduddin Date: Sun, 4 Aug 2019 01:41:10 -0400 Subject: [PATCH 1/3] Add monoid instances --- src/Effect/Uncurried.purs | 62 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/src/Effect/Uncurried.purs b/src/Effect/Uncurried.purs index a5e0846..09a624a 100644 --- a/src/Effect/Uncurried.purs +++ b/src/Effect/Uncurried.purs @@ -132,6 +132,8 @@ module Effect.Uncurried where +import Data.Function (($)) +import Data.Monoid (class Monoid, class Semigroup, mempty, (<>)) import Effect (Effect) foreign import data EffectFn1 :: Type -> Type -> Type @@ -186,3 +188,63 @@ foreign import runEffectFn9 :: forall a b c d e f g h i r. EffectFn9 a b c d e f g h i r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Effect r foreign import runEffectFn10 :: forall a b c d e f g h i j r. EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r + +instance semigroupEffectFn1 :: Semigroup r => Semigroup (EffectFn1 a r) where + append f1 f2 = mkEffectFn1 $ runEffectFn1 f1 <> runEffectFn1 f2 + +instance semigroupEffectFn2 :: Semigroup r => Semigroup (EffectFn2 a b r) where + append f1 f2 = mkEffectFn2 $ runEffectFn2 f1 <> runEffectFn2 f2 + +instance semigroupEffectFn3 :: Semigroup r => Semigroup (EffectFn3 a b c r) where + append f1 f2 = mkEffectFn3 $ runEffectFn3 f1 <> runEffectFn3 f2 + +instance semigroupEffectFn4 :: Semigroup r => Semigroup (EffectFn4 a b c d r) where + append f1 f2 = mkEffectFn4 $ runEffectFn4 f1 <> runEffectFn4 f2 + +instance semigroupEffectFn5 :: Semigroup r => Semigroup (EffectFn5 a b c d e r) where + append f1 f2 = mkEffectFn5 $ runEffectFn5 f1 <> runEffectFn5 f2 + +instance semigroupEffectFn6 :: Semigroup r => Semigroup (EffectFn6 a b c d e f r) where + append f1 f2 = mkEffectFn6 $ runEffectFn6 f1 <> runEffectFn6 f2 + +instance semigroupEffectFn7 :: Semigroup r => Semigroup (EffectFn7 a b c d e f g r) where + append f1 f2 = mkEffectFn7 $ runEffectFn7 f1 <> runEffectFn7 f2 + +instance semigroupEffectFn8 :: Semigroup r => Semigroup (EffectFn8 a b c d e f g h r) where + append f1 f2 = mkEffectFn8 $ runEffectFn8 f1 <> runEffectFn8 f2 + +instance semigroupEffectFn9 :: Semigroup r => Semigroup (EffectFn9 a b c d e f g h i r) where + append f1 f2 = mkEffectFn9 $ runEffectFn9 f1 <> runEffectFn9 f2 + +instance semigroupEffectFn10 :: Semigroup r => Semigroup (EffectFn10 a b c d e f g h i j r) where + append f1 f2 = mkEffectFn10 $ runEffectFn10 f1 <> runEffectFn10 f2 + +instance monoidEffectFn1 :: Monoid r => Monoid (EffectFn1 a r) where + mempty = mkEffectFn1 mempty + +instance monoidEffectFn2 :: Monoid r => Monoid (EffectFn2 a b r) where + mempty = mkEffectFn2 mempty + +instance monoidEffectFn3 :: Monoid r => Monoid (EffectFn3 a b c r) where + mempty = mkEffectFn3 mempty + +instance monoidEffectFn4 :: Monoid r => Monoid (EffectFn4 a b c d r) where + mempty = mkEffectFn4 mempty + +instance monoidEffectFn5 :: Monoid r => Monoid (EffectFn5 a b c d e r) where + mempty = mkEffectFn5 mempty + +instance monoidEffectFn6 :: Monoid r => Monoid (EffectFn6 a b c d e f r) where + mempty = mkEffectFn6 mempty + +instance monoidEffectFn7 :: Monoid r => Monoid (EffectFn7 a b c d e f g r) where + mempty = mkEffectFn7 mempty + +instance monoidEffectFn8 :: Monoid r => Monoid (EffectFn8 a b c d e f g h r) where + mempty = mkEffectFn8 mempty + +instance monoidEffectFn9 :: Monoid r => Monoid (EffectFn9 a b c d e f g h i r) where + mempty = mkEffectFn9 mempty + +instance monoidEffectFn10 :: Monoid r => Monoid (EffectFn10 a b c d e f g h i j r) where + mempty = mkEffectFn10 mempty From e9313e2c2c59eec015d2ccc2895679ef784dcabe Mon Sep 17 00:00:00 2001 From: Asad Saeeduddin Date: Tue, 6 Aug 2019 14:19:22 -0400 Subject: [PATCH 2/3] Eta-expand all the things to help optimizer --- src/Effect/Uncurried.purs | 41 +++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 21 deletions(-) diff --git a/src/Effect/Uncurried.purs b/src/Effect/Uncurried.purs index 09a624a..6ed4175 100644 --- a/src/Effect/Uncurried.purs +++ b/src/Effect/Uncurried.purs @@ -132,7 +132,6 @@ module Effect.Uncurried where -import Data.Function (($)) import Data.Monoid (class Monoid, class Semigroup, mempty, (<>)) import Effect (Effect) @@ -190,61 +189,61 @@ foreign import runEffectFn10 :: forall a b c d e f g h i j r. EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r instance semigroupEffectFn1 :: Semigroup r => Semigroup (EffectFn1 a r) where - append f1 f2 = mkEffectFn1 $ runEffectFn1 f1 <> runEffectFn1 f2 + append f1 f2 = mkEffectFn1 \a -> runEffectFn1 f1 a <> runEffectFn1 f2 a instance semigroupEffectFn2 :: Semigroup r => Semigroup (EffectFn2 a b r) where - append f1 f2 = mkEffectFn2 $ runEffectFn2 f1 <> runEffectFn2 f2 + append f1 f2 = mkEffectFn2 \a b -> runEffectFn2 f1 a b <> runEffectFn2 f2 a b instance semigroupEffectFn3 :: Semigroup r => Semigroup (EffectFn3 a b c r) where - append f1 f2 = mkEffectFn3 $ runEffectFn3 f1 <> runEffectFn3 f2 + append f1 f2 = mkEffectFn3 \a b c -> runEffectFn3 f1 a b c <> runEffectFn3 f2 a b c instance semigroupEffectFn4 :: Semigroup r => Semigroup (EffectFn4 a b c d r) where - append f1 f2 = mkEffectFn4 $ runEffectFn4 f1 <> runEffectFn4 f2 + append f1 f2 = mkEffectFn4 \a b c d -> runEffectFn4 f1 a b c d <> runEffectFn4 f2 a b c d instance semigroupEffectFn5 :: Semigroup r => Semigroup (EffectFn5 a b c d e r) where - append f1 f2 = mkEffectFn5 $ runEffectFn5 f1 <> runEffectFn5 f2 + append f1 f2 = mkEffectFn5 \a b c d e -> runEffectFn5 f1 a b c d e <> runEffectFn5 f2 a b c d e instance semigroupEffectFn6 :: Semigroup r => Semigroup (EffectFn6 a b c d e f r) where - append f1 f2 = mkEffectFn6 $ runEffectFn6 f1 <> runEffectFn6 f2 + append f1 f2 = mkEffectFn6 \a b c d e f -> runEffectFn6 f1 a b c d e f <> runEffectFn6 f2 a b c d e f instance semigroupEffectFn7 :: Semigroup r => Semigroup (EffectFn7 a b c d e f g r) where - append f1 f2 = mkEffectFn7 $ runEffectFn7 f1 <> runEffectFn7 f2 + append f1 f2 = mkEffectFn7 \a b c d e f g -> runEffectFn7 f1 a b c d e f g <> runEffectFn7 f2 a b c d e f g instance semigroupEffectFn8 :: Semigroup r => Semigroup (EffectFn8 a b c d e f g h r) where - append f1 f2 = mkEffectFn8 $ runEffectFn8 f1 <> runEffectFn8 f2 + append f1 f2 = mkEffectFn8 \a b c d e f g h -> runEffectFn8 f1 a b c d e f g h <> runEffectFn8 f2 a b c d e f g h instance semigroupEffectFn9 :: Semigroup r => Semigroup (EffectFn9 a b c d e f g h i r) where - append f1 f2 = mkEffectFn9 $ runEffectFn9 f1 <> runEffectFn9 f2 + append f1 f2 = mkEffectFn9 \a b c d e f g h i -> runEffectFn9 f1 a b c d e f g h i <> runEffectFn9 f2 a b c d e f g h i instance semigroupEffectFn10 :: Semigroup r => Semigroup (EffectFn10 a b c d e f g h i j r) where - append f1 f2 = mkEffectFn10 $ runEffectFn10 f1 <> runEffectFn10 f2 + append f1 f2 = mkEffectFn10 \a b c d e f g h i j -> runEffectFn10 f1 a b c d e f g h i j <> runEffectFn10 f2 a b c d e f g h i j instance monoidEffectFn1 :: Monoid r => Monoid (EffectFn1 a r) where - mempty = mkEffectFn1 mempty + mempty = mkEffectFn1 \_ -> mempty instance monoidEffectFn2 :: Monoid r => Monoid (EffectFn2 a b r) where - mempty = mkEffectFn2 mempty + mempty = mkEffectFn2 \_ _ -> mempty instance monoidEffectFn3 :: Monoid r => Monoid (EffectFn3 a b c r) where - mempty = mkEffectFn3 mempty + mempty = mkEffectFn3 \_ _ _ -> mempty instance monoidEffectFn4 :: Monoid r => Monoid (EffectFn4 a b c d r) where - mempty = mkEffectFn4 mempty + mempty = mkEffectFn4 \_ _ _ _ -> mempty instance monoidEffectFn5 :: Monoid r => Monoid (EffectFn5 a b c d e r) where - mempty = mkEffectFn5 mempty + mempty = mkEffectFn5 \_ _ _ _ _ -> mempty instance monoidEffectFn6 :: Monoid r => Monoid (EffectFn6 a b c d e f r) where - mempty = mkEffectFn6 mempty + mempty = mkEffectFn6 \_ _ _ _ _ _ -> mempty instance monoidEffectFn7 :: Monoid r => Monoid (EffectFn7 a b c d e f g r) where - mempty = mkEffectFn7 mempty + mempty = mkEffectFn7 \_ _ _ _ _ _ _ -> mempty instance monoidEffectFn8 :: Monoid r => Monoid (EffectFn8 a b c d e f g h r) where - mempty = mkEffectFn8 mempty + mempty = mkEffectFn8 \_ _ _ _ _ _ _ _ -> mempty instance monoidEffectFn9 :: Monoid r => Monoid (EffectFn9 a b c d e f g h i r) where - mempty = mkEffectFn9 mempty + mempty = mkEffectFn9 \_ _ _ _ _ _ _ _ _ -> mempty instance monoidEffectFn10 :: Monoid r => Monoid (EffectFn10 a b c d e f g h i j r) where - mempty = mkEffectFn10 mempty + mempty = mkEffectFn10 \_ _ _ _ _ _ _ _ _ _ -> mempty From 9906b006aee634b5493b2ea5bbedac5fdb711e6b Mon Sep 17 00:00:00 2001 From: Asad Saeeduddin Date: Tue, 6 Aug 2019 14:45:13 -0400 Subject: [PATCH 3/3] Add comment --- src/Effect/Uncurried.purs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Effect/Uncurried.purs b/src/Effect/Uncurried.purs index 6ed4175..a157b26 100644 --- a/src/Effect/Uncurried.purs +++ b/src/Effect/Uncurried.purs @@ -188,6 +188,14 @@ foreign import runEffectFn9 :: forall a b c d e f g h i r. foreign import runEffectFn10 :: forall a b c d e f g h i j r. EffectFn10 a b c d e f g h i j r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> Effect r +-- The reason these are written eta-expanded instead of as: +-- ``` +-- append f1 f2 = mkEffectFnN $ runEffectFnN f1 <> runEffectFnN f2 +-- ``` +-- is to help the compiler recognize that it can emit uncurried +-- JS functions (which are more efficient), when an appended +-- EffectFn is applied to all its arguments + instance semigroupEffectFn1 :: Semigroup r => Semigroup (EffectFn1 a r) where append f1 f2 = mkEffectFn1 \a -> runEffectFn1 f1 a <> runEffectFn1 f2 a