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