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