characterization of subset of Monads that respect tail calls?
Tom Ellis
tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk
Tue Sep 27 19:59:42 UTC 2022
On Tue, Sep 27, 2022 at 10:15:29AM +1000, Isaac Elliott wrote:
> https://pursuit.purescript.org/packages/purescript-tailrec/6.1.0/docs/Control.Monad.Rec.Class
> seems like a good starting point
Seems like that package may have missed a trick to encode tail
recursiveness through a distribution property:
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveFunctor #-}
module RecExperiment where
data Step a b = Loop a | Done b
deriving Functor
tailRec :: (a -> Step a b) -> a -> b
tailRec f = go . f
where
go (Loop a) = go (f a)
go (Done b) = b
-- | This works for all monads
tailRecM1 :: Monad m => (a -> m (Step a b)) -> a -> m b
tailRecM1 f a = do
f a >>= \case
Loop a' -> tailRecM1 f a'
Done b -> pure b
-- | This works for all monads with a "distribute" operation over
-- @Step a@ and is guaranteed tail recursive via @tailRec at .
tailRecM2 ::
Monad m =>
(m (Step a b) -> Step a (m b)) ->
(a -> m (Step a b)) ->
a ->
m b
tailRecM2 distribute f = tailRec (distribute . f)
More information about the Libraries
mailing list