Unify simple instruction actions

MVM.cabal

@@ -27,7 +27,6 @@ executable MVM
     other-modules:
       VirtualMachine
       Instruction
-      Command
       Parser
       Interpreter
       Util

app/Command.hs

@@ -1,9 +0,0 @@
-module Command (
-  Command(..)
-) where
-
-import qualified Instruction as I
-
-data Command = Command { instr  :: I.Instruction
-                       , args   :: [Int]
-                       } deriving (Eq, Show)

app/Instruction.hs

@@ -1,6 +1,7 @@
 module Instruction (
   Op(..),
   Instruction(..),
+  Command(..),
   instructions,
   instructionByOp,
   toOp
@@ -8,6 +9,9 @@ module Instruction (
 
 import qualified Data.Char as Char
 import qualified Data.Map as Map
+import qualified Data.Sequence as S
+
+import qualified VirtualMachine as VM
 
 data Op = Nop  -- 0x00 
         | Halt -- 0x01
@@ -33,24 +37,33 @@ data Op = Nop  -- 0x00
         | Ld   -- 0x15
         deriving (Eq, Ord, Enum, Show, Read, Bounded)
 
+type Args = [Int]
+type Pops = [Int]
+type Pushes = S.Seq Int
+
 data Instruction = Simple     { op        :: Op
                               , noParams  :: Int
-                              , noPops    :: Int } 
+                              , noPops    :: Int
+                              , sAction   :: Args -> Pops -> Pushes
+                              } 
                    | Complex  { op        :: Op
-                              }
-                   deriving (Eq, Show)
+                              , cAction   :: VM.VM -> Command -> Either String VM.VM
+                              } 
+
+data Command = Command { instr  :: Instruction
+                       , args   :: [Int]
+                       } 
 
 instructions :: [Instruction]
-instructions = [ Simple { op = Nop,  noParams = 0, noPops = 0 }
-               , Simple { op = Halt, noParams = 0, noPops = 0 }
-               , Simple { op = Push, noParams = 1, noPops = 0 }
-               , Simple { op = Pop,  noParams = 0, noPops = 1 }
+instructions = [ Simple { op = Nop,  noParams = 0, noPops = 0, sAction = (\_ _ -> S.empty) }
+               , Simple { op = Halt, noParams = 0, noPops = 0, sAction = (\_ _ -> S.empty) }
+               , Simple { op = Push, noParams = 1, noPops = 0, sAction = (\args _ -> S.fromList args) }
+               , Simple { op = Pop,  noParams = 0, noPops = 1, sAction = (\_ _ -> S.empty) }
                ]
 
 instructionByOp :: Map.Map Op Instruction
 instructionByOp = Map.fromList $ map (\i -> (op i, i)) instructions
 
-
 toOp :: String -> Op
 toOp = read . capitalize
   where capitalize :: String -> String

app/Interpreter.hs

@@ -4,46 +4,36 @@ module Interpreter (
 
 import Data.Word
 import Control.Monad
+import Data.Foldable
 import qualified Data.Sequence as S
 
-import qualified Command as C
 import qualified Instruction as I
 import qualified VirtualMachine as VM
 
-interpret :: [C.Command] -> VM.VM -> Either String VM.VM
+interpret :: [I.Command] -> VM.VM -> Either String VM.VM
 interpret _ vm@(VM.VM _ _ _ True) = Right $ vm
 interpret cmds vm = do
   vm' <- interpretCommand cmds vm
   interpret cmds vm'
 
-interpretCommand :: [C.Command] -> VM.VM -> Either String VM.VM
+interpretCommand :: [I.Command] -> VM.VM -> Either String VM.VM
 interpretCommand [] _ = Left $ "Empty code"
 interpretCommand cmds vm@(VM.VM pc _ _ _)
   | pc >= length cmds = Right $ vm { VM.halt = True }
   | otherwise         = case instr of
-                          (I.Simple _ _ _) -> interpretSimple vm cmd
-                          (I.Complex _)    -> interpretComplex vm cmd
-                          where cmd@(C.Command instr _) = cmds !! pc
+                          (I.Simple _ _ _ _) -> interpretSimple vm cmd
+                          (I.Complex _ _)    -> interpretComplex vm cmd
+                          where cmd@(I.Command instr _) = cmds !! pc
 
-interpretSimple :: VM.VM -> C.Command -> Either String VM.VM
-interpretSimple vm (C.Command (I.Simple op _ noPops) args) = vm'
+interpretSimple :: VM.VM -> I.Command -> Either String VM.VM
+interpretSimple vm (I.Command (I.Simple op _ noPops operation) args) = vm'
   where
-    pops = [1, 2, 3]
-    stack' = case op of
-      I.Nop -> Right $ nop vm args pops
-      I.Halt -> Right $ nop vm args pops
-      I.Push -> Right $ push vm args pops
-      _ -> Left $ "Unknown operator"
+    pops = toList . S.take noPops . VM.stack $ vm
+    stack' = Right $ operation args pops
     vm' = stack' >>= (\s -> Right $ vm { VM.pc = VM.pc vm + 1
-                                       , VM.stack = VM.stack vm <> s
+                                       , VM.stack = (S.drop noPops . VM.stack) vm <> s
                                        })
 interpretSimple _ _ = Left $ "Unknown operation"
 
-interpretComplex :: VM.VM -> C.Command -> Either String VM.VM
-interpretComplex _ _ = Left "Not implemented yet"
-
-nop :: VM.VM -> [Int] -> [Int] -> S.Seq Int
-nop vm _ _ = S.empty
-
-push :: VM.VM -> [Int] -> [Int] -> S.Seq Int
-push vm args _ = S.fromList args
+interpretComplex :: VM.VM -> I.Command -> Either String VM.VM
+interpretComplex _ _ = Left "Not implemented yet"

app/Parser.hs

@@ -6,24 +6,23 @@ import Data.Word
 import qualified Data.ByteString as B
 import qualified Data.Map as Map
 
-import qualified Command as C
 import qualified Instruction as I
 import qualified Util as U
 
-parse :: B.ByteString -> Either String [C.Command]
+parse :: B.ByteString -> Either String [I.Command]
 parse = parseCommands . B.unpack
 
-parseCommands :: [Word8] -> Either String [C.Command]
+parseCommands :: [Word8] -> Either String [I.Command]
 parseCommands [] = Right []
 parseCommands code@(x:_) = case parseCommand code of
   Just (cmd, rest) -> parseCommands rest >>= (\r -> return $ cmd : r)                              
   Nothing          -> Left $ "Unparseable byte: " ++ U.byteStr x ++ "\nIn following sequence:\n" ++ U.bytesStr 16 code
 
-parseCommand :: [Word8] -> Maybe (C.Command, [Word8])
+parseCommand :: [Word8] -> Maybe (I.Command, [Word8])
 parseCommand [] = Nothing
 parseCommand (opByte:xs) = do
   let op = toEnum . fromIntegral $ opByte :: I.Op
   instruction <- Map.lookup op I.instructionByOp
   let noParams = I.noParams instruction
   let params = map fromIntegral $ take noParams xs :: [Int]
-  return (C.Command instruction params, drop noParams xs)
+  return (I.Command instruction params, drop noParams xs)