You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
296 lines
12 KiB
296 lines
12 KiB
{-# LANGUAGE OverloadedStrings #-} |
|
|
|
module Test.Nand2Tetris.VM |
|
( |
|
spec |
|
) where |
|
|
|
import Test.Hspec (Spec, describe, it, shouldBe) |
|
|
|
import Nand2Tetris.Hack (HackInstruction (..), Imm (..), Jump (..), |
|
Reg (..), Source (..)) |
|
import Nand2Tetris.VM (AccessType (ACPop, ACPush), |
|
AnnotatedAsmLine (..), |
|
ArithmeticCmd (ACAdd, ACAnd, ACEq, ACGt, ACLt, ACNeg, ACNot, ACOr, ACSub), |
|
Segment (SArgument, SConstant, SLocal, SPointer, SStatic, STemp, SThat, SThis), |
|
VMInstruction (VMArithmetic, VMMemAccess), |
|
compileInstruction, parseInstruction, |
|
runCompilerDef) |
|
import Text.Megaparsec (runParser) |
|
|
|
|
|
spec :: Spec |
|
spec = do |
|
describe "parseInstruction" parseInstructionSpec |
|
describe "compile push instruction" compilePushInstructionSpec |
|
describe "compile pop instruction" compilePopInstructionSpec |
|
describe "compile arithmetic instrucitons" compileArithInstructionSpec |
|
|
|
parseInstructionSpec :: Spec |
|
parseInstructionSpec = do |
|
it "Parses instruction: push argument 42" $ |
|
doParse "push argument 42" `shouldBe` Right (VMMemAccess ACPush (SArgument 42)) |
|
|
|
it "Parses instruction: pop argument 42" $ |
|
doParse "pop argument 42" `shouldBe` Right (VMMemAccess ACPop (SArgument 42)) |
|
|
|
it "Parses instruction: push local 42" $ |
|
doParse "push local 42" `shouldBe` Right (VMMemAccess ACPush (SLocal 42)) |
|
|
|
it "Parses instruction: push this 42" $ |
|
doParse "push this 42" `shouldBe` Right (VMMemAccess ACPush (SThis 42)) |
|
|
|
it "Parses instruction: push that 42" $ |
|
doParse "push that 42" `shouldBe` Right (VMMemAccess ACPush (SThat 42)) |
|
|
|
it "Parses instruction: push constant 42" $ |
|
doParse "push constant 42" `shouldBe` Right (VMMemAccess ACPush (SConstant 42)) |
|
|
|
it "Parses instruction: push static Foo.1" $ |
|
doParse "push static Foo.1" `shouldBe` Right (VMMemAccess ACPush (SStatic "Foo.1")) |
|
|
|
it "Parses instruction: push pointer 42" $ |
|
doParse "push pointer 42" `shouldBe` Right (VMMemAccess ACPush (SPointer 42)) |
|
|
|
it "Parses instruction: push temp 42" $ |
|
doParse "push temp 42" `shouldBe` Right (VMMemAccess ACPush (STemp 42)) |
|
|
|
it "Parses instruction: push temp 11" $ |
|
doParse "push temp 11" `shouldBe` Right (VMMemAccess ACPush (STemp 11)) |
|
|
|
it "Parses instruction: add" $ |
|
doParse "add" `shouldBe` Right (VMArithmetic ACAdd) |
|
|
|
it "Parses instruction: sub" $ |
|
doParse "sub" `shouldBe` Right (VMArithmetic ACSub) |
|
|
|
it "Parses instruction: neg" $ |
|
doParse "neg" `shouldBe` Right (VMArithmetic ACNeg) |
|
|
|
it "Parses instruction: eq" $ |
|
doParse "eq" `shouldBe` Right (VMArithmetic ACEq) |
|
|
|
it "Parses instruction: gt" $ |
|
doParse "gt" `shouldBe` Right (VMArithmetic ACGt) |
|
|
|
it "Parses instruction: lt" $ |
|
doParse "lt" `shouldBe` Right (VMArithmetic ACLt) |
|
|
|
it "Parses instruction: and" $ |
|
doParse "and" `shouldBe` Right (VMArithmetic ACAnd) |
|
|
|
it "Parses instruction: or" $ |
|
doParse "or" `shouldBe` Right (VMArithmetic ACOr) |
|
|
|
it "Parses instruction: not" $ |
|
doParse "not" `shouldBe` Right (VMArithmetic ACNot) |
|
|
|
where |
|
doParse = runParser parseInstruction "" |
|
|
|
compilePushInstructionSpec :: Spec |
|
compilePushInstructionSpec = do |
|
it "Compiles push argument 42" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (SArgument 42)) |
|
head compiled `shouldBe` (Comment "push argument 42") |
|
tail compiled `shouldBe` pushValue "ARG" 42 |
|
|
|
it "Compiles push local 42" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (SLocal 42)) |
|
head compiled `shouldBe` (Comment "push local 42") |
|
tail compiled `shouldBe` pushValue "LCL" 42 |
|
|
|
it "Compiles push this 41" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (SThis 41)) |
|
head compiled `shouldBe` (Comment "push this 41") |
|
tail compiled `shouldBe` pushValue "THIS" 41 |
|
|
|
it "Compiles push that 41" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (SThat 41)) |
|
head compiled `shouldBe` (Comment "push that 41") |
|
tail compiled `shouldBe` pushValue "THAT" 41 |
|
|
|
it "Compiles push constant 17" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (SConstant 17)) |
|
head compiled `shouldBe` (Comment "push constant 17") |
|
tail compiled `shouldBe` [ |
|
Code (A (Imm 17)), |
|
Code (C [RegD] (SReg RegA) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegA] (SReg RegM) JNone), |
|
Code (C [RegM] (SReg RegD) JNone), |
|
Code (C [RegD] (SRegPlus1 RegA) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SReg RegD) JNone) ] |
|
|
|
it "Compiles push static Foo.1" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (SStatic "Foo.1")) |
|
head compiled `shouldBe` (Comment "push static Foo.1") |
|
tail compiled `shouldBe` pushLabel "Foo.1" |
|
|
|
it "Compiles push pointer 0" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (SPointer 0)) |
|
head compiled `shouldBe` (Comment "push pointer 0") |
|
tail compiled `shouldBe` pushLabel "THIS" |
|
|
|
it "Compiles push pointer 1" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (SPointer 1)) |
|
head compiled `shouldBe` (Comment "push pointer 1") |
|
tail compiled `shouldBe` pushLabel "THAT" |
|
|
|
it "Compiles push temp 2" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPush (STemp 2)) |
|
head compiled `shouldBe` (Comment "push temp 2") |
|
tail compiled `shouldBe` pushRam (5 + 2) |
|
|
|
where |
|
pushRam offset = [ Code (A (Imm offset)), |
|
Code (C [RegD] (SReg RegM) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegA] (SReg RegM) JNone), |
|
Code (C [RegM] (SReg RegD) JNone), |
|
Code (C [RegD] (SRegPlus1 RegA) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SReg RegD) JNone) ] |
|
pushLabel label = [ Code (A (Label label)), |
|
Code (C [RegD] (SReg RegM) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegA] (SReg RegM) JNone), |
|
Code (C [RegM] (SReg RegD) JNone), |
|
Code (C [RegD] (SRegPlus1 RegA) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SReg RegD) JNone) ] |
|
|
|
pushValue reg value = [ Code (A (Imm value)), |
|
Code (C [RegD] (SReg RegA) JNone), |
|
Code (A (Label reg)), |
|
Code (C [RegA] (SReg RegM) JNone), |
|
Code (C [RegA] SDPlusA JNone), |
|
Code (C [RegD] (SReg RegM) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegA] (SReg RegM) JNone), |
|
Code (C [RegM] (SReg RegD) JNone), |
|
Code (C [RegD] (SRegPlus1 RegA) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SReg RegD) JNone) ] |
|
|
|
|
|
|
|
compilePopInstructionSpec :: Spec |
|
compilePopInstructionSpec = do |
|
it "pop argument 42" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPop (SArgument 42)) |
|
head compiled `shouldBe` (Comment "pop argument 42") |
|
tail compiled `shouldBe` popValue "ARG" 42 |
|
|
|
it "pop local 42" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPop (SLocal 42)) |
|
head compiled `shouldBe` (Comment "pop local 42") |
|
tail compiled `shouldBe` popValue "LCL" 42 |
|
|
|
it "pop this 42" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPop (SThis 42)) |
|
head compiled `shouldBe` (Comment "pop this 42") |
|
tail compiled `shouldBe` popValue "THIS" 42 |
|
|
|
it "pop that 42" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPop (SThat 42)) |
|
head compiled `shouldBe` (Comment "pop that 42") |
|
tail compiled `shouldBe` popValue "THAT" 42 |
|
|
|
it "pop static Foo.1" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPop (SStatic "Foo.1")) |
|
head compiled `shouldBe` (Comment "pop static Foo.1") |
|
tail compiled `shouldBe` popLabelValue "Foo.1" |
|
|
|
it "pop pointer 0" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPop (SPointer 0)) |
|
head compiled `shouldBe` (Comment "pop pointer 0") |
|
tail compiled `shouldBe` popLabelValue "THIS" |
|
|
|
it "pop pointer 1" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPop (SPointer 1)) |
|
head compiled `shouldBe` (Comment "pop pointer 1") |
|
tail compiled `shouldBe` popLabelValue "THAT" |
|
|
|
it "pop temp 1" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMMemAccess ACPop (STemp 1)) |
|
head compiled `shouldBe` (Comment "pop temp 1") |
|
tail compiled `shouldBe` popRam (5 + 1) |
|
|
|
|
|
where |
|
popValue reg value = [ |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SRegMinus1 RegM) JNone), |
|
|
|
Code (A (Imm value)), |
|
Code (C [RegD] (SReg RegA) JNone), |
|
Code (A (Label reg)), |
|
Code (C [RegA] SDPlusM JNone), |
|
Code (C [RegD] (SReg RegM) JNone), |
|
|
|
Code (A (Label "SP")), |
|
Code (C [RegA] (SReg RegM) JNone), |
|
Code (C [RegM] (SReg RegD) JNone) |
|
] |
|
|
|
popLabelValue label = [ |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SRegMinus1 RegM) JNone), |
|
Code (C [RegA] (SReg RegM) JNone), |
|
Code (C [RegD] (SReg RegM) JNone), |
|
Code (A . Label $ label), |
|
Code (C [RegM] (SReg RegD) JNone) ] |
|
|
|
popRam offset = [ |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SRegMinus1 RegM) JNone), |
|
Code (C [RegA] (SReg RegM) JNone), |
|
Code (C [RegD] (SReg RegM) JNone), |
|
Code (A . Imm $ offset), |
|
Code (C [RegM] (SReg RegD) JNone) ] |
|
|
|
|
|
compileArithInstructionSpec :: Spec |
|
compileArithInstructionSpec = do |
|
it "compiles add" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMArithmetic ACAdd) |
|
head compiled `shouldBe` (Comment "add") |
|
tail compiled `shouldBe` |
|
[ |
|
Code (A (Label "SP")), |
|
Code (C [RegA] (SRegMinus1 RegM) JNone), |
|
Code (C [RegD] (SReg RegM) JNone), |
|
Code (C [RegA] (SRegMinus1 RegA) JNone), |
|
Code (C [RegM] SDPlusM JNone), |
|
Code (C [RegD] (SRegPlus1 RegA) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SReg RegD) JNone) |
|
] |
|
|
|
it "compiles sub" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMArithmetic ACSub) |
|
head compiled `shouldBe` (Comment "sub") |
|
tail compiled `shouldBe` |
|
[ |
|
Code (A (Label "SP")), |
|
Code (C [RegA] (SRegMinus1 RegM) JNone), |
|
Code (C [RegD] (SReg RegM) JNone), |
|
Code (C [RegA] (SRegMinus1 RegA) JNone), |
|
Code (C [RegM] SMMinusD JNone), |
|
Code (C [RegD] (SRegPlus1 RegA) JNone), |
|
Code (A (Label "SP")), |
|
Code (C [RegM] (SReg RegD) JNone) |
|
] |
|
|
|
it "compiles neg" $ do |
|
let compiled = runCompilerDef $ compileInstruction (VMArithmetic ACNeg) |
|
head compiled `shouldBe` (Comment "neg") |
|
tail compiled `shouldBe` |
|
[ |
|
Code (A (Label "SP")), |
|
Code (C [RegA] (SRegMinus1 RegM) JNone), |
|
Code (C [RegM] (SNeg RegM) JNone) |
|
] |
|
|
|
|