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 qualified Data.Text.Lazy               as LT
   13 import           Text.Read
   14 import qualified Text.Show
   15 
   16 showExpressionList :: ExpressionList -> LT.Text
   17 showExpressionList f = fmconcat $ show <$> f
   18 
   19 readExpressionList :: LT.Text -> ExpressionList
   20 readExpressionList = stringToExpressionList . toString
   21 
   22 stringToExpressionList :: String -> ExpressionList
   23 stringToExpressionList s = charToExpressionList =<< s
   24 
   25 charToExpressionList :: Char -> ExpressionList
   26 charToExpressionList = maybeToList . rightToMaybe . charToExpressionSafe
   27 
   28 charToExpression :: Char -> Expression
   29 charToExpression = unsafe . charToExpressionSafe
   30 
   31 charToExpressionSafe :: MonadSafe m => Char -> m Expression
   32 charToExpressionSafe '0' = pure Zero
   33 charToExpressionSafe '1' = pure One
   34 charToExpressionSafe  c  = liftErrorWithPrefix "charToExpression" $ one c
   35 
   36 -- | Types
   37 type ExpressionDList = D.DList Expression
   38 
   39 type ExpressionList = [Expression]
   40 
   41 data Expression = Zero | One | Expression (Expression -> Out Expression)
   42 
   43 type Out = Writer ExpressionDList
   44 
   45 instance Read Expression where
   46   readsPrec _ []      = []
   47   readsPrec _ (c : s) = [(charToExpression c , s)]
   48   readList s = [(stringToExpressionList s , "")]
   49 
   50 instance Show Expression where
   51   show  Zero          = "0"
   52   show  One           = "1"
   53   show (Expression _) = "function"
   54   showList fs  = (concatMap show fs <>)
   55 
   56 instance Digitable Expression where
   57   fromDigit 0 = pure Zero
   58   fromDigit 1 = pure One
   59   fromDigit t = wrongToken t
   60 
   61 instance ToDigit Expression where
   62   toDigit Zero = pure 0
   63   toDigit One  = pure 1
   64   toDigit t    = wrongToken t