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
   12   = E
   13   | T
   14   | A
   15   | O
   16   | I
   17   | N
   18   | S
   19   | H
   20   | R
   21   deriving stock (Bounded, Enum, Eq, Read, Show)
   22 
   23 type TokenList   = [Token]
   24 type TokenVector = Vector Token
   25 
   26 instance ToDigit Token where
   27   toDigit H = pure 0
   28   toDigit T = pure 1
   29   toDigit A = pure 2
   30   toDigit O = pure 3
   31   toDigit I = pure 4
   32   toDigit N = pure 5
   33   toDigit S = pure 6
   34   toDigit t = liftErrorWithPrefix "Wrong token" $ show t
   35 
   36 ----
   37 
   38 newtype WhiteToken
   39   = WhiteToken { unWhiteToken :: Token }
   40   deriving stock (Eq)
   41 
   42 type WhiteTokenList = [WhiteToken]
   43 
   44 instance Show WhiteToken where
   45   show (WhiteToken R) = "\n"
   46   show (WhiteToken t) = show t
   47 
   48 -- | Scanner
   49 instance Read WhiteToken where
   50   readsPrec _ "\n" = [( WhiteToken R , "")]
   51   readsPrec _ "E"  = [( WhiteToken E , "")]
   52   readsPrec _ "T"  = [( WhiteToken T , "")]
   53   readsPrec _ "A"  = [( WhiteToken A , "")]
   54   readsPrec _ "O"  = [( WhiteToken O , "")]
   55   readsPrec _ "I"  = [( WhiteToken I , "")]
   56   readsPrec _ "N"  = [( WhiteToken N , "")]
   57   readsPrec _ "S"  = [( WhiteToken S , "")]
   58   readsPrec _ "H"  = [( WhiteToken H , "")]
   59   readsPrec _ _    = []
   60 
   61 tokenToWhiteTokenPair ∷ Token → (WhiteToken , String)
   62 tokenToWhiteTokenPair t = (WhiteToken t , "")
   63 
   64 whiteTokenListToTokenList ∷ WhiteTokenList → TokenList
   65 whiteTokenListToTokenList = fmap unWhiteToken