{-# 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) ]