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.Eff.MonadEff
   15 import           HelVM.HelMA.Automaton.Types.DumpType
   16 
   17 import           Control.Type.Operator
   18 
   19 evalSource ∷ (AppSafeEff m , Symbol e) ⇒ Source → FullTape e → DumpType → m ()
   20 evalSource source tape dt = logDump dt =<< doInstruction ([] , tokenize source) tape
   21 
   22 doInstruction ∷ (AppSafeEff 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 ∷ (AppSafeEff 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 ∷ (AppSafeEff 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 ∷ (AppSafeEff m , Symbol e) ⇒ Table → FullTape e → m $ Memory e
   43 doOutputChar _          (_ ,    []) = error "Illegal State"
   44 doOutputChar table tape@(_ , e : _) = putChar (toChar e) *> doInstruction (nextInst table) tape
   45 
   46 doInputChar ∷ (AppSafeEff m , Symbol e) ⇒ Table → FullTape e → m $ Memory e
   47 doInputChar table tape = (doInstruction (nextInst table) . flip writeSymbol tape) =<< getChar
   48 
   49 -- | Terminate instruction
   50 doEnd ∷ AppSafeEff m ⇒ Table → FullTape e → m $ Memory e
   51 doEnd table tape = pure $ Memory table tape
   52 
   53 -- | Types
   54 data Memory e
   55   = Memory
   56       { memoryTable :: Table
   57       , memoryTape  :: FullTape e
   58       }
   59   deriving stock (Eq, Read, Show)