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

Refactor code

Browse Source
This commit is contained in:
Bartłomiej Przemysław Pluta
2021-11-18 17:20:27 +01:00
parent c656b8ca4e
commit 2c56582460
15 changed files with 454 additions and 659 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
test/Assembler/EmitterSpec.hs
View File

@@ -13,7 +13,7 @@ import Assembler.Emitter as E
import VirtualMachine.VM (Op(..))
evalContext :: Context -> AST -> Emitter -> Either String Context
evalContext ctx ast emitter = flip evalState ctx $ runExceptT $ emitter ast >> lift get
evalContext ctx ast emitter = flip evalState ctx $ runExceptT $ emitter ast >> lift get
spec :: Spec
spec = do
@@ -37,12 +37,12 @@ spec = do
let ctx = E.empty { _labels = M.fromList [("main", 0)], _currentLabel = Just "main" }
let input = LabelDef Local "foo"
let expected = Right (ctx { _labels = M.fromList [("main", 0), ("main.foo", 0)], _currentLabel = Just "main" })
evalContext ctx input emitLabelDef `shouldBe` expected
evalContext ctx input emitLabelDef `shouldBe` expected
it "allows for the same local label in different global label scopes" $ do
let ctx = E.empty { _labels = M.fromList [("main", 0), ("main.foo", 0), ("program", 0)], _currentLabel = Just "program" }
let input = LabelDef Local "foo"
let expected = Right (ctx { _labels = M.fromList [("main", 0), ("main.foo", 0), ("program", 0), ("program.foo", 0)], _currentLabel = Just "program" })
evalContext ctx input emitLabelDef `shouldBe` expected
evalContext ctx input emitLabelDef `shouldBe` expected
it "does not allow to redefine local label" $ do
let ctx = E.empty { _labels = M.fromList [("main", 0), ("main.foo", 0)], _currentLabel = Just "main" }
let input = LabelDef Local "foo"
@@ -84,7 +84,7 @@ spec = do
evalContext ctx input emitInstr `shouldBe` expected
it "emits bytes for 2-param instruction" $ do
let ctx = E.empty
let input = Instruction (Operator Push) (Params [(Param (Integer 11)), (Param (LabelRef Global "main"))])
let input = Instruction (Operator Push) (Params [Param (Integer 11), Param (LabelRef Global "main")])
let expected = Right (ctx { _beans = [Byte 0x02, Byte 0x0B, Reference "main"] })
evalContext ctx input emitInstr `shouldBe` expected
@@ -106,7 +106,7 @@ spec = do
\ push 2 \n\
\ jmp &sum \n\
\ sum: add \n\
\ jmp &main "
\ jmp &main "
let (Right tokens) = tokenize input
let (Right ast) = parse tokens
let expected = [0x02, 0x01, 0x02, 0x02, 0x0e, 0x06, 0x06, 0x0e, 0x00]
@@ -123,7 +123,7 @@ spec = do
\ push 2 \n\
\ jmp &.sum \n\
\ .sum: add \n\
\ jmp &.loop "
\ jmp &.loop "
let (Right tokens) = tokenize input
let (Right ast) = parse tokens
-- The differences: &.sum &.loop
@@ -138,7 +138,7 @@ spec = do
\ push 2 \n\
\ jmp &sum \n\
\ sum: add \n\
\ jmp &program "
\ jmp &program "
let (Right tokens) = tokenize input
let (Right ast) = parse tokens
let (Right ast) = parse tokens
emit ast `shouldBe` Left "Label 'program' is not defined"

253
test/Assembler/ParserSpec.hs
View File

@@ -17,8 +17,7 @@ spec = do
let input = map ((:[]) . T.Operator) ops
let expected = map (flip success 1 . Operator) ops
map parseOperator input `shouldBe` expected
it "supports non-truncated input" $ do
parseOperator [T.Operator Call, T.Ampersand, T.Identifier "label"] `shouldBe` success (Operator Call) 1
it "supports non-truncated input" $ parseOperator [T.Operator Call, T.Ampersand, T.Identifier "label"] `shouldBe` success (Operator Call) 1
it "supports empty input" $
parseOperator [] `shouldBe` Nothing
@@ -28,35 +27,31 @@ spec = do
let input = map ((:[]) . T.IntLiteral) ints
let expected = map (flip success 1 . Integer) ints
map parseInt input `shouldBe` expected
it "supports non-truncated input" $ do
parseInt [T.IntLiteral 4, T.Colon] `shouldBe` success (Integer 4) 1
it "supports non-truncated input" $ parseInt [T.IntLiteral 4, T.Colon] `shouldBe` success (Integer 4) 1
it "supports empty input" $
parseInt [] `shouldBe` Nothing
describe "parseIdentifier" $ do
it "accepts identifier tokens" $
parseIdentifier [T.Identifier "someId"] `shouldBe` success (Identifier "someId") 1
it "supports non-truncated input" $ do
parseIdentifier [T.Identifier "label", T.Colon] `shouldBe` success (Identifier "label") 1
it "supports non-truncated input" $ parseIdentifier [T.Identifier "label", T.Colon] `shouldBe` success (Identifier "label") 1
it "supports empty input" $
parseIdentifier [] `shouldBe` Nothing
describe "parseColon" $ do
it "accepts colon tokens" $
parseColon [T.Colon] `shouldBe` success Colon 1
it "supports non-truncated input" $ do
parseColon [T.Colon, T.Operator Add] `shouldBe` success Colon 1
it "supports non-truncated input" $ parseColon [T.Colon, T.Operator Add] `shouldBe` success Colon 1
it "supports empty input" $
parseColon [] `shouldBe` Nothing
describe "parseAmpersand" $ do
it "accepts colon tokens" $
parseAmpersand [T.Ampersand] `shouldBe` success Ampersand 1
it "supports non-truncated input" $ do
parseAmpersand [T.Ampersand, T.Identifier "label"] `shouldBe` success Ampersand 1
it "supports non-truncated input" $ parseAmpersand [T.Ampersand, T.Identifier "label"] `shouldBe` success Ampersand 1
it "supports empty input" $
parseAmpersand [] `shouldBe` Nothing
parseAmpersand [] `shouldBe` Nothing
describe "parseLabelDef" $ do
it "parses global label def" $
parseLabelDef [T.Identifier "label", T.Colon] `shouldBe` success (LabelDef Global "label") 2
@@ -65,9 +60,8 @@ spec = do
it "requires label" $
parseLabelDef [T.Colon] `shouldBe` Nothing
it "requires colon" $
parseLabelDef [T.Identifier "label"] `shouldBe` Nothing
it "supports non-truncated input" $ do
parseLabelDef [T.Identifier "sum", T.Colon, T.Operator Nop] `shouldBe` success (LabelDef Global "sum") 2
parseLabelDef [T.Identifier "label"] `shouldBe` Nothing
it "supports non-truncated input" $ parseLabelDef [T.Identifier "sum", T.Colon, T.Operator Nop] `shouldBe` success (LabelDef Global "sum") 2
it "supports empty input" $
parseLabelDef [] `shouldBe` Nothing
@@ -79,11 +73,10 @@ spec = do
it "requires label" $
parseLabelRef [T.Ampersand] `shouldBe` Nothing
it "requires ampersand" $
parseLabelRef [T.Identifier "label"] `shouldBe` Nothing
it "supports non-truncated input" $ do
parseLabelRef [T.Ampersand, T.Identifier "sum", T.Operator Nop] `shouldBe` success (LabelRef Global "sum") 2
parseLabelRef [T.Identifier "label"] `shouldBe` Nothing
it "supports non-truncated input" $ parseLabelRef [T.Ampersand, T.Identifier "sum", T.Operator Nop] `shouldBe` success (LabelRef Global "sum") 2
it "supports empty input" $
parseLabelRef [] `shouldBe` Nothing
parseLabelRef [] `shouldBe` Nothing
describe "parseParam" $ do
it "parses int params" $ do
@@ -96,9 +89,9 @@ spec = do
parseParam [T.Ampersand, T.Identifier "program"] `shouldBe` expected
it "supports non-truncated input" $ do
let expected = success (Param (Integer 1)) 1
parseParam [T.IntLiteral 1, T.IntLiteral 2, T.IntLiteral 3] `shouldBe` expected
parseParam [T.IntLiteral 1, T.IntLiteral 2, T.IntLiteral 3] `shouldBe` expected
it "supports empty input" $
parseParam [] `shouldBe` Nothing
parseParam [] `shouldBe` Nothing
describe "parseInstr" $ do
it "parses no-param operator" $ do
@@ -113,53 +106,53 @@ spec = do
let expected = success (Instruction
(Operator Push)
(Params [
(Param (Integer 4))
Param (Integer 4)
])
) (length input)
parseInstr input `shouldBe` expected
parseInstr input `shouldBe` expected
it "parses operator with single label ref param" $ do
let input = [T.Operator Call, T.Ampersand, T.Identifier "program"]
let expected = success (Instruction
(Operator Call)
(Params [
(Param (LabelRef Global "program"))
Param (LabelRef Global "program")
])
) (length input)
parseInstr input `shouldBe` expected
parseInstr input `shouldBe` expected
it "parses operator with multiple int params" $ do
let input = [T.Operator Push
, T.IntLiteral 1
, T.IntLiteral 4
, T.IntLiteral 2
, T.IntLiteral 0
]
]
let expected = success (Instruction
(Operator Push)
(Params [
(Param (Integer 1)),
(Param (Integer 4)),
(Param (Integer 2)),
(Param (Integer 0))
Param (Integer 1),
Param (Integer 4),
Param (Integer 2),
Param (Integer 0)
])
) (length input)
parseInstr input `shouldBe` expected
parseInstr input `shouldBe` expected
it "parses operator with multiple param ref params" $ do
let input = [T.Operator Push
, T.Ampersand, T.Dot, T.Identifier "program"
, T.Ampersand, T.Dot, T.Identifier "main"
, T.Ampersand, T.Identifier "foo"
, T.Ampersand, T.Dot, T.Identifier "bar"
]
]
let expected = success (Instruction
(Operator Push)
(Params [
(Param (LabelRef Local "program")),
(Param (LabelRef Local "main")),
(Param (LabelRef Global "foo")),
(Param (LabelRef Local "bar"))
Param (LabelRef Local "program"),
Param (LabelRef Local "main"),
Param (LabelRef Global "foo"),
Param (LabelRef Local "bar")
])
) (length input)
parseInstr input `shouldBe` expected
parseInstr input `shouldBe` expected
it "parses operator with multiple mixed params" $ do
let input = [T.Operator Push
, T.Ampersand, T.Identifier "program"
@@ -170,21 +163,21 @@ spec = do
, T.IntLiteral 11
, T.Ampersand, T.Dot, T.Identifier "bar"
, T.IntLiteral 20
]
]
let expected = success (Instruction
(Operator Push)
(Params [
(Param (LabelRef Global "program")),
(Param (Integer 4)),
(Param (LabelRef Local "main")),
(Param (LabelRef Global "foo")),
(Param (Integer 10)),
(Param (Integer 11)),
(Param (LabelRef Local "bar")),
(Param (Integer 20))
Param (LabelRef Global "program"),
Param (Integer 4),
Param (LabelRef Local "main"),
Param (LabelRef Global "foo"),
Param (Integer 10),
Param (Integer 11),
Param (LabelRef Local "bar"),
Param (Integer 20)
])
) (length input)
parseInstr input `shouldBe` expected
parseInstr input `shouldBe` expected
it "supports non-truncated input" $ do
let input = [T.Operator Push
, T.Ampersand, T.Identifier "program"
@@ -196,26 +189,26 @@ spec = do
, T.Ampersand, T.Identifier "bar"
, T.IntLiteral 20 -- this is the last param, so we're going to stop here (13 tokens so far)
, T.Operator Call
, T.Ampersand, T.Identifier "program"
]
, T.Ampersand, T.Identifier "program"
]
let expected = success (Instruction
(Operator Push)
(Params [
(Param (LabelRef Global "program")),
(Param (Integer 4)),
(Param (LabelRef Global "main")),
(Param (LabelRef Local "foo")),
(Param (Integer 10)),
(Param (Integer 11)),
(Param (LabelRef Global "bar")),
(Param (Integer 20))
Param (LabelRef Global "program"),
Param (Integer 4),
Param (LabelRef Global "main"),
Param (LabelRef Local "foo"),
Param (Integer 10),
Param (Integer 11),
Param (LabelRef Global "bar"),
Param (Integer 20)
])
) 14
parseInstr input `shouldBe` expected
parseInstr input `shouldBe` expected
it "supports empty input" $
parseInstr [] `shouldBe` Nothing
parseInstr [] `shouldBe` Nothing
describe "parseLine" $ do
describe "parseLine" $ do
it "supports label definition and operator in the same line" $ do
let input = [T.Dot, T.Identifier "main", T.Colon, T.Operator Call, T.Ampersand, T.Identifier "program"]
let expected = success (Line
@@ -223,7 +216,7 @@ spec = do
(Instruction
(Operator Call)
(Params [
(Param (LabelRef Global "program"))
Param (LabelRef Global "program")
])
)
) (length input)
@@ -231,10 +224,10 @@ spec = do
it "supports line with just label definition" $ do
let input = [T.Identifier "main", T.Colon]
let expected = success (Line
(LabelDef Global "main")
Empty
(LabelDef Global "main")
Empty
) (length input)
parseLine input `shouldBe` expected
parseLine input `shouldBe` expected
it "supports line with just operator" $ do
let input = [T.Operator Call, T.Ampersand, T.Dot, T.Identifier "program"]
let expected = success (Line
@@ -242,7 +235,7 @@ spec = do
(Instruction
(Operator Call)
(Params [
(Param (LabelRef Local "program"))
Param (LabelRef Local "program")
])
)
) (length input)
@@ -254,117 +247,117 @@ spec = do
(Instruction
(Operator Call)
(Params [
(Param (LabelRef Global "program"))
Param (LabelRef Global "program")
])
)
) 5
parseLine input `shouldBe` expected
parseLine input `shouldBe` expected
it "parses empty input" $
parseLine [] `shouldBe` Nothing
describe "mapAST" $ do
it "returns mapped AST if wrapped parser succeeded" $ do
let astMapper ast = Param ast
let astMapper = Param
let parser = const $ success Colon 1
let input = [T.StringLiteral "Some not important input"]
mapAST parser astMapper input `shouldBe` success (Param Colon) 1
it "results Nothing when wrapped parser failed" $ do
let astMapper ast = Param ast
let astMapper = Param
let parser = const Nothing
let input = [T.StringLiteral "Some not important input"]
mapAST parser astMapper input `shouldBe` Nothing
it "supports empty input irrespective of wrapped parser" $ do
let astMapper ast = Param ast
let astMapper = Param
let parser = const $ success Colon 1
let input = []
mapAST parser astMapper input `shouldBe` Nothing
describe "parseOptionally" $ do
it "returns parsed AST if wrapped parser succeeded" $ do
let parser = const $ success Ampersand 1
let input = [T.StringLiteral "Some not important input"]
parseOptionally parser input `shouldBe` success Ampersand 1
it "returns Empty if wrapped parser failed" $ do
let parser = const $ Nothing
let parser = const Nothing
let input = [T.StringLiteral "Some not important input"]
parseOptionally parser input `shouldBe` success Empty 0
parseOptionally parser input `shouldBe` success Empty 0
it "supports empty input irrespective of wrapped parser" $ do
let parser = const $ Nothing
let parser = const Nothing
let input = []
parseOptionally parser input `shouldBe` success Empty 0
parseOptionally parser input `shouldBe` success Empty 0
describe "parseMany" $ do
it "parses many occurrences on truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Colon, T.Colon, T.Colon]
parseMany colonParser combiner input `shouldBe` success (Params [Colon, Colon, Colon]) 3
it "parses single occurence on truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Colon]
parseMany colonParser combiner input `shouldBe` success (Params [Colon]) 1
parseMany colonParser combiner input `shouldBe` success (Params [Colon]) 1
it "parses many occurrences on non-truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Colon, T.Colon, T.Colon, T.Ampersand]
parseMany colonParser combiner input `shouldBe` success (Params [Colon, Colon, Colon]) 3
it "parses single occurence on non-truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Colon, T.Ampersand]
parseMany colonParser combiner input `shouldBe` success (Params [Colon]) 1
parseMany colonParser combiner input `shouldBe` success (Params [Colon]) 1
it "rejects input if current token is not parseable" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Ampersand, T.Colon, T.Colon, T.Colon]
parseMany colonParser combiner input `shouldBe` Nothing
parseMany colonParser combiner input `shouldBe` Nothing
it "supports empty input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = []
parseMany colonParser combiner input `shouldBe` Nothing
parseMany colonParser combiner input `shouldBe` Nothing
describe "parseMany0" $ do
it "parses many occurrences on truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Colon, T.Colon, T.Colon]
parseMany0 colonParser combiner input `shouldBe` success (Params [Colon, Colon, Colon]) 3
it "parses single occurence on truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Colon]
parseMany0 colonParser combiner input `shouldBe` success (Params [Colon]) 1
parseMany0 colonParser combiner input `shouldBe` success (Params [Colon]) 1
it "parses many occurrences on non-truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Colon, T.Colon, T.Colon, T.Ampersand]
parseMany0 colonParser combiner input `shouldBe` success (Params [Colon, Colon, Colon]) 3
it "parses single occurence on non-truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Colon, T.Ampersand]
parseMany0 colonParser combiner input `shouldBe` success (Params [Colon]) 1
parseMany0 colonParser combiner input `shouldBe` success (Params [Colon]) 1
it "accepts input even though current token is not parseable" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = [T.Ampersand, T.Colon, T.Colon, T.Colon]
parseMany0 colonParser combiner input `shouldBe` success Empty 0
parseMany0 colonParser combiner input `shouldBe` success Empty 0
it "supports empty input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let combiner = Params
let input = []
parseMany0 colonParser combiner input `shouldBe` success Empty 0
@@ -375,7 +368,7 @@ spec = do
, Nothing
, Nothing
, Nothing
, Nothing
, Nothing
]
let input = [T.StringLiteral "some not important input"]
parseAny parsers input `shouldBe` success Ampersand 1
@@ -384,7 +377,7 @@ spec = do
, Nothing
, success (Integer 4) 1
, Nothing
, Nothing
, Nothing
, success (LabelDef Local "not me") 2
, Nothing
, success (Instruction (Operator Push) Empty) 1
@@ -395,14 +388,14 @@ spec = do
, success Colon 1
, Nothing
]
let input = [T.StringLiteral "some not important input"]
let input = [T.StringLiteral "some not important input"]
parseAny parsers input `shouldBe` success (Integer 4) 1
it "returns Nothing if no one of the parsers matches the input" $ do
let parsers = map const (take 4 $ repeat $ Nothing)
let input = [T.StringLiteral "some not important input"]
let parsers = replicate 4 (const Nothing)
let input = [T.StringLiteral "some not important input"]
parseAny parsers input `shouldBe` Nothing
it "always returns Nothing if no parsers are defined" $ do
let input = [T.StringLiteral "some not important input"]
let input = [T.StringLiteral "some not important input"]
parseAny [] input `shouldBe` Nothing
it "supports empty input irrespective of wrapped parsers" $ do
let parsers = map const [ success (Integer 4) 1
@@ -413,45 +406,45 @@ spec = do
, success Colon 1
]
let input = []
parseAny parsers input `shouldBe` Nothing
parseAny parsers input `shouldBe` Nothing
describe "parseSeq" $ do
it "parses truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let ampersandParser (T.Ampersand:_) = success Ampersand 1
ampersandParser _ = Nothing
ampersandParser _ = Nothing
let combiner = Params
let pattern = [colonParser, ampersandParser]
let input = [T.Colon, T.Ampersand]
parseSeq pattern combiner input `shouldBe` success (Params [Colon, Ampersand]) 2
it "parses non-truncated input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let ampersandParser (T.Ampersand:_) = success Ampersand 1
ampersandParser _ = Nothing
ampersandParser _ = Nothing
let combiner = Params
let pattern = [colonParser, ampersandParser]
let input = [T.Colon, T.Ampersand, T.Colon]
parseSeq pattern combiner input `shouldBe` success (Params [Colon, Ampersand]) 2
it "rejects incomplete pattern" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let ampersandParser (T.Ampersand:_) = success Ampersand 1
ampersandParser _ = Nothing
ampersandParser _ = Nothing
let combiner = Params
let pattern = [colonParser, ampersandParser]
let input = [T.Colon]
parseSeq pattern combiner input `shouldBe` Nothing
parseSeq pattern combiner input `shouldBe` Nothing
it "rejects non-matching input" $ do
let colonParser (T.Colon:_) = success Colon 1
colonParser _ = Nothing
colonParser _ = Nothing
let ampersandParser (T.Ampersand:_) = success Ampersand 1
ampersandParser _ = Nothing
ampersandParser _ = Nothing
let combiner = Params
let pattern = [colonParser, ampersandParser]
let input = [T.Ampersand, T.Colon]
parseSeq pattern combiner input `shouldBe` Nothing
parseSeq pattern combiner input `shouldBe` Nothing
it "supports empty input irrespective of wrapped parsers" $ do
let pattern = map const [ success (Integer 4) 1
, success (LabelDef Global "not me") 2
@@ -471,11 +464,11 @@ spec = do
it "returns Nothing if there are tokens left to be consumed, even though the wrapped parser succeeded to parse" $ do
let parser = const $ success Colon 1
let input = [T.Colon, T.Ampersand]
assertConsumed parser input `shouldBe` Nothing
assertConsumed parser input `shouldBe` Nothing
it "supports empty input" $ do
let parser = const $ success Colon 1
let input = []
assertConsumed parser input `shouldBe` Nothing
assertConsumed parser input `shouldBe` Nothing
describe "parse" $ do
it "parses empty input" $ do
@@ -486,11 +479,11 @@ spec = do
let input = "add1_2: push 1\npush 2\nadd"
let (Right tokens) = T.tokenize input
-- Labels: Operations: Params:
let expected = Program [ (Line (LabelDef Global "add1_2") (Instruction (Operator Push) (Params [Param $ Integer 1])))
, (Line Empty (Instruction (Operator Push) (Params [Param $ Integer 2])))
, (Line Empty (Instruction (Operator Add) Empty))
let expected = Program [ Line (LabelDef Global "add1_2") (Instruction (Operator Push) (Params [Param $ Integer 1]))
, Line Empty (Instruction (Operator Push) (Params [Param $ Integer 2]))
, Line Empty (Instruction (Operator Add) Empty)
]
parse tokens `shouldBe` (Right $ expected :: Either String AST)
parse tokens `shouldBe` (Right expected :: Either String AST)
it "rejects multiple instructions in single line" $ do
let input = "push 1 add"
let (Right tokens) = T.tokenize input
@@ -500,9 +493,9 @@ spec = do
let (Right tokens) = T.tokenize input
parse tokens `shouldBe` (Left "Parse error(s):\n[Identifier \"label1\",Colon,Identifier \"label2\",Colon]" :: Either String AST)
it "rejects instruction followed by a label definition" $ do
let input = "pop label:"
let input = "pop label:"
let (Right tokens) = T.tokenize input
parse tokens `shouldBe` (Left "Parse error(s):\n[Operator Pop,Identifier \"label\",Colon]" :: Either String AST)
parse tokens `shouldBe` (Left "Parse error(s):\n[Operator Pop,Identifier \"label\",Colon]" :: Either String AST)
it "rejects orphaned identifiers" $ do
let inputs = ["id", "push id", "main: id", "id main:"]
let tokens = map ((\(Right t) -> t) . T.tokenize) inputs
@@ -521,7 +514,7 @@ spec = do
, "Parse error(s):\n[Ampersand,IntLiteral 4]"
, "Parse error(s):\n[Identifier \"label\",IntLiteral 5,Colon]"
] :: [Either String AST]
map parse tokens `shouldBe` expected
map parse tokens `shouldBe` expected
it "parses example #1" $ do
let input = "main: ; here we define some main label\n\
\ push 7 ; we push 7 to the stack\n\
@@ -533,12 +526,12 @@ spec = do
\ ret"
let (Right tokens) = T.tokenize input
-- Labels: Operations: Params:
let expected = Program [ (Line (LabelDef Global "main") Empty)
, (Line Empty (Instruction (Operator Push) (Params [Param $ Integer 7])))
, (Line Empty (Instruction (Operator Push) (Params [Param $ Integer 4])))
, (Line Empty (Instruction (Operator Call) (Params [Param $ LabelRef Global "sum"])))
, (Line Empty (Instruction (Operator Halt) Empty))
, (Line (LabelDef Global "sum") (Instruction (Operator Add) Empty))
, (Line Empty (Instruction (Operator Ret) Empty))
let expected = Program [ Line (LabelDef Global "main") Empty
, Line Empty (Instruction (Operator Push) (Params [Param $ Integer 7]))
, Line Empty (Instruction (Operator Push) (Params [Param $ Integer 4]))
, Line Empty (Instruction (Operator Call) (Params [Param $ LabelRef Global "sum"]))
, Line Empty (Instruction (Operator Halt) Empty)
, Line (LabelDef Global "sum") (Instruction (Operator Add) Empty)
, Line Empty (Instruction (Operator Ret) Empty)
]
parse tokens `shouldBe` (Right $ expected :: Either String AST)
parse tokens `shouldBe` (Right expected :: Either String AST)

158
test/Assembler/TokenizerSpec.hs
View File

@@ -12,7 +12,7 @@ success token consumed = Just $ TokenizeResult token consumed
spec :: Spec
spec = do
describe "keywordTokenizer" $ do
describe "keywordTokenizer" $ do
it "supports truncated input" $
keywordTokenizer True "hey" NewLine "hey" `shouldBe` success NewLine 3
it "supports non-truncated input" $
@@ -20,12 +20,12 @@ spec = do
it "supports case sensitivity" $
keywordTokenizer True "hey" NewLine "heYjude" `shouldBe` Nothing
it "supports case insensitivity" $
keywordTokenizer False "hey" NewLine "heYjude" `shouldBe` success NewLine 3
keywordTokenizer False "hey" NewLine "heYjude" `shouldBe` success NewLine 3
it "returns correct token" $
keywordTokenizer True "hey" Colon "heyjude" `shouldBe` success Colon 3
it "returns Nothing if input does not match" $
keywordTokenizer True "hey" Colon "xheyjude" `shouldBe` Nothing
it "supports empty input" $
it "supports empty input" $
keywordTokenizer True "hey" Colon "" `shouldBe` Nothing
describe "operatorTokenizer" $ do
@@ -35,7 +35,7 @@ spec = do
operatorTokenizer Pop "pops" `shouldBe` success (Operator Pop) 3
it "returns Nothing if input does not match" $
operatorTokenizer Pop "poop" `shouldBe` Nothing
it "supports empty input" $
it "supports empty input" $
operatorTokenizer Call "" `shouldBe` Nothing
describe "tokenizeOperators" $ do
@@ -53,7 +53,7 @@ spec = do
map tokenizeOperators input `shouldBe` expected
it "rejects other input" $
tokenizeOperators "some unsupported input" `shouldBe` Nothing
it "supports empty input" $
it "supports empty input" $
tokenizeOperators "" `shouldBe` Nothing
describe "tokenizeIdentifier" $ do
@@ -62,12 +62,12 @@ spec = do
it "parses correct identifier with numbers" $
tokenizeIdentifier "someId14" `shouldBe` success (Identifier "someId14") 8
it "parses correct identifier with underscores" $
tokenizeIdentifier "some_Id" `shouldBe` success (Identifier "some_Id") 7
it "disallows to start identifier with underscore" $
tokenizeIdentifier "some_Id" `shouldBe` success (Identifier "some_Id") 7
it "disallows to start identifier with underscore" $
tokenizeIdentifier "_someId" `shouldBe` Nothing
it "disallows to start identifier with digit" $
it "disallows to start identifier with digit" $
tokenizeIdentifier "5someId" `shouldBe` Nothing
it "supports empty input" $
it "supports empty input" $
tokenizeIdentifier "" `shouldBe` Nothing
describe "tokenizeWhitespace" $ do
@@ -80,12 +80,12 @@ spec = do
it "parses CR" $
tokenizeWhitespace "\r" `shouldBe` success WhiteSpace 1
it "rejects non-whitespace chars" $ do
let input = map (\x -> [x]) $ ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9']
let expected = take (length input) . repeat $ Nothing
let input = map (: []) $ ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9']
let expected = replicate (length input) Nothing
map tokenizeWhitespace input `shouldBe` expected
it "supports empty input" $
tokenizeIdentifier "" `shouldBe` Nothing
it "supports empty input" $
tokenizeIdentifier "" `shouldBe` Nothing
describe "tokenizeDecimal" $ do
it "parses numbers from 0 to 65535" $ do
let nums = [0 .. 65535]
@@ -95,34 +95,34 @@ spec = do
it "does not support negative numbers" $ do
let nums = [-1, -2 .. -65535] :: [Integer]
let input = map show nums
let expected = take (length nums) . repeat $ Nothing
let expected = replicate (length nums) Nothing
map tokenizeDecimal input `shouldBe` expected
it "rejects other input" $
tokenizeDecimal "some unsupported input" `shouldBe` Nothing
it "supports empty input" $
tokenizeDecimal "" `shouldBe` Nothing
tokenizeDecimal "some unsupported input" `shouldBe` Nothing
it "supports empty input" $
tokenizeDecimal "" `shouldBe` Nothing
describe "tokenizeHex" $ do
it "parses numbers from 0x0 to 0xFFFF" $ do
let nums = [0 .. 0xFFFF]
let input = map (("0x"++) . (flip showHex "")) nums
let expected = map (\n -> success (IntLiteral n) (length . ("0x"++) . (flip showHex "") $ n)) nums
let input = map (("0x"++) . flip showHex "") nums
let expected = map (\n -> success (IntLiteral n) (length . ("0x"++) . flip showHex "" $ n)) nums
map tokenizeHex input `shouldBe` expected
it "does not support negative numbers" $ do
let nums = [0 .. 0xFFFF] :: [Integer]
let input = map (("-0x"++) . (flip showHex "")) nums
let expected = take (length nums) . repeat $ Nothing
map tokenizeHex input `shouldBe` expected
let input = map (("-0x"++) . flip showHex "") nums
let expected = replicate (length nums) Nothing
map tokenizeHex input `shouldBe` expected
it "accepts left-padded number" $
tokenizeHex "0x0010" `shouldBe` success (IntLiteral 16) 6
it "rejects other input" $
tokenizeHex "some unsupported input" `shouldBe` Nothing
tokenizeHex "some unsupported input" `shouldBe` Nothing
it "rejects '0'" $
tokenizeHex "0" `shouldBe` Nothing
it "rejects '0x'" $
tokenizeHex "0x" `shouldBe` Nothing
it "supports empty input" $
tokenizeHex "" `shouldBe` Nothing
tokenizeHex "0x" `shouldBe` Nothing
it "supports empty input" $
tokenizeHex "" `shouldBe` Nothing
describe "tokenizeChar" $ do
it "parses letters literals" $ do
@@ -134,13 +134,13 @@ spec = do
let chars = ['0' .. '9']
let input = map (\c -> "'" ++ [c] ++ "'") chars
let expected = map (\c -> success (IntLiteral (ord c)) 3) chars
map tokenizeChar input `shouldBe` expected
map tokenizeChar input `shouldBe` expected
it "parses regular symbols literals" $ do
let chars = "!@#$%^&*()_+-=[]{};:|,/?<>\""
let input = map (\c -> "'" ++ [c] ++ "'") chars
let expected = map (\c -> success (IntLiteral (ord c)) 3) chars
map tokenizeChar input `shouldBe` expected
it "parses escape sequences literals" $ do
map tokenizeChar input `shouldBe` expected
it "parses escape sequences literals" $ do
let input = [ "'\\n'"
, "'\\t'"
, "'\\v'"
@@ -162,7 +162,7 @@ spec = do
tokenizeChar "'ab'" `shouldBe` Nothing
it "rejects non-closed char literals" $
tokenizeChar "'a" `shouldBe` Nothing
it "rejects invalid escape sequences" $
it "rejects invalid escape sequences" $
tokenizeChar "'\\x'" `shouldBe` Nothing
it "rejects empty quotes" $
tokenizeChar "''" `shouldBe` Nothing
@@ -185,9 +185,8 @@ spec = do
let str = "!@2#$%9^&*(1)_s+2-=[2h6sh]t{};:'e|<>,./?"
let len = length str + 2
let input = "\"" ++ str ++ "\""
tokenizeString input `shouldBe` success (StringLiteral str) len
it "supports escape sequences literals" $ do
pendingWith "We need probably to fix tokenizeString since the following test fails"
tokenizeString input `shouldBe` success (StringLiteral str) len
it "supports escape sequences literals" $ pendingWith "We need probably to fix tokenizeString since the following test fails"
-- TODO:
-- let str = "\\n\\t\\v\\b\\r\\f\\a\\\\\\\"\\0"
-- let len = length str + 2
@@ -207,18 +206,18 @@ spec = do
it "rejects multilined strings" $
tokenizeString "\"first line\nsecond line\"" `shouldBe` Nothing
it "supports empty input" $
tokenizeString "" `shouldBe` Nothing
tokenizeString "" `shouldBe` Nothing
describe "tokenizeComment" $ do
it "properly consumes comment" $
it "properly consumes comment" $
tokenizeComment ";some comment\n" `shouldBe` success (Comment "some comment") 13
it "properly consumes comment with whitespace padding" $
tokenizeComment "; \t some comment \t \n \t" `shouldBe` success (Comment " \t some comment \t ") 22
it "properly consumes comment with whitespace padding" $
tokenizeComment "; \t some comment \t \n \t" `shouldBe` success (Comment " \t some comment \t ") 22
it "does not treat the input as a comment if it does not start with semicolon" $
tokenizeComment "some not valid comment\n" `shouldBe` Nothing
it "expands the comment till the end of the line" $
it "expands the comment till the end of the line" $
tokenizeComment "; some comment ; push 4 push 10\nadd" `shouldBe` success (Comment " some comment ; push 4 push 10") 31
it "parses the comment at the end of the input" $
it "parses the comment at the end of the input" $
tokenizeComment "; some comment " `shouldBe` success (Comment " some comment ") 15
it "supports empty input" $
tokenizeComment "" `shouldBe` Nothing
@@ -241,7 +240,7 @@ spec = do
it "does not produce any token when the space is present instead" $ do
let input = "abc "
let tokenizer _ = success Colon 3
sepTokenizer ('-'==) tokenizer input `shouldBe` Nothing
sepTokenizer ('-'==) tokenizer input `shouldBe` Nothing
it "does not change the number of consumed chars even though it's checking the separator presence" $ do
let input = "abc-"
let expected = success Colon 3
@@ -251,24 +250,24 @@ spec = do
it "supports empty input irrespective of wrapped tokenizer" $ do
let input = ""
let tokenizer _ = success Colon 3 -- MOCK: tokenizer returns Just even though the input is empty
sepTokenizer ('-'==) tokenizer input `shouldBe` Nothing
sepTokenizer ('-'==) tokenizer input `shouldBe` Nothing
describe "anyTokenizer" $ do
it "returns the token if at least one subtokenizer produce that" $ do
let values = [ success Ampersand 1
, Nothing
, Nothing
, Nothing
, Nothing
, Nothing
]
let t = map (\x -> (\_ -> x)) values
let t = map const values
anyTokenizer t "some not important input" `shouldBe` success Ampersand 1
it "returns the token of the first matching subtokenizer" $ do
let values = [ Nothing
, Nothing
, success (IntLiteral 4) 1
, Nothing
, Nothing
, Nothing
, success (StringLiteral "not me") 8
, Nothing
, success (StringLiteral "me neither") 12
@@ -279,19 +278,19 @@ spec = do
, success Colon 1
, Nothing
]
let t = map (\x -> (\_ -> x)) values
let t = map const values
anyTokenizer t "some not important input" `shouldBe` success (IntLiteral 4) 1
it "returns Nothing if no one of the tokenizers matches the input" $ do
let values = [ Nothing
, Nothing
, Nothing
, Nothing
, Nothing
, Nothing
]
let t = map (\x -> (\_ -> x)) values
let t = map const values
anyTokenizer t "some not important input" `shouldBe` Nothing
it "always returns Nothing if no tokenizers are defined" $
anyTokenizer [] "some not important input" `shouldBe` Nothing
anyTokenizer [] "some not important input" `shouldBe` Nothing
it "supports empty input irrespective of wrapped tokenizers" $ do
let input = ""
let values = [ success Ampersand 1
@@ -299,47 +298,46 @@ spec = do
, success (IntLiteral 3) 1
, success (Operator Push) 4
]
let t = map (\x -> (\_ -> x)) values
anyTokenizer t input `shouldBe` Nothing
let t = map const values
anyTokenizer t input `shouldBe` Nothing
describe "tokenFilter" $ do
it "filters out whitespaces and comments" $ do
let tokens = [ Operator Push
describe "tokenFilter" $ it "filters out whitespaces and comments" $ do
let tokens = [ Operator Push
, IntLiteral 4
, Comment "here is the identifier"
, Identifier "someId"
, WhiteSpace
, Colon
, WhiteSpace
, Ampersand
, NewLine
, WhiteSpace
, Comment "some comment"
]
let expected = [ Operator Push
, IntLiteral 4
, Comment "here is the identifier"
, Identifier "someId"
, WhiteSpace
, Colon
, WhiteSpace
, Ampersand
, NewLine
, WhiteSpace
, Comment "some comment"
]
let expected = [ Operator Push
, IntLiteral 4
, Identifier "someId"
, Colon
, Ampersand
, NewLine
]
filter tokenFilter tokens `shouldBe` expected
filter tokenFilter tokens `shouldBe` expected
describe "tokenize" $ do
it "treats 'pop' as a operator instead of identifier" $
tokenize "pop" `shouldBe` Right [Operator Pop]
it "treats 'poop' as a identifier" $
tokenize "poop" `shouldBe` Right [Identifier "poop"]
tokenize "poop" `shouldBe` Right [Identifier "poop"]
it "treats operator as themselves instead of identifiers" $ do
let ops = [Nop ..]
let input = map show ops
let expected = map (\o -> Right [Operator o]) ops
let expected = map (\o -> Right [Operator o]) ops
map tokenize input `shouldBe` expected
it "treats operator-like names (with 's' appended) as identifiers" $ do
let ops = [Nop ..]
let input = map ((++"s") . show) ops
let expected = map (\i-> Right [Identifier i]) input
map tokenize input `shouldBe` expected
let expected = map (\i-> Right [Identifier i]) input
map tokenize input `shouldBe` expected
it "treats '\n' as a newline instead of whitespace" $
tokenize "\n" `shouldBe` Right [NewLine]
it "ignores comments" $ do
@@ -355,11 +353,11 @@ spec = do
it "accepts 'main: NL" $
tokenize ".main: \n" `shouldBe` Right [Dot, Identifier "main", Colon, NewLine]
it "accepts 'call &sum NL" $
tokenize "call &sum \n" `shouldBe` Right [Operator Call, Ampersand, Identifier "sum", NewLine]
tokenize "call &sum \n" `shouldBe` Right [Operator Call, Ampersand, Identifier "sum", NewLine]
it "rejects '4push'" $
tokenize "4push" `shouldBe` Left "Unknown token: 4push"
it "supports empty input" $
tokenize "" `shouldBe` Right []
tokenize "4push" `shouldBe` Left "Unknown token: 4push"
it "supports empty input" $
tokenize "" `shouldBe` Right []
it "interprets example #1" $ do
let input = "main: ; here we define some main label\n\
\ push 7 ; we push 7 to the stack\n\
@@ -377,5 +375,5 @@ spec = do
, NewLine
, Identifier "sum", Colon, Operator Add, NewLine
, Operator Ret
]
tokenize input `shouldBe` Right expected
]
tokenize input `shouldBe` Right expected

118
test/VirtualMachineSpec.hs
View File

@@ -741,14 +741,14 @@ spec = do
let vm = empty { _stack = S.fromList [], _fp = 0 }
let input = " ret \n\
\ halt "
let expected = Left "Cannot determine previous frame pointer (fp)"
let expected = Left "Cannot determine frame pointer (fp) - index 0 out of frame bounds"
actual <- exec vm input
actual `shouldBe` expected
it "raises error if there is no return address on the stack (stack size is 1)" $ do
let vm = empty { _stack = S.fromList [-1], _fp = 0 }
let input = " ret \n\
\ halt "
let expected = Left "Cannot determine return address"
let expected = Left "Cannot determine return address - index 1 out of frame bounds"
actual <- exec vm input
actual `shouldBe` expected
@@ -790,7 +790,7 @@ spec = do
it "raises error if stack is empty" $ do
let input = " lda 0 \n\
\ halt "
let expected = Left "Index 0 out of stack bounds"
let expected = Left "Cannot determine call argument - index 0 out of frame bounds"
let vm = empty { _stack = S.fromList [], _fp = 0 }
actual <- exec vm input
actual `shouldBe` expected
@@ -798,14 +798,14 @@ spec = do
let vm = empty { _stack = S.fromList [-1], _fp = 0 }
let input = " lda 0 \n\
\ halt "
let expected = Left "Index 0 out of stack bounds"
let expected = Left "Cannot determine call argument - index 0 out of frame bounds"
actual <- exec vm input
actual `shouldBe` expected
it "raises error if stack contains only previous fp and return address" $ do
let vm = empty { _stack = S.fromList [2, -1], _fp = 0 }
let input = " lda 0 \n\
\ halt "
let expected = Left "Index 0 out of stack bounds"
let expected = Left "Cannot determine call argument - index 0 out of frame bounds"
actual <- exec vm input
actual `shouldBe` expected
it "loads the first (0) argument if stack contains only previous fp, return address and single argument" $ do
@@ -819,7 +819,7 @@ spec = do
let vm = empty { _stack = S.fromList [2, -1, 3], _fp = 1 }
let input = " lda 1 \n\
\ halt "
let expected = Left "Index 1 out of stack bounds"
let expected = Left "Cannot determine call argument - index 1 out of frame bounds"
actual <- exec vm input
actual `shouldBe` expected
it "loads the 11th argument if it exists" $ do
@@ -861,109 +861,7 @@ spec = do
\ ret "
let expected = done [25] 8 (-1)
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
@@ -1017,7 +915,7 @@ spec = do
\ push 3 \n\
\ ldl 0 \n\
\ halt "
let expected = Left "No active stack frame to load local variable"
let expected = Left "No active stack frame"
actual <- run input
actual `shouldBe` expected
@@ -1040,7 +938,7 @@ spec = do
\ push 3 \n\
\ stl 0 \n\
\ halt "
let expected = Left "No active stack frame to store local variable"
let expected = Left "No active stack frame"
actual <- run input
actual `shouldBe` expected