never executed always true always false

    1 module HelVM.HelMA.Automata.Zot.Automaton
    2   ( runExpressionList
    3   ) where
    4 
    5 import           HelVM.HelMA.Automata.Zot.Expression
    6 
    7 import           Control.Monad.Writer.Lazy
    8 
    9 import qualified Data.DList                          as D
   10 
   11 -- | High-level Expressions
   12 runExpressionList ∷ ExpressionList → Out Expression
   13 runExpressionList el = foldExpression el >><< outputExpression >>< printExpression
   14 
   15 foldExpression ∷ ExpressionList → Out Expression
   16 foldExpression = foldlM (><) emptyExpression
   17 
   18 emptyExpression ∷ Expression
   19 emptyExpression = contExpression iExpression
   20 
   21 outputExpression ∷ Out Expression
   22 outputExpression = kExpression ><< kExpression ><< kExpression ><< kExpression ><< kExpression ><< kExpression >< iExpression
   23 
   24 printExpression ∷ Expression
   25 printExpression = Expression innerPrintExpression
   26 
   27 innerPrintExpression ∷ Expression → Out Expression
   28 innerPrintExpression f = interrogateExpression f >>< Zero >>< One >>= tell . D.singleton >> pure printExpression
   29 
   30 interrogateExpression ∷ Expression → Out Expression
   31 interrogateExpression f = f >< iExpression >>< iExpression >>< iExpression >>< kExpression
   32 
   33 -- | Operators
   34 infixl 9 ><
   35 (><) ∷ Expression → Expression → Out Expression
   36 (><) Zero           = (zeroExpression ><)
   37 (><) One            = (oneExpression ><)
   38 (><) (Expression f) = f
   39 
   40 infixl 6 >><
   41 (>><) ∷ Out Expression → Expression → Out Expression
   42 f >>< a = f >>= (>< a)
   43 
   44 infixr 8 ><<
   45 (><<) ∷ Expression → Out Expression → Out Expression
   46 f ><< a = (f ><) =<< a
   47 
   48 infixl 7 >><<
   49 (>><<) ∷ Out Expression → Out Expression → Out Expression
   50 f >><< a = f >>= (><< a)
   51 
   52 
   53 -- | Low-level Expressions
   54 zeroExpression ∷ Expression
   55 zeroExpression = contExpression $ Expression $ \ f -> f >< sExpression >>< kExpression
   56 
   57 oneExpression ∷ Expression
   58 oneExpression = makeExpression $ \c -> contExpression $ makeExpression $ \l -> contExpression $ Expression $ \r -> c ><< l >< r
   59 
   60 contExpression ∷ Expression → Expression
   61 contExpression = Expression . flip (><)
   62 
   63 sExpression ∷ Expression
   64 sExpression = makeExpression $ \x -> makeExpression $ \y -> Expression $ \z -> x >< z >><< y >< z
   65 
   66 kExpression ∷ Expression
   67 kExpression = makeExpression $ makeExpression . const
   68 
   69 iExpression ∷ Expression
   70 iExpression = makeExpression id
   71 
   72 makeExpression ∷ (Expression → Expression) → Expression
   73 makeExpression f =  Expression $ pure . f