From a2d2b10e86beb2769245502e7f5dec4592bb2a2a Mon Sep 17 00:00:00 2001 From: Danila Fedorin Date: Sat, 4 Mar 2023 22:02:15 -0800 Subject: [PATCH] Make the failure continuation a function to avoid strictness --- src/Control/Monad/Logic/Trans.purs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Control/Monad/Logic/Trans.purs b/src/Control/Monad/Logic/Trans.purs index 6643547..e37e0d5 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, runSFKT, runSFKTOnce) where -import Prelude (class Applicative, class Apply, class Bind, class Functor, class Monad, bind, pure, ($), (<<<), (>>=), const) +import Prelude (class Applicative, class Apply, class Bind, class Functor, class Monad, bind, pure, ($), (<<<), (>>=), const, Unit, unit) import Control.Monad.Logic.Class import Control.MonadPlus (class MonadPlus, class Alternative, class Alt, class Plus, (<|>), empty) @@ -13,7 +13,7 @@ import Data.List (List(Nil), (:)) import Data.Maybe (Maybe(..)) type FK :: Type -> Type -type FK ans = ans +type FK ans = Unit -> ans type SK :: Type -> Type -> Type type SK ans a = a -> FK ans -> ans @@ -25,10 +25,10 @@ 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 (const <<< pure) (\_ -> empty) runSFKT :: forall a m. Monad m => SFKT m a -> m (List a) -runSFKT (SFKT f) = f (map <<< (:)) (pure Nil) +runSFKT (SFKT f) = f (\a fk -> map (a:_) (fk unit)) (\_ -> pure Nil) instance Functor (SFKT m) where map f m = SFKT (\sk -> unSFKT m (\a -> sk (f a))) @@ -45,10 +45,10 @@ instance Bind m => Bind (SFKT m) where instance Monad m => Monad (SFKT m) instance Alt (SFKT m) where - alt m1 m2 = SFKT (\sk fk -> unSFKT m1 sk (unSFKT m2 sk fk)) + alt m1 m2 = SFKT (\sk fk -> unSFKT m1 sk (\_ -> unSFKT m2 sk fk)) instance Plus (SFKT m) where - empty = SFKT (\_ fk -> fk) + empty = SFKT (\_ fk -> fk unit) instance Applicative m => Alternative (SFKT m) @@ -58,7 +58,7 @@ instance MonadTrans SFKT where lift m = SFKT (\sk fk -> m >>= (\a -> sk a fk)) instance Monad m => MonadLogic (SFKT m) where - msplit ma = lift (unSFKT ma (\a fk -> pure (Just (a /\ (lift fk >>= reflect)))) (pure Nothing)) + msplit ma = lift (unSFKT ma (\a fk -> pure (Just (a /\ (lift (fk unit) >>= reflect)))) (\_ -> pure Nothing)) interleave m1 m2 = do r <- msplit m1 case r of