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