Create working PoC of interpreter

This commit is contained in:
2021-11-02 20:55:53 +01:00
parent 0b419650f0
commit e263617a2c
4 changed files with 51 additions and 3 deletions

View File

@@ -29,6 +29,7 @@ executable MVM
Instruction
Command
Parser
Interpreter
Util
-- LANGUAGE extensions used by modules in this package.

View File

@@ -8,7 +8,6 @@ module Instruction (
import qualified Data.Char as Char
import qualified Data.Map as Map
import qualified VirtualMachine as VM
data Op = Nop -- 0x00
| Halt -- 0x01
@@ -38,7 +37,6 @@ data Instruction = Simple { op :: Op
, noParams :: Int
, noPops :: Int }
| Complex { op :: Op
, vm :: VM.VM
}
deriving (Eq, Show)

49
app/Interpreter.hs Normal file
View File

@@ -0,0 +1,49 @@
module Interpreter (
interpret,
) where
import Data.Word
import Control.Monad
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 _ 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 [] _ = 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
interpretSimple :: VM.VM -> C.Command -> Either String VM.VM
interpretSimple vm (C.Command (I.Simple op _ noPops) 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"
vm' = stack' >>= (\s -> Right $ vm { VM.pc = VM.pc vm + 1
, VM.stack = 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

View File

@@ -13,7 +13,7 @@ data VM = VM { pc :: Int
} deriving (Show, Eq)
empty :: VM
empty = VM { pc = -1
empty = VM { pc = 0
, fp = -1
, stack = S.empty
, halt = False