never executed always true always false
    1 module HelVM.HelMA.Automata.Piet.Combiner.ALU (
    2   -- | I/O Instructions
    3   pietInNumber,
    4   pietInChar,
    5   pietOutNumber,
    6   pietOutChar,
    7   -- | Stack & Arithmetic Instructions
    8   pietPush,
    9   pietPop,
   10   pietAdd,
   11   pietSubtract,
   12   pietMultiply,
   13   pietDivide,
   14   pietMod,
   15   pietNot,
   16   pietGreater,
   17   pietDuplicate,
   18   pietRoll,
   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 :: AppEff m => Memory -> m Memory
   32 pietInNumber = modifyStack "in_number" inputDec
   33 
   34 pietInChar :: AppEff m => Memory -> m Memory
   35 pietInChar = modifyStack "in_char" inputChar
   36 
   37 pietOutNumber :: AppEff m => Memory -> m Memory
   38 pietOutNumber = modifyStack "out_number" outputDecMaybe
   39 
   40 pietOutChar :: AppEff m => Memory -> m Memory
   41 pietOutChar = modifyStack "out_char" outputCharMaybe
   42 
   43 -- | Push / Pop
   44 pietPush :: AppEff 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 :: AppEff m => Text -> (Stack -> m Stack) -> Memory -> m Memory
   81 modifyStack name f (Memory im s) = logWithPosition name im *> (Memory im <$> f s)