never executed always true always false

    1 module HelVM.HelMA.Automata.Piet.Combiner.ALU
    2   ( -- | I/O Instructions
    3     pietInChar
    4   , pietInNumber
    5   , pietOutChar
    6   , pietOutNumber
    7     -- | Stack & Arithmetic Instructions
    8   , pietAdd
    9   , pietDivide
   10   , pietDuplicate
   11   , pietGreater
   12   , pietMod
   13   , pietMultiply
   14   , pietNot
   15   , pietPop
   16   , pietPush
   17   , pietRoll
   18   , pietSubtract
   19   ) where
   20 
   21 import           HelVM.HelMA.Automata.Piet.Types.InstructionMemory
   22 import           HelVM.HelMA.Automata.Piet.Types.Memory
   23 
   24 import           HelVM.HelMA.Automaton.Combiner.ALU                     hiding ( Stack )
   25 import           HelVM.HelMA.Automaton.Eff.MonadEff
   26 import           HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
   27 
   28 import           Prelude                                                hiding ( getLine )
   29 
   30 -- | I/O Instructions
   31 pietInNumber ∷ AppSafeEff m ⇒ Memory → m Memory
   32 pietInNumber = modifyStack "in_number" inputDec
   33 
   34 pietInChar ∷ AppSafeEff m ⇒ Memory → m Memory
   35 pietInChar = modifyStack "in_char" inputChar
   36 
   37 pietOutNumber ∷ AppSafeEff m ⇒ Memory → m Memory
   38 pietOutNumber = modifyStack "out_number" outputDecMaybe
   39 
   40 pietOutChar ∷ AppSafeEff m ⇒ Memory → m Memory
   41 pietOutChar = modifyStack "out_char" outputCharMaybe
   42 
   43 -- | Push / Pop
   44 pietPush ∷ AppSafeEff m ⇒ Int → Memory → m Memory
   45 pietPush n = modifyStack ("push " <> show n) (pure . push1 n)
   46 
   47 pietPop ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   48 pietPop = modifyStack "pop" discard
   49 
   50 -- | Binary & Unary Arithmetic Instructions
   51 pietAdd ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   52 pietAdd = modifyStack "add" (binaryInstruction Add)
   53 
   54 pietSubtract ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   55 pietSubtract = modifyStack "subtract" (binaryInstruction Sub)
   56 
   57 pietMultiply ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   58 pietMultiply = modifyStack "multiply" (binaryInstruction Mul)
   59 
   60 pietDivide ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   61 pietDivide = modifyStack "divide" (binaryInstruction Div)
   62 
   63 pietMod ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   64 pietMod = modifyStack "mod" (binaryInstruction Mod)
   65 
   66 pietNot ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   67 pietNot = modifyStack "not" lNot
   68 
   69 pietGreater ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   70 pietGreater = modifyStack "greater" (binaryInstruction LGT)
   71 
   72 -- | Stack Manipulation Instructions
   73 pietDuplicate ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   74 pietDuplicate = modifyStack "duplicate" (copy 0)
   75 
   76 pietRoll ∷ (ALU m Stack Int) ⇒ Memory → m Memory
   77 pietRoll = modifyStack "roll" roll
   78 
   79 -- | Utils
   80 modifyStack ∷ AppSafeEff m ⇒ Text → (Stack → m Stack) → Memory → m Memory
   81 modifyStack name f (Memory im s) = logWithPosition name im *> (Memory im <$> f s)