never executed always true always false

    1 module HelVM.HelMA.Automata.Zot.Expression where
    2 
    3 import           HelVM.HelIO.Control.Safe
    4 
    5 import           HelVM.HelIO.Containers.Extra
    6 import           HelVM.HelIO.Digit.Digitable
    7 import           HelVM.HelIO.Digit.ToDigit
    8 
    9 import           Control.Monad.Writer.Lazy
   10 
   11 import qualified Data.DList                   as D
   12 import           Text.Read
   13 import qualified Text.Show
   14 
   15 showExpressionList ∷ ExpressionList → LText
   16 showExpressionList f = fmconcat $ show <$> f
   17 
   18 readExpressionList ∷ LText → ExpressionList
   19 readExpressionList = stringToExpressionList . toString
   20 
   21 stringToExpressionList ∷ String → ExpressionList
   22 stringToExpressionList s = charToExpressionList =<< s
   23 
   24 charToExpressionList ∷ Char → ExpressionList
   25 charToExpressionList = maybeToList . rightToMaybe . charToExpressionSafe
   26 
   27 charToExpression ∷ Char → Expression
   28 charToExpression = unsafe . charToExpressionSafe
   29 
   30 charToExpressionSafe ∷ MonadSafe m ⇒ Char → m Expression
   31 charToExpressionSafe '0' = pure Zero
   32 charToExpressionSafe '1' = pure One
   33 charToExpressionSafe  c  = liftErrorWithPrefix "charToExpression" $ one c
   34 
   35 -- | Types
   36 type ExpressionDList = D.DList Expression
   37 
   38 type ExpressionList = [Expression]
   39 
   40 data Expression
   41   = Zero
   42   | One
   43   | Expression (Expression -> Out Expression)
   44 
   45 type Out = Writer ExpressionDList
   46 
   47 instance Read Expression where
   48   readsPrec _ []      = []
   49   readsPrec _ (c : s) = [(charToExpression c , s)]
   50   readList s = [(stringToExpressionList s , "")]
   51 
   52 instance Show Expression where
   53   show  Zero          = "0"
   54   show  One           = "1"
   55   show (Expression _) = "function"
   56   showList fs  = (concatMap show fs <>)
   57 
   58 instance Digitable Expression where
   59   fromDigit 0 = pure Zero
   60   fromDigit 1 = pure One
   61   fromDigit t = wrongToken t
   62 
   63 instance ToDigit Expression where
   64   toDigit Zero = pure 0
   65   toDigit One  = pure 1
   66   toDigit t    = wrongToken t