never executed always true always false

    1 module HelVM.HelMA.Automata.ETA.Token where
    2 
    3 import           HelVM.HelIO.Control.Safe
    4 import           HelVM.HelIO.Digit.ToDigit
    5 
    6 import           Data.Vector               as Vector
    7 
    8 import qualified Text.Read
    9 import qualified Text.Show
   10 
   11 data Token = E | T | A | O | I | N | S | H | R
   12   deriving stock (Bounded , Enum , Eq , Read , Show)
   13 
   14 type TokenList   = [Token]
   15 type TokenVector = Vector Token
   16 
   17 instance ToDigit Token where
   18   toDigit H = pure 0
   19   toDigit T = pure 1
   20   toDigit A = pure 2
   21   toDigit O = pure 3
   22   toDigit I = pure 4
   23   toDigit N = pure 5
   24   toDigit S = pure 6
   25   toDigit t = liftErrorWithPrefix "Wrong token" $ show t
   26 
   27 ----
   28 
   29 newtype WhiteToken = WhiteToken { unWhiteToken :: Token}
   30   deriving stock (Eq)
   31 
   32 type WhiteTokenList = [WhiteToken]
   33 
   34 instance Show WhiteToken where
   35   show (WhiteToken R) = "\n"
   36   show (WhiteToken t) = show t
   37 
   38 -- | Scanner
   39 instance Read WhiteToken where
   40   readsPrec _ "\n" = [( WhiteToken R , "")]
   41   readsPrec _ "E"  = [( WhiteToken E , "")]
   42   readsPrec _ "T"  = [( WhiteToken T , "")]
   43   readsPrec _ "A"  = [( WhiteToken A , "")]
   44   readsPrec _ "O"  = [( WhiteToken O , "")]
   45   readsPrec _ "I"  = [( WhiteToken I , "")]
   46   readsPrec _ "N"  = [( WhiteToken N , "")]
   47   readsPrec _ "S"  = [( WhiteToken S , "")]
   48   readsPrec _ "H"  = [( WhiteToken H , "")]
   49   readsPrec _ _    = []
   50 
   51 tokenToWhiteTokenPair :: Token -> (WhiteToken , String)
   52 tokenToWhiteTokenPair t = (WhiteToken t , "")
   53 
   54 whiteTokenListToTokenList :: WhiteTokenList -> TokenList
   55 whiteTokenListToTokenList = fmap unWhiteToken