never executed always true always false

    1 module HelVM.HelMA.Automata.WhiteSpace.OperandParsers where
    2 
    3 import           HelVM.HelMA.Automata.WhiteSpace.Token
    4 import           HelVM.HelMA.Automaton.Symbol
    5 
    6 import           HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
    7 
    8 import           HelVM.HelMA.Automaton.Types.FormatType
    9 
   10 import           HelVM.HelIO.Collections.SList
   11 import           HelVM.HelIO.Control.Safe
   12 import           HelVM.HelIO.Digit.ToDigit
   13 
   14 import           Control.Monad.Extra
   15 
   16 parseIndex :: MonadSafe m => ParserFromTokenList m Index
   17 parseIndex = parseInt
   18 
   19 parseSymbol :: MonadSafe m => ParserFromTokenList m Symbol
   20 parseSymbol = parseInteger
   21 
   22 parseLabel :: MonadSafe m => FormatType -> ParserFromTokenList m Label
   23 parseLabel BinaryLabel = parseDigitString
   24 parseLabel TextLabel   = parseAsciiString
   25 
   26 ----
   27 
   28 parseInt :: MonadSafe m => ParserFromTokenList m Int
   29 parseInt tl = parseInt' <$> parseInteger tl where
   30   parseInt' (integer , tl') = (fromIntegral integer , tl')
   31 
   32 parseInteger :: MonadSafe m => ParserFromTokenList m Integer
   33 parseInteger []       = liftError "EOL"
   34 parseInteger (S : tl) = parseExtra makeIntegral2FromList tl
   35 parseInteger (T : tl) = negationIntegral <$> parseExtra makeIntegral2FromList tl
   36 parseInteger (N : tl) = pure (0 , tl)
   37 
   38 negationIntegral :: (Integer , TokenList) -> (Integer , TokenList)
   39 negationIntegral (i , l) = (-i , l)
   40 
   41 parseNatural :: MonadSafe m => ParserFromTokenList m Natural
   42 parseNatural = parseExtra makeIntegral2FromList
   43 
   44 parseExtra :: MonadSafe m => (TokenList -> m a) -> ParserFromTokenList m a
   45 parseExtra maker = loop act . ([] , ) where
   46   act (acc ,      []) = Right $ liftError $ show acc
   47   act (acc ,  N : tl) = Right $ moveSafe (maker acc , tl)
   48   act (acc ,  t : tl) = Left (t : acc , tl)
   49 
   50 parseDigitString :: MonadSafe m => ParserFromTokenList m SString
   51 parseDigitString tl = moveSafe =<< parseString' makeDigitStringFromList tl
   52 
   53 parseAsciiString :: MonadSafe m => ParserFromTokenList m SString
   54 parseAsciiString tl = moveSafe =<< parseString' makeAsciiString28FromList tl
   55 
   56 moveSafe :: MonadSafe m => (m a , TokenList) -> m (a , TokenList)
   57 moveSafe (a , tl) = appendErrorTuple ("TokenList" , show tl) $ ( , tl) <$> a
   58 
   59 parseString' :: MonadSafe m => (TokenList -> a) -> ParserFromTokenList m a
   60 parseString' maker tl = parseString'' <$> splitByN tl where
   61   parseString'' (acc , tl') = (maker acc , tl')
   62 
   63 splitByN :: MonadSafe m => ParserFromTokenList m TokenList
   64 splitByN []       = liftError "Empty list"
   65 splitByN (N : tl) = pure ([]    , tl)
   66 splitByN (t : tl) = splitByN' <$> splitByN tl where
   67   splitByN' (acc , tl') = (t:acc , tl')
   68 
   69 -- | Types
   70 type ParserFromTokenList m a = Parser TokenList m a
   71 
   72 type Parser b m a = b -> m (a , b)