never executed always true always false

    1 module HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Evaluator(
    2   evalSource,
    3 ) where
    4 
    5 import           HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Instruction
    6 import           HelVM.HelMA.Automata.BrainFuck.Impl.Flat.Parser
    7 import           HelVM.HelMA.Automata.BrainFuck.Impl.Flat.TableOfInstructions
    8 
    9 import           HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction
   10 import           HelVM.HelMA.Automata.BrainFuck.Common.Symbol
   11 import           HelVM.HelMA.Automata.BrainFuck.Common.TapeOfSymbols
   12 
   13 import           HelVM.HelMA.Automaton.API.IOTypes
   14 import           HelVM.HelMA.Automaton.IO.BusinessIO
   15 import           HelVM.HelMA.Automaton.Types.DumpType
   16 
   17 import           Control.Type.Operator
   18 
   19 evalSource :: (BIO m , Symbol e) => Source -> FullTape e -> DumpType -> m ()
   20 evalSource source tape dt = logDump dt =<< doInstruction ([] , tokenize source) tape
   21 
   22 doInstruction :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
   23 doInstruction table@(_ , Simple MoveR  : _) tape = doInstruction (nextInst table) (moveHeadRight tape)
   24 doInstruction table@(_ , Simple MoveL  : _) tape = doInstruction (nextInst table)  (moveHeadLeft tape)
   25 doInstruction table@(_ , Simple Inc    : _) tape = doInstruction (nextInst table)    (nextSymbol tape)
   26 doInstruction table@(_ , Simple Dec    : _) tape = doInstruction (nextInst table)    (prevSymbol tape)
   27 doInstruction table@(_ , Simple Output : _) tape = doOutputChar            table                 tape
   28 doInstruction table@(_ , Simple Input  : _) tape = doInputChar             table                 tape
   29 doInstruction table@(_ , JmpPast       : _) tape = doJmpPast               table                 tape
   30 doInstruction table@(_ , JmpBack       : _) tape = doJmpBack               table                 tape
   31 doInstruction table@(_ , []               ) tape = doEnd                   table                 tape
   32 
   33 doJmpPast :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
   34 doJmpPast table tape@(_ , 0 : _) = doInstruction (jumpPast table) tape
   35 doJmpPast table tape             = doInstruction (nextInst table) tape
   36 
   37 doJmpBack :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
   38 doJmpBack table tape@(_ , 0 : _) = doInstruction (nextInst table) tape
   39 doJmpBack table tape             = doInstruction (jumpBack table) tape
   40 
   41 -- | IO instructions
   42 doOutputChar :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
   43 doOutputChar _          (_ ,    []) = error "Illegal State"
   44 doOutputChar table tape@(_ , e : _) = wPutChar (toChar e) *> doInstruction (nextInst table) tape
   45 
   46 doInputChar :: (BIO m , Symbol e) => Table -> FullTape e -> m $ Memory e
   47 doInputChar table tape = (doInstruction (nextInst table) . flip writeSymbol tape) =<< wGetChar
   48 
   49 -- | Terminate instruction
   50 doEnd :: BIO m => Table -> FullTape e -> m $ Memory e
   51 doEnd table tape = pure $ Memory table tape
   52 
   53 -- | Types
   54 data Memory e = Memory
   55   { memoryTable :: Table
   56   , memoryTape  :: FullTape e
   57   }
   58   deriving stock (Eq , Read , Show)