never executed always true always false

    1 module HelVM.HelMA.Automata.ETA.OperandParsers where
    2 
    3 import           HelVM.HelMA.Automata.ETA.Symbol
    4 import           HelVM.HelMA.Automata.ETA.Token
    5 
    6 import           HelVM.HelIO.Containers.LLIndexSafe
    7 import           HelVM.HelIO.Control.Safe
    8 import           HelVM.HelIO.Digit.ToDigit
    9 
   10 import           Control.Monad.Extra
   11 
   12 import qualified Data.Vector                        as Vector
   13 
   14 parseNumberFromTLL :: (MonadSafe m , Integral a) => (TokenList, [TokenList]) -> m (a , (TokenList, [TokenList]))
   15 parseNumberFromTLL a = loop act ([] , a) where
   16   act (acc , (E  : tl , tll))      = Right $ ( , (tl , tll)) <$> makeIntegral7FromList acc
   17   act (acc , (R  : tl , tll))      = Left (    acc , (tl , tll))
   18   act (acc , (t  : tl , tll))      = Left (t : acc , (tl , tll))
   19   act (acc ,      ([] , tl : tll)) = Left (    acc , (tl , tll))
   20   act (acc ,      ([] , []))       = Right $ ( , ([] , [])) <$> makeIntegral7FromList acc
   21 
   22 parseNumberFromTL :: (MonadSafe m , Integral a) => OperandParser m a
   23 parseNumberFromTL a = loop act ([] , a) where
   24   act (acc , E  : tl) = Right $ ( , tl) <$> makeIntegral7FromList acc
   25   act (acc , R  : tl) = Left (    acc , tl)
   26   act (acc , t  : tl) = Left (t : acc , tl)
   27   act (acc ,      []) = Right (liftError $ show acc)
   28 
   29 parseNumber :: (MonadSafe m , Integral a) => OperandIMParser m a
   30 parseNumber iu = loopM act =<< (([] , ) <$> nextIM iu) where
   31   act (acc , (Nothing , iu')) = Right . ( , iu') <$> makeIntegral7FromList acc
   32   act (acc , (Just E  , iu')) = Right . ( , iu') <$> makeIntegral7FromList acc
   33   act (acc , (Just R  , iu')) = Left  . (    acc , ) <$> nextIM iu'
   34   act (acc , (Just t  , iu')) = Left  . (t : acc , ) <$> nextIM iu'
   35 
   36 nextIM :: MonadSafe m => OperandIMParser m (Maybe Token)
   37 nextIM iu@(IM il ic)
   38   | ic < Vector.length il = wrap <$> indexSafe il ic
   39   | otherwise             = pure (Nothing , iu)
   40   where wrap i = (Just i, IM il (ic+1))
   41 
   42 updatePC :: InstructionMemory -> InstructionCounter -> InstructionMemory
   43 updatePC iu a = iu { programCounter = a }
   44 
   45 -- | Types
   46 type OperandParser m a = TokenList -> m (a , TokenList)
   47 
   48 data InstructionMemory = IM
   49   { program        :: !TokenVector
   50   , programCounter :: !InstructionCounter
   51   } deriving stock (Eq , Read , Show)
   52 
   53 type OperandIMParser m a = InstructionMemory -> m (a , InstructionMemory)