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.
174 lines
7.0 KiB
174 lines
7.0 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) |
|
import Text.Megaparsec (runParser) |
|
|
|
|
|
spec :: Spec |
|
spec = do |
|
describe "parseInstruction" parseInstructionSpec |
|
describe "compileInstruction" compileInstructionSpec |
|
|
|
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 "" |
|
|
|
compileInstructionSpec :: Spec |
|
compileInstructionSpec = do |
|
it "Compiles push argument 42" $ do |
|
let compiled = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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) ] |
|
|
|
|
|
|