never executed always true always false

    1 module HelVM.HelMA.Automata.Zot.Evaluator (
    2   runExpressionList,
    3 )  where
    4 
    5 import           HelVM.HelMA.Automata.Zot.Expression
    6 
    7 import           Control.Monad.Writer.Lazy
    8 
    9 import qualified Data.ListLike                       as LL
   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 = foldM (><) 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 . LL.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