never executed always true always false

    1 module HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Evaluator (
    2   evalSource,
    3 ) where
    4 
    5 import           HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction
    6 
    7 import           HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Parser
    8 
    9 import           HelVM.HelMA.Automata.BrainFuck.Common.Symbol
   10 import           HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols
   11 
   12 import           HelVM.HelMA.Automaton.API.IOTypes
   13 import           HelVM.HelMA.Automaton.IO.BusinessIO
   14 import           HelVM.HelMA.Automaton.Types.DumpType
   15 
   16 import           HelVM.HelIO.Containers.LLIndexSafe
   17 
   18 import           Control.Type.Operator
   19 
   20 evalSource :: (BIO m , Symbol e) => Source -> FullTape e -> DumpType -> m ()
   21 evalSource source tape dt = logDump dt =<< flip runList tape =<< parseWithOptimize source
   22 
   23 runList :: (BIO m , Symbol e) => FastInstructionList -> FullTape e -> m $ Memory e
   24 runList il = nextStep (IM il 0)
   25 
   26 nextStep :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
   27 nextStep (IM iv ic) = doInstruction (iv `indexMaybe` ic) (IM iv $ ic + 1)
   28 
   29 doInstruction :: (BIO m , Symbol e) => Maybe FastInstruction -> InstructionMemory -> FullTape e -> m $ Memory e
   30 doInstruction (Just (Move   i       )) table tape       = nextStep     table (moveHead          i        tape)
   31 doInstruction (Just (Inc    i       )) table tape       = nextStep     table (incSymbol         i        tape)
   32 doInstruction (Just  Output          ) table tape       = doOutputChar table                             tape
   33 doInstruction (Just  Input           ) table tape       = doInputChar  table                             tape
   34 doInstruction (Just (While  iv      )) table tape       = doWhile iv   table                             tape
   35 doInstruction (Just (Set    i       )) table tape       = nextStep     table (setSymbol         i        tape)
   36 
   37 doInstruction (Just (SubClr          f    )) table tape = nextStep table (subAndClearSymbol          f     tape)
   38 doInstruction (Just (AddClr          f    )) table tape = nextStep table (addAndClearSymbol          f     tape)
   39 doInstruction (Just (MulAddClr m     f    )) table tape = nextStep table (mulAddAndClearSymbol m     f     tape)
   40 
   41 doInstruction (Just (DupClr          f1 f2)) table tape = nextStep table (dupAndClearSymbol          f1 f2 tape)
   42 doInstruction (Just (MulDupClr m1 m2 f1 f2)) table tape = nextStep table (mulDupAndClearSymbol m1 m2 f1 f2 tape)
   43 
   44 doInstruction (Just (TriClr i1 i2 i3)) table tape       = nextStep     table (triAndClearSymbol i1 i2 i3 tape)
   45 doInstruction  Nothing           table tape             = doEnd        table                             tape
   46 
   47 doWhile :: (BIO m , Symbol e) => FastInstructionList -> InstructionMemory -> FullTape e -> m $ Memory e
   48 doWhile _  table tape@(_ , 0:_) = nextStep table tape
   49 doWhile iv table tape           = doWhileWithTape =<< runList iv tape where
   50   doWhileWithTape :: (BIO m , Symbol e) => Memory e -> m $ Memory e
   51   doWhileWithTape = doWhile iv table . memoryTape
   52 
   53 -- | IO instructions
   54 doOutputChar :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
   55 doOutputChar _          (_ ,  []) = error "Illegal State"
   56 doOutputChar table tape@(_ , e:_) = wPutChar (toChar e) *> nextStep table tape
   57 
   58 doInputChar  :: (BIO m , Symbol e) => InstructionMemory -> FullTape e -> m $ Memory e
   59 doInputChar table tape = (nextStep table . flip writeSymbol tape) =<< wGetChar
   60 
   61 -- | Terminate instruction
   62 doEnd :: BIO m => InstructionMemory -> FullTape e -> m $ Memory e
   63 doEnd iu tape = pure $ Memory iu tape
   64 
   65 -- | Types
   66 data Memory e = Memory
   67   { memoryIM   :: InstructionMemory
   68   , memoryTape :: FullTape e
   69   }
   70   deriving stock (Eq , Show)
   71 
   72 data InstructionMemory = IM !FastInstructionList !InstructionCounter
   73   deriving stock (Eq , Show)
   74 
   75 type InstructionCounter = Int