From 880ade17dc5129975c16d211dc6ed3bddf2821c8 Mon Sep 17 00:00:00 2001
From: Danila Fedorin <danila.fedorin@gmail.com>
Date: Sun, 12 Mar 2023 22:17:00 -0700
Subject: [PATCH] Manually uncurry the success continuation (?)

---
 src/Control/Monad/Logic/Trans.purs | 28 ++++++++++++++--------------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/Control/Monad/Logic/Trans.purs b/src/Control/Monad/Logic/Trans.purs
index c978aab..7bf5429 100644
--- a/src/Control/Monad/Logic/Trans.purs
+++ b/src/Control/Monad/Logic/Trans.purs
@@ -1,6 +1,6 @@
 module Control.Monad.Logic.Trans (SFKT(..), FK, SK, unSFKT, runSFKT, runSFKTOnce) where
 
-import Prelude (class Applicative, class Apply, class Bind, class Functor, class Monad, bind, pure, ($), (<<<), (>>=), const, Unit, unit)
+import Prelude (class Applicative, class Apply, class Bind, class Functor, class Monad, bind, pure, ($), (<<<), (>>=), Unit, unit)
 import Control.Monad.Logic.Class
 
 import Control.Lazy (class Lazy)
@@ -18,7 +18,7 @@ type FK :: Type -> Type
 type FK ans = Unit -> ans
 
 type SK :: Type -> Type -> Type
-type SK ans a = a -> FK ans -> ans
+type SK ans a = { val :: a, fk :: FK ans } -> ans
 
 newtype SFKT :: (Type -> Type) -> Type -> Type
 newtype SFKT m a = SFKT (forall ans. SK (m ans) a -> FK (m ans) -> m ans)
@@ -27,22 +27,22 @@ unSFKT :: forall a m. SFKT m a -> forall ans. SK (m ans) a -> FK (m ans) -> m an
 unSFKT (SFKT f) = f
 
 runSFKTOnce :: forall a m. Alternative m => SFKT m a -> m a
-runSFKTOnce (SFKT f) = f (const <<< pure) (\_ -> empty)
+runSFKTOnce (SFKT f) = f (pure <<< _.val) (\_ -> empty)
 
 runSFKT :: forall a m. Monad m => SFKT m a -> m (List a)
-runSFKT (SFKT f) = f (\a fk -> map (a:_) (fk unit)) (\_ -> pure Nil)
+runSFKT (SFKT f) = f (\{val: a, fk} -> map (a:_) (fk unit)) (\_ -> pure Nil)
 
 instance Functor (SFKT m) where
-    map f m = SFKT (\sk -> unSFKT m (\a -> sk (f a)))
+    map f m = SFKT (\sk -> unSFKT m (\{val: a, fk} -> sk { val: f a, fk: fk }))
 
 instance Apply m => Apply (SFKT m) where
-    apply mf ma = SFKT (\sk -> unSFKT mf (\f -> unSFKT ma (\a -> sk (f a))))
+    apply mf ma = SFKT (\sk -> unSFKT mf (\{val: f, fk: fk} -> unSFKT ma (\{val: a, fk: fk'} -> sk { val: f a, fk: fk' }) fk))
 
 instance Applicative m => Applicative (SFKT m) where
-    pure a = SFKT (\sk fk -> sk a fk)
+    pure a = SFKT (\sk fk -> sk {val: a, fk: fk})
 
 instance Bind m => Bind (SFKT m) where
-    bind m f = SFKT (\sk -> unSFKT m (\a -> unSFKT (f a) sk))
+    bind m f = SFKT (\sk -> unSFKT m (\{val: a, fk} -> unSFKT (f a) sk fk))
 
 instance Monad m => Monad (SFKT m)
 
@@ -57,11 +57,11 @@ instance Applicative m => Alternative (SFKT m)
 instance Monad m => MonadPlus (SFKT m)
 
 instance MonadTrans SFKT where
-    lift m = SFKT (\sk fk -> m >>= (\a -> sk a fk))
+    lift m = SFKT (\sk fk -> m >>= (\a -> sk { val: a, fk: fk }))
 
 instance Monad m => MonadLogic (SFKT m) where
-    msplit ma = lift (unSFKT ma (\a fk -> pure (Just (a /\ (lazyLift fk >>= reflect)))) (\_ -> pure Nothing))
-        where lazyLift f = SFKT (\sk fk -> f unit >>= (\a -> sk a fk))
+    msplit ma = lift (unSFKT ma (\{val: a, fk} -> pure (Just (a /\ (lazyLift fk >>= reflect)))) (\_ -> pure Nothing))
+        where lazyLift f = SFKT (\sk fk -> f unit >>= (\a -> sk {val: a, fk: fk }))
     interleave m1 m2 = do
         r <- msplit m1
         case r of
@@ -72,7 +72,7 @@ instance MonadAsk r m => MonadAsk r (SFKT m) where
     ask = lift ask
 
 instance MonadReader r m => MonadReader r (SFKT m) where
-    local f m = SFKT (\sk -> unSFKT m (\a -> local f <<< sk a))
+    local f m = SFKT (\sk -> unSFKT m (local f <<< sk))
 
 instance MonadState s m => MonadState s (SFKT m) where
     state f = lift $ state f
@@ -88,8 +88,8 @@ instance Monad m => MonadRec (SFKT m) where
             go r@{sk,fk} an =
                 let
                     (SFKT sfktf) = f an
-                    success st fk' =
+                    success {val: st, fk: fk'} =
                         case st of
                             Loop an' -> go r an'
-                            Done b -> sk b fk'
+                            Done b -> sk {val: b, fk: fk' }
                  in sfktf success fk