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)