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 = Zero | One | Expression (Expression -> Out Expression)
   41 
   42 type Out = Writer ExpressionDList
   43 
   44 instance Read Expression where
   45   readsPrec _ []      = []
   46   readsPrec _ (c : s) = [(charToExpression c , s)]
   47   readList s = [(stringToExpressionList s , "")]
   48 
   49 instance Show Expression where
   50   show  Zero          = "0"
   51   show  One           = "1"
   52   show (Expression _) = "function"
   53   showList fs  = (concatMap show fs <>)
   54 
   55 instance Digitable Expression where
   56   fromDigit 0 = pure Zero
   57   fromDigit 1 = pure One
   58   fromDigit t = wrongToken t
   59 
   60 instance ToDigit Expression where
   61   toDigit Zero = pure 0
   62   toDigit One  = pure 1
   63   toDigit t    = wrongToken t