never executed always true always false
    1 module HelVM.HelMA.Automaton.Trampoline where
    2 
    3 import           Control.Monad.Extra   hiding (loop)
    4 import           Control.Type.Operator
    5 
    6 import           Data.Either.Extra
    7 
    8 import           Prelude               hiding (break)
    9 
   10 testMaybeLimit :: LimitMaybe
   11 testMaybeLimit = Just $ fromIntegral (maxBound :: Int)
   12 
   13 trampolineMWithLimit :: Monad m => (a -> m $ Same a) -> LimitMaybe -> a -> m a
   14 trampolineMWithLimit f Nothing  x = trampolineM f x
   15 trampolineMWithLimit f (Just n) x = trampolineM (actMWithLimit f) (n , x)
   16 
   17 actMWithLimit :: Monad m => (a -> m $ Same a) -> WithLimit a -> m $ EitherWithLimit a
   18 actMWithLimit f (n , x) = checkN n where
   19   checkN 0 = pure $ break x
   20   checkN _ = next n <$> f x
   21 
   22 next :: Natural -> Same a -> EitherWithLimit a
   23 next n a = withLimit n <$> a
   24 
   25 withLimit :: Natural -> a -> WithLimit a
   26 withLimit n a = (n - 1 , a)
   27 
   28 trampolineM :: Monad m => (a -> m (Either b a)) -> a -> m b
   29 trampolineM f = loop where loop = either return loop <=< f
   30 
   31 trampoline :: (a -> Either b a) -> a -> b
   32 trampoline f = loop where loop = either id loop . f
   33 
   34 continue :: a -> Either b a
   35 continue = Right
   36 
   37 break :: b -> Either b a
   38 break = Left
   39 
   40 type LimitMaybe = Maybe Natural
   41 
   42 type EitherWithLimit a = Either a $ WithLimit a
   43 
   44 type WithLimit a = (Natural , a)
   45 
   46 type Same a = Either a a