Add experimental MonadRec instance for SFKT

This commit is contained in:
Danila Fedorin 2023-03-12 21:03:26 -07:00
parent e19721af5e
commit 3fe4f60542
2 changed files with 23 additions and 1 deletions

View File

@ -12,7 +12,14 @@ to generate this file without the comments in this block.
-} -}
{ name = "logict" { name = "logict"
, dependencies = , dependencies =
[ "control", "lists", "maybe", "prelude", "transformers", "tuples" ] [ "control"
, "lists"
, "maybe"
, "prelude"
, "tailrec"
, "transformers"
, "tuples"
]
, packages = ./packages.dhall , packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs" ] , sources = [ "src/**/*.purs", "test/**/*.purs" ]
} }

View File

@ -8,6 +8,7 @@ import Control.MonadPlus (class MonadPlus, class Alternative, class Alt, class P
import Control.Monad.Reader.Class (class MonadReader, local, class MonadAsk, ask) import Control.Monad.Reader.Class (class MonadReader, local, class MonadAsk, ask)
import Control.Monad.State.Class (class MonadState, state) import Control.Monad.State.Class (class MonadState, state)
import Control.Monad.Trans.Class (class MonadTrans, lift) import Control.Monad.Trans.Class (class MonadTrans, lift)
import Control.Monad.Rec.Class (class MonadRec, Step(..))
import Data.Functor (map) import Data.Functor (map)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Data.List (List(Nil), (:)) import Data.List (List(Nil), (:))
@ -78,3 +79,17 @@ instance MonadState s m => MonadState s (SFKT m) where
instance Lazy (SFKT m a) where instance Lazy (SFKT m a) where
defer f = SFKT (\sk fk -> unSFKT (f unit) sk fk) defer f = SFKT (\sk fk -> unSFKT (f unit) sk fk)
instance Monad m => MonadRec (SFKT m) where
tailRecM :: forall acc b. (acc -> SFKT m (Step acc b)) -> acc -> SFKT m b
tailRecM f a0 = SFKT \sk fk -> go {sk: sk, fk: fk} a0
where
go :: forall ans. { sk :: SK (m ans) b, fk :: FK (m ans) } -> acc -> m ans
go r@{sk,fk} an =
let
(SFKT sfktf) = f an
success st fk' =
case st of
Loop an' -> go r an'
Done b -> sk b fk'
in sfktf success fk