1 module Machine(Instruction(..), exec) where 2 3 import Data.Array(array, (!)) 4 import Behaviour (Trace(..)) 5 import Value (Value(..), Op1, uno, Op2, duo) 6 7 data Instruction 8 = Push Value 9 | Pop 10 | Fetch Int 11 | Store Int 12 | Instr1 Op1 13 | Instr2 Op2 14 | Display 15 | Jump Int 16 | JumpUnless Int 17 | Halt 18 deriving (Eq, Show) 19 20 exec :: [Instruction] -> Trace Value 21 exec instrs = run 1 [] 22 where 23 size = length instrs 24 memory = array (1,size) ([1..] `zip` instrs) 25 run pc stack = 26 if pc < 1 || size < pc then Crash 27 else 28 case (memory ! pc, stack) of 29 (Push x , stack) -> run pc' (x : stack) 30 (Pop , _ : stack) -> run pc' stack 31 (Fetch n , stack) 32 | length stack >= n -> run pc' (stack !! n : stack) 33 (Store n , x : stack) 34 | length stack >= n -> run pc' (take (n-1) stack ++ 35 -- run pc' (take n stack ++ -- Bug example 36 x : drop n stack) 37 (Instr1 op1 , i : stack) -> run pc' (uno op1 i : stack) 38 (Instr2 op2 , i : j : stack) -> run pc' (duo op2 j i : stack) 39 (Display , i : stack) -> i :> run pc' stack 40 (Jump n , stack) -> step n (run (pc' + n) stack) 41 (JumpUnless n , Bol b : stack) 42 | b -> run pc' stack 43 | otherwise -> step n (run (pc' + n) stack) 44 (Halt , stack) -> End 45 _ -> Crash 46 where 47 pc' = pc + 1 48 49 step :: Int -> Trace Value -> Trace Value 50 step n t | n < 0 = Step t 51 | otherwise = t