Add support for local labels

This commit is contained in:
2021-11-15 14:05:18 +01:00
parent 5ad4114405
commit 18ddfa611d
8 changed files with 344 additions and 255 deletions

View File

@@ -8,7 +8,7 @@ import Control.Monad.State (evalState, get)
import Control.Monad.Trans.Except (runExceptT)
import Assembler.Tokenizer (tokenize)
import Assembler.Parser (AST(..), parse)
import Assembler.Parser (AST(..), Scope(..), parse)
import Assembler.Emitter as E
import VirtualMachine.VM (Op(..))
@@ -18,17 +18,76 @@ evalContext ctx ast emitter = flip evalState ctx $ runExceptT $ emitter ast >> l
spec :: Spec
spec = do
describe "emitLabelDef" $ do
it "inserts label definition to the context" $ do
it "inserts global label definition to the context" $ do
let ctx = E.empty
let input = LabelDef "main"
let expected = Right (ctx { _labels = M.fromList[("main", 0)] })
let input = LabelDef Global "main"
let expected = Right (ctx { _labels = M.fromList [("main", 0)], _currentLabel = Just "main" })
evalContext ctx input emitLabelDef `shouldBe` expected
it "does not allow to redefine label" $ do
it "does not allow to redefine global label" $ do
let ctx = E.empty { _labels = M.fromList [("main", 0)] }
let input = LabelDef "main"
let input = LabelDef Global "main"
let expected = Left "Label 'main' is already defined"
evalContext ctx input emitLabelDef `shouldBe` expected
it "does not allow to redefine global label" $ do
let ctx = E.empty { _labels = M.fromList [("main", 0)] }
let input = LabelDef Global "main"
let expected = Left "Label 'main' is already defined"
evalContext ctx input emitLabelDef `shouldBe` expected
it "inserts local label definition to the context" $ 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
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
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"
let expected = Left "Label 'foo' is already defined in the global label 'main' scope"
evalContext ctx input emitLabelDef `shouldBe` expected
it "does not allow to define local label outside global label scope" $ do
let ctx = E.empty
let input = LabelDef Local "foo"
let expected = Left "Local label ('.foo') can be defined only in the global label scope"
evalContext ctx input emitLabelDef `shouldBe` expected
describe "emitParam" $ do
it "emits byte for integer literal" $ do
let ctx = E.empty
let input = Param (Integer 4)
let expected = Right (ctx { _beans = [Byte 0x04] })
evalContext ctx input emitParam `shouldBe` expected
it "emits reference mark for global label reference" $ do
let ctx = E.empty
let input = Param (LabelRef Global "main")
let expected = Right (ctx { _beans = [Reference "main"] })
evalContext ctx input emitParam `shouldBe` expected
it "emits reference mark for local label reference" $ do
let ctx = E.empty { _labels = M.fromList [("main", 0)], _currentLabel = Just "main"}
let input = Param (LabelRef Local "foo")
let expected = Right (ctx { _beans = [Reference "main.foo"] })
evalContext ctx input emitParam `shouldBe` expected
it "does not allow to reference local label outside global label scope" $ do
let ctx = E.empty
let input = Param (LabelRef Local "foo")
let expected = Left "Local label ('.foo') reference is allowed only in the global label scope"
evalContext ctx input emitParam `shouldBe` expected
describe "emitInstr" $ do
it "emits byte for no-param instruction" $ do
let ctx = E.empty
let input = Instruction (Operator Halt) Empty
let expected = Right (ctx { _beans = [Byte 0x01] })
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 expected = Right (ctx { _beans = [Byte 0x02, Byte 0x0B, Reference "main"] })
evalContext ctx input emitInstr `shouldBe` expected
describe "resolveLabels" $ do
it "replaces reference with actual byte number" $ do
let beans = [ Byte 1, Byte 2, Reference "main", Byte 4 ]
@@ -40,51 +99,46 @@ spec = do
let expected = Left "Label 'not_existing_label' is not defined"
resolveLabels labels beans `shouldBe` expected
describe "emitParam" $ do
it "emits byte for integer literal" $ do
let ctx = E.empty
let input = Param (Integer 4)
let expected = Right (ctx { _beans = [Byte 0x04] })
evalContext ctx input emitParam `shouldBe` expected
it "emits reference mark for label reference" $ do
let ctx = E.empty
let input = Param (LabelRef "main")
let expected = Right (ctx { _beans = [Reference "main"] })
evalContext ctx input emitParam `shouldBe` expected
describe "emitInstr" $ do
it "emits byte for no-param instruction" $ do
let ctx = E.empty
let input = Instruction (Operator Halt) Empty
let expected = Right (ctx { _beans = [Byte 0x01] })
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 "main"))])
let expected = Right (ctx { _beans = [Byte 0x02, Byte 0x0B, Reference "main"] })
evalContext ctx input emitInstr `shouldBe` expected
describe "emit" $ do
it "label resolution works" $ do
let input = "main: \n\
\push 1\n\
\push 2\n\
\jmp &sum\n\
\\n\
\sum: add\n\
\jmp &main"
it "global label resolution works" $ do
let input = "main: \n\
\ push 1 \n\
\ push 2 \n\
\ jmp &sum \n\
\ sum: add \n\
\ jmp &main "
let (Right tokens) = tokenize input
let (Right ast) = parse tokens
let expected = [0x02, 0x01, 0x02, 0x02, 0x0e, 0x06, 0x06, 0x0e, 0x00]
emit ast `shouldBe` Right expected
it "local label resolution works" $ do
let input = " main: \n\
\ .loop: push 1 \n\
\ push 2 \n\
\ jmp &.sum \n\
\ .sum: add \n\
\ jmp &.loop \n\
\ foo: \n\
\ .loop: push 1 \n\
\ push 2 \n\
\ jmp &.sum \n\
\ .sum: add \n\
\ jmp &.loop "
let (Right tokens) = tokenize input
let (Right ast) = parse tokens
-- The differences: &.sum &.loop
-- vvvv vvvv
let expected = [ 0x02, 0x01, 0x02, 0x02, 0x0e, 0x06, 0x06, 0x0e, 0x00 -- 'main' scope
, 0x02, 0x01, 0x02, 0x02, 0x0e, 0x0f, 0x06, 0x0e, 0x09 -- 'foo' scope
]
emit ast `shouldBe` Right expected
it "raises error if label has not been defined" $ do
let input = "main: \n\
\push 1\n\
\push 2\n\
\jmp &sum\n\
\\n\
\sum: add\n\
\jmp &program"
let input = " main: \n\
\ push 1 \n\
\ push 2 \n\
\ jmp &sum \n\
\ sum: add \n\
\ jmp &program "
let (Right tokens) = tokenize input
let (Right ast) = parse tokens
emit ast `shouldBe` Left "Label 'program' is not defined"

View File

@@ -58,26 +58,30 @@ spec = do
parseAmpersand [] `shouldBe` Nothing
describe "parseLabelDef" $ do
it "parses 'label:'" $
parseLabelDef [T.Identifier "label", T.Colon] `shouldBe` success (LabelDef "label") 2
it "parses global label def" $
parseLabelDef [T.Identifier "label", T.Colon] `shouldBe` success (LabelDef Global "label") 2
it "parses local label def" $
parseLabelDef [T.Dot, T.Identifier "label", T.Colon] `shouldBe` success (LabelDef Local "label") 3
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 "sum") 2
parseLabelDef [T.Identifier "sum", T.Colon, T.Operator Nop] `shouldBe` success (LabelDef Global "sum") 2
it "supports empty input" $
parseLabelDef [] `shouldBe` Nothing
describe "parseLabelRef" $ do
it "parses '&label'" $
parseLabelRef [T.Ampersand, T.Identifier "label"] `shouldBe` success (LabelRef "label") 2
it "parses global label ref" $
parseLabelRef [T.Ampersand, T.Identifier "label"] `shouldBe` success (LabelRef Global "label") 2
it "parses local label" $
parseLabelRef [T.Ampersand, T.Dot, T.Identifier "label"] `shouldBe` success (LabelRef Local "label") 3
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 "sum") 2
parseLabelRef [T.Ampersand, T.Identifier "sum", T.Operator Nop] `shouldBe` success (LabelRef Global "sum") 2
it "supports empty input" $
parseLabelRef [] `shouldBe` Nothing
@@ -88,7 +92,7 @@ spec = do
let expected = map (flip success 1 . Param . Integer) ints
map parseParam input `shouldBe` expected
it "parses label references" $ do
let expected = success (Param (LabelRef "program")) 2
let expected = success (Param (LabelRef Global "program")) 2
parseParam [T.Ampersand, T.Identifier "program"] `shouldBe` expected
it "supports non-truncated input" $ do
let expected = success (Param (Integer 1)) 1
@@ -118,7 +122,7 @@ spec = do
let expected = success (Instruction
(Operator Call)
(Params [
(Param (LabelRef "program"))
(Param (LabelRef Global "program"))
])
) (length input)
parseInstr input `shouldBe` expected
@@ -141,18 +145,18 @@ spec = do
parseInstr input `shouldBe` expected
it "parses operator with multiple param ref params" $ do
let input = [T.Operator Push
, T.Ampersand, T.Identifier "program"
, T.Ampersand, T.Identifier "main"
, T.Ampersand, T.Dot, T.Identifier "program"
, T.Ampersand, T.Dot, T.Identifier "main"
, T.Ampersand, T.Identifier "foo"
, T.Ampersand, T.Identifier "bar"
, T.Ampersand, T.Dot, T.Identifier "bar"
]
let expected = success (Instruction
(Operator Push)
(Params [
(Param (LabelRef "program")),
(Param (LabelRef "main")),
(Param (LabelRef "foo")),
(Param (LabelRef "bar"))
(Param (LabelRef Local "program")),
(Param (LabelRef Local "main")),
(Param (LabelRef Global "foo")),
(Param (LabelRef Local "bar"))
])
) (length input)
parseInstr input `shouldBe` expected
@@ -160,23 +164,23 @@ spec = do
let input = [T.Operator Push
, T.Ampersand, T.Identifier "program"
, T.IntLiteral 4
, T.Ampersand, T.Identifier "main"
, T.Ampersand, T.Dot, T.Identifier "main"
, T.Ampersand, T.Identifier "foo"
, T.IntLiteral 10
, T.IntLiteral 11
, T.Ampersand, T.Identifier "bar"
, T.Ampersand, T.Dot, T.Identifier "bar"
, T.IntLiteral 20
]
let expected = success (Instruction
(Operator Push)
(Params [
(Param (LabelRef "program")),
(Param (LabelRef Global "program")),
(Param (Integer 4)),
(Param (LabelRef "main")),
(Param (LabelRef "foo")),
(Param (LabelRef Local "main")),
(Param (LabelRef Global "foo")),
(Param (Integer 10)),
(Param (Integer 11)),
(Param (LabelRef "bar")),
(Param (LabelRef Local "bar")),
(Param (Integer 20))
])
) (length input)
@@ -186,7 +190,7 @@ spec = do
, T.Ampersand, T.Identifier "program"
, T.IntLiteral 4
, T.Ampersand, T.Identifier "main"
, T.Ampersand, T.Identifier "foo"
, T.Ampersand, T.Dot, T.Identifier "foo"
, T.IntLiteral 10
, T.IntLiteral 11
, T.Ampersand, T.Identifier "bar"
@@ -197,29 +201,29 @@ spec = do
let expected = success (Instruction
(Operator Push)
(Params [
(Param (LabelRef "program")),
(Param (LabelRef Global "program")),
(Param (Integer 4)),
(Param (LabelRef "main")),
(Param (LabelRef "foo")),
(Param (LabelRef Global "main")),
(Param (LabelRef Local "foo")),
(Param (Integer 10)),
(Param (Integer 11)),
(Param (LabelRef "bar")),
(Param (LabelRef Global "bar")),
(Param (Integer 20))
])
) 13
) 14
parseInstr input `shouldBe` expected
it "supports empty input" $
parseInstr [] `shouldBe` Nothing
describe "parseLine" $ do
it "supports label definition and operator in the same line" $ do
let input = [T.Identifier "main", T.Colon, T.Operator Call, T.Ampersand, T.Identifier "program"]
let input = [T.Dot, T.Identifier "main", T.Colon, T.Operator Call, T.Ampersand, T.Identifier "program"]
let expected = success (Line
(LabelDef "main")
(LabelDef Local "main")
(Instruction
(Operator Call)
(Params [
(Param (LabelRef "program"))
(Param (LabelRef Global "program"))
])
)
) (length input)
@@ -227,18 +231,18 @@ spec = do
it "supports line with just label definition" $ do
let input = [T.Identifier "main", T.Colon]
let expected = success (Line
(LabelDef "main")
(LabelDef Global "main")
Empty
) (length input)
parseLine input `shouldBe` expected
it "supports line with just operator" $ do
let input = [T.Operator Call, T.Ampersand, T.Identifier "program"]
let input = [T.Operator Call, T.Ampersand, T.Dot, T.Identifier "program"]
let expected = success (Line
Empty
(Instruction
(Operator Call)
(Params [
(Param (LabelRef "program"))
(Param (LabelRef Local "program"))
])
)
) (length input)
@@ -246,11 +250,11 @@ spec = do
it "supports non-truncated input" $ do
let input = [T.Identifier "main", T.Colon, T.Operator Call, T.Ampersand, T.Identifier "program", T.Identifier "exit"]
let expected = success (Line
(LabelDef "main")
(LabelDef Global "main")
(Instruction
(Operator Call)
(Params [
(Param (LabelRef "program"))
(Param (LabelRef Global "program"))
])
)
) 5
@@ -381,7 +385,7 @@ spec = do
, success (Integer 4) 1
, Nothing
, Nothing
, success (LabelDef "not me") 2
, success (LabelDef Local "not me") 2
, Nothing
, success (Instruction (Operator Push) Empty) 1
, Nothing
@@ -402,7 +406,7 @@ spec = do
parseAny [] input `shouldBe` Nothing
it "supports empty input irrespective of wrapped parsers" $ do
let parsers = map const [ success (Integer 4) 1
, success (LabelDef "not me") 2
, success (LabelDef Local "not me") 2
, success (Instruction (Operator Push) Empty) 1
, Nothing
, success Ampersand 1
@@ -450,7 +454,7 @@ spec = do
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 "not me") 2
, success (LabelDef Global "not me") 2
, success (Instruction (Operator Push) Empty) 1
, success Ampersand 1
, success Colon 1
@@ -481,10 +485,10 @@ spec = do
it "parses line by line" $ do
let input = "add1_2: push 1\npush 2\nadd"
let (Right tokens) = T.tokenize input
-- Labels: Operations: Params:
let expected = Program [ (Line (LabelDef "add1_2") (Instruction (Operator Push) (Params [Param $ Integer 1])))
, (Line Empty (Instruction (Operator Push) (Params [Param $ Integer 2])))
, (Line Empty (Instruction (Operator Add) Empty))
-- 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))
]
parse tokens `shouldBe` (Right $ expected :: Either String AST)
it "rejects multiple instructions in single line" $ do
@@ -528,13 +532,13 @@ spec = do
\ sum: add\n\
\ ret"
let (Right tokens) = T.tokenize input
-- Labels: Operations: Params:
let expected = Program [ (Line (LabelDef "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 "sum"])))
, (Line Empty (Instruction (Operator Halt) Empty))
, (Line (LabelDef "sum") (Instruction (Operator Add) Empty))
, (Line Empty (Instruction (Operator Ret) Empty))
-- 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))
]
parse tokens `shouldBe` (Right $ expected :: Either String AST)

View File

@@ -353,7 +353,7 @@ spec = do
it "treats 'someId1234' as 'someId1234' identifier instead of 'someId' identifier and 1234 int" $
tokenize "someId1234" `shouldBe` Right [Identifier "someId1234"]
it "accepts 'main: NL" $
tokenize "main: \n" `shouldBe` Right [Identifier "main", Colon, NewLine]
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]
it "rejects '4push'" $

View File

@@ -1055,13 +1055,13 @@ spec = do
\ clr 2 \n\
\ halt \n\
\ \n\
\ sum: lda 0 \n\
\ lda 1 \n\
\ sum: lda 0 \n\
\ lda 1 \n\
\ add \n\
\ ret \n\
\ \n\
\ prd: lda 0 \n\
\ lda 1 \n\
\ prd: lda 0 \n\
\ lda 1 \n\
\ mul \n\
\ ret "
let expected = done [2*3+5] 14 (-01)
@@ -1069,97 +1069,97 @@ spec = do
actual `shouldBe` expected
it "example #2" $ do
let input = " main: push 100 \n\
\ loop: push 1 \n\
\ sub \n\
\ jne &loop \n\
\ halt "
let input = " main: push 100 \n\
\ .loop: push 1 \n\
\ sub \n\
\ jne &.loop \n\
\ halt "
let expected = done [0] 7 (-1)
actual <- run input
actual `shouldBe` expected
it "example #3: power - loop variant" $ do
let input = " push 3 \n\
\ push 6 \n\
\ call &pow \n\
\ clr 2 \n\
\ halt \n\
\ pow: lda 1 \n\
\ lda 0 \n\
\ push 1 \n\
\ loop: ldl 1 \n\
\ je &done \n\
\ pop \n\
\ ldl 2 \n\
\ ldl 0 \n\
\ mul \n\
\ stl 2 \n\
\ ldl 1 \n\
\ push 1 \n\
\ sub \n\
\ stl 1 \n\
\ jmp &loop \n\
\ done: ldl 2 \n\
\ ret "
let input = " push 3 \n\
\ push 6 \n\
\ call &pow \n\
\ clr 2 \n\
\ halt \n\
\ pow: lda 1 \n\
\ lda 0 \n\
\ push 1 \n\
\ .loop: ldl 1 \n\
\ je &.done \n\
\ pop \n\
\ ldl 2 \n\
\ ldl 0 \n\
\ mul \n\
\ stl 2 \n\
\ ldl 1 \n\
\ push 1 \n\
\ sub \n\
\ stl 1 \n\
\ jmp &.loop \n\
\ .done: ldl 2 \n\
\ ret "
let expected = done [3 ^ (6 :: Int)] 8 (-1)
actual <- run input
actual `shouldBe` expected
it "example #4: power - recursive variant" $ do
let input = " push 4 \n\
\ push 7 \n\
\ call &pow \n\
\ clr 2 \n\
\ halt \n\
\ pow: lda 1 \n\
\ lda 0 \n\
\ ldl 1 \n\
\ je &edge \n\
\ pop \n\
\ ldl 0 \n\
\ ldl 1 \n\
\ push 1 \n\
\ sub \n\
\ call &pow \n\
\ clr 1 \n\
\ mul \n\
\ ret \n\
\ edge: pop \n\
\ push 1 \n\
\ ret "
let input = " push 4 \n\
\ push 7 \n\
\ call &pow \n\
\ clr 2 \n\
\ halt \n\
\ pow: lda 1 \n\
\ lda 0 \n\
\ ldl 1 \n\
\ je &.edge \n\
\ pop \n\
\ ldl 0 \n\
\ ldl 1 \n\
\ push 1 \n\
\ sub \n\
\ call &pow \n\
\ clr 1 \n\
\ mul \n\
\ ret \n\
\ .edge: pop \n\
\ push 1 \n\
\ ret "
let expected = done [4 ^ (7 :: Int)] 8 (-1)
actual <- run input
actual `shouldBe` expected
it "example #5: 11-th element of Fibonacci sequence - recursive variant" $ do
let input = " push 11 \n\
\ call &fibb \n\
\ clr 1 \n\
\ halt \n\
\ fibb: lda 0 \n\
\ ldl 0 \n\
\ je &done0 \n\
\ pop \n\
\ ldl 0 \n\
\ push 1 \n\
\ sub \n\
\ je &done1 \n\
\ dup \n\
\ push 1 \n\
\ sub \n\
\ call &fibb \n\
\ clr 1 \n\
\ over \n\
\ call &fibb \n\
\ clr 1 \n\
\ add \n\
\ ret \n\
\ done1: pop \n\
\ push 1 \n\
\ ret \n\
\ done0: pop \n\
\ push 1 \n\
\ ret "
let input = " push 11 \n\
\ call &fibb \n\
\ clr 1 \n\
\ halt \n\
\ fibb: lda 0 \n\
\ ldl 0 \n\
\ je &.done0 \n\
\ pop \n\
\ ldl 0 \n\
\ push 1 \n\
\ sub \n\
\ je &.done1 \n\
\ dup \n\
\ push 1 \n\
\ sub \n\
\ call &fibb \n\
\ clr 1 \n\
\ over \n\
\ call &fibb \n\
\ clr 1 \n\
\ add \n\
\ ret \n\
\ .done1: pop \n\
\ push 1 \n\
\ ret \n\
\ .done0: pop \n\
\ push 1 \n\
\ ret "
let expected = done [fibb 11] 6 (-1)
actual <- run input
actual `shouldBe` expected