Everything-I-Know-About-Types
/
logict
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make the failure continuation a function to avoid strictness

This commit is contained in:
Danila Fedorin 2023-03-04 22:02:15 -08:00
parent 1a2f69036c
commit a2d2b10e86
1 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Control/Monad/Logic/Trans.purs
View File

@ -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