never executed always true always false

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