bartek/mvm
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add support for 'roll' and 'over' instructions

Browse Source
This commit is contained in:
Bartłomiej Przemysław Pluta
2021-11-12 17:38:58 +01:00
parent 41438cc709
commit 434d5a16ff
3 changed files with 157 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
app/VirtualMachine/Instruction.hs
View File

@@ -5,7 +5,7 @@ import Data.Word (Word8)
import System.IO (stdin, hGetChar)
import Control.Monad.Except (throwError)
import Control.Monad.Trans (lift, liftIO)
import Control.Monad.Trans.Except (ExceptT, except)
import Control.Monad.Trans.Except (ExceptT)
import qualified Data.Map as M
import qualified Data.Sequence as S
@@ -39,6 +39,7 @@ instructions = [ Simple { _op = Nop, _noParams = 0, _noPops = 0, _sAction = (\
, Simple { _op = Div, _noParams = 0, _noPops = 2, _sAction = (\_ [x, y] -> S.fromList [y `div` x]) }
, Simple { _op = Neg, _noParams = 0, _noPops = 1, _sAction = (\_ [x] -> S.fromList [-x]) }
, Simple { _op = Not, _noParams = 0, _noPops = 1, _sAction = (\_ [x] -> S.fromList [if x /= 0 then 0 else 1]) }
, Simple { _op = Over, _noParams = 0, _noPops = 2, _sAction = (\_ [x, y] -> S.fromList [y, x, y]) }
, Complex { _op = Halt, _noParams = 0, _noPops = 0, _cAction = halt }
, Complex { _op = Call, _noParams = 1, _noPops = 0, _cAction = call }
, Complex { _op = Ret, _noParams = 0, _noPops = 0, _cAction = ret }
@@ -53,6 +54,7 @@ instructions = [ Simple { _op = Nop, _noParams = 0, _noPops = 0, _sAction = (\
, Complex { _op = In, _noParams = 0, _noPops = 0, _cAction = input }
, Complex { _op = Out, _noParams = 0, _noPops = 1, _cAction = output }
, Complex { _op = Clr, _noParams = 1, _noPops = 0, _cAction = clear }
, Complex { _op = Roll, _noParams = 0, _noPops = 0, _cAction = roll }
]
instructionByOp :: M.Map Op Instruction
@@ -125,7 +127,7 @@ output _ (char:_) = lift $ do
liftIO $ putStr $ [chr char]
forward 1
return ()
output _ [] = except $ Left $ "Empty stack - nothing to output"
output _ [] = throwError $ "Empty stack - nothing to output"
load :: Params -> Pops -> ExceptT String Machine ()
load (index:_) _ = do
@@ -149,4 +151,19 @@ clear (count:_) _ = lift $ do
push top
forward 2
return ()
clear [] _ = except $ Left "Number of elements to be cleaned expected"
clear [] _ = throwError "Number of elements to be cleaned expected"
roll :: Params -> Pops -> ExceptT String Machine ()
roll _ _ = lift $ do
fp <- getFp
stackSize <- getStackSize
let offset = if fp == -1 then 0 else (fp + 2)
substack <- pop $ stackSize - offset
if null substack
then return ()
else do
let (x:xs) = substack
push $ xs ++ [x]
return ()
forward 1
return ()

2
app/VirtualMachine/VM.hs
View File

@@ -41,6 +41,8 @@ data Op = Nop -- 0x00
| In -- 0x16
| Out -- 0x17
| Clr -- 0x18
| Roll -- 0x19
| Over -- 0x20
deriving (Eq, Ord, Enum, Show, Read, Bounded)
type Machine = StateT VM IO

135
test/VirtualMachineSpec.hs
View File

@@ -826,6 +826,141 @@ spec = do
actual <- run input
actual `shouldBe` expected
describe "roll" $ do
it "supports stack with 5 elements" $ do
let input = " push 4 \n\
\ push 5 \n\
\ push 6 \n\
\ push 7 \n\
\ push 8 \n\
\ roll \n\
\ halt "
let expected = done [7, 6, 5, 4, 8] 11 (-1)
actual <- run input
actual `shouldBe` expected
it "supports stack with 4 elements" $ do
let input = " push 4 \n\
\ push 5 \n\
\ push 6 \n\
\ push 7 \n\
\ roll \n\
\ halt "
let expected = done [6, 5, 4, 7] 9 (-1)
actual <- run input
actual `shouldBe` expected
it "supports stack with 3 elements" $ do
let input = " push 4 \n\
\ push 5 \n\
\ push 6 \n\
\ roll \n\
\ halt "
let expected = done [5, 4, 6] 7 (-1)
actual <- run input
actual `shouldBe` expected
it "supports stack with 2 elements" $ do
let input = " push 4 \n\
\ push 5 \n\
\ roll \n\
\ halt "
let expected = done [4, 5] 5 (-1)
actual <- run input
actual `shouldBe` expected
it "supports singleton stack" $ do
let input = " push 4 \n\
\ roll \n\
\ halt "
let expected = done [4] 3 (-1)
actual <- run input
actual `shouldBe` expected
it "supports empty stack" $ do
let input = " roll \n\
\ halt "
let expected = done [] 1 (-1)
actual <- run input
actual `shouldBe` expected
it "can be composed" $ do
let input = " push 4 \n\
\ push 5 \n\
\ push 6 \n\
\ push 7 \n\
\ push 8 \n\
\ roll \n\
\ roll \n\
\ roll \n\
\ halt "
let expected = done [5, 4, 8, 7, 6] 13 (-1)
actual <- run input
actual `shouldBe` expected
it "does not change the stack order when rolling number equals the stack size" $ do
let input = " push 4 \n\
\ push 5 \n\
\ push 6 \n\
\ push 7 \n\
\ push 8 \n\
\ roll \n\
\ roll \n\
\ roll \n\
\ roll \n\
\ roll \n\
\ halt "
let expected = done [8, 7, 6, 5, 4] 15 (-1)
actual <- run input
actual `shouldBe` expected
it "works in the context of current frame" $ do
let input = " push 1 \n\
\ push 2 \n\
\ push 3 \n\
\ call &foo \n\
\ foo: push 10 \n\
\ push 20 \n\
\ push 30 \n\
\ call &bar \n\
\ bar: push 70 \n\
\ push 80 \n\
\ push 90 \n\
\ roll \n\
\ halt "
let expected = done [80, 70, 90, 16, 3, 30, 20, 10, 8, -1, 3, 2, 1] 23 8
-- ├────────┤ ├────────┤ ├─────┤
-- │ │ │ │ └─────┴── there are no 'roll' instructions under the root so the data is in the correct order
-- │ │ └────────┴────────────────── as above - no 'roll' instruction under the 'foo' function
-- └────────┴───────────────────────────────────── the 'roll' instruction is called under the 'bar' function, so the numbers are rolled
actual <- run input
actual `shouldBe` expected
describe "over" $ do
it "pushes the second value from the top" $ do
let input = " push 1 \n\
\ push 2 \n\
\ over \n\
\ halt "
let expected = done [1, 2, 1] 5 (-1)
actual <- run input
actual `shouldBe` expected
it "can be used multiple times" $ do
let input = " push 1 \n\
\ push 2 \n\
\ over \n\
\ over \n\
\ over \n\
\ halt "
let expected = done [1, 2, 1, 2, 1] 7 (-1)
actual <- run input
actual `shouldBe` expected
it "raises error if empty stack" $ do
let input = " over \n\
\ halt "
let expected = Left "Attempt to pop from empty stack: tried to pop 2 elements, got 0"
actual <- run input
actual `shouldBe` expected
it "raises error if stack is not big enough" $ do
let input = " push 5 \n\
\ over \n\
\ halt "
let expected = Left "Attempt to pop from empty stack: tried to pop 2 elements, got 1"
actual <- run input
actual `shouldBe` expected
describe "examples" $ do
it "example #1" $ do
let input = " main: push 2 \n\