From 18ddfa611da7592d47c8a570bd5151c7cba7038c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bart=C5=82omiej=20Przemys=C5=82aw=20Pluta?= Date: Mon, 15 Nov 2021 14:05:18 +0100 Subject: [PATCH] Add support for local labels --- README.md | 126 ++++++++++++------------- app/Assembler/Emitter.hs | 34 +++++-- app/Assembler/Parser.hs | 25 +++-- app/Assembler/Tokenizer.hs | 2 + test/Assembler/EmitterSpec.hs | 146 ++++++++++++++++++++--------- test/Assembler/ParserSpec.hs | 104 +++++++++++---------- test/Assembler/TokenizerSpec.hs | 2 +- test/VirtualMachineSpec.hs | 160 ++++++++++++++++---------------- 8 files changed, 344 insertions(+), 255 deletions(-) diff --git a/README.md b/README.md index cba5437..06eb093 100644 --- a/README.md +++ b/README.md @@ -124,28 +124,28 @@ call &pow clr 2 halt -pow: lda 1 ; base - lda 0 ; exp - push 1 ; acc +pow: lda 1 ; base + lda 0 ; exp + push 1 ; acc - ; | Stack: -loop: ldl 1 ; if exp == 0 | exp - je &done ; then return | exp - pop ; | - ; | - ldl 2 ; Evaluate | acc - ldl 0 ; next power | acc base - mul ; | acc*base - stl 2 ; | - ; | - ldl 1 ; Decrement exp | exp - push 1 ; | exp 1 - sub ; | exp-1 - stl 1 ; | - jmp &loop ; | - -done: ldl 2 ; | ... acc - ret ; | acc + ; | Stack: +.loop: ldl 1 ; if exp == 0 | exp + je &.done ; then return | exp + pop ; | + ; | + ldl 2 ; Evaluate | acc + ldl 0 ; next power | acc base + mul ; | acc*base + stl 2 ; | + ; | + ldl 1 ; Decrement exp | exp + push 1 ; | exp 1 + sub ; | exp-1 + stl 1 ; | + jmp &.loop ; | + +.done: ldl 2 ; | ... acc + ret ; | acc ``` The result of execution: ``` @@ -161,26 +161,26 @@ call &pow clr 2 halt -pow: lda 1 ; base - lda 0 ; exp +pow: lda 1 ; base + lda 0 ; exp - ldl 1 ; push exp to top - je &edge ; the edge case: if exp == 0 then return 1 - pop ; pop exp + ldl 1 ; push exp to top + je &.edge ; the edge case: if exp == 0 then return 1 + pop ; pop exp - ; | Stack: - ldl 0 ; | base - ldl 1 ; | base exp - push 1 ; | base exp 1 - sub ; | base exp-1 - call &pow ; | base exp-1 base^(exp-1)] - clr 1 ; | base base^(exp-1) - mul ; | base*base^(exp-1) - ret ; | base*base^(exp-1) - -edge: pop - push 1 ; return 1 - ret + ; | Stack: + ldl 0 ; | base + ldl 1 ; | base exp + push 1 ; | base exp 1 + sub ; | base exp-1 + call &pow ; | base exp-1 base^(exp-1)] + clr 1 ; | base base^(exp-1) + mul ; | base*base^(exp-1) + ret ; | base*base^(exp-1) + +.edge: pop + push 1 ; return 1 + ret ``` The result of execution: ``` @@ -195,32 +195,32 @@ call &fibb clr 1 halt -fibb: lda 0 ; n | Stack: - ldl 0 ; n == 0 -> return 1 | n - je &done0 ; | n - pop ; | - ldl 0 ; n == 1 -> return 1 | n - push 1 ; | n 1 - sub ; | n-1 - je &done1 ; | n-1 - dup ; Evaluate fibb | n-1 n-1 - push 1 ; | n-1 n-1 1 - sub ; | n-1 n-2 - call &fibb ; | n-1 n-2 f(n-2) - clr 1 ; | n-1 f(n-2) - over ; | n-1 f(n-2) n-1 - call &fibb ; | n-1 f(n-2) n-1 f(n-1) - clr 1 ; | n-1 f(n-2) f(n-1) - add ; | n-1 f(n-2)+f(n-1) - ret +fibb: lda 0 ; n | Stack: + ldl 0 ; n == 0 -> return 1 | n + je &.done0 ; | n + pop ; | + ldl 0 ; n == 1 -> return 1 | n + push 1 ; | n 1 + sub ; | n-1 + je &.done1 ; | n-1 + dup ; Evaluate fibb | n-1 n-1 + push 1 ; | n-1 n-1 1 + sub ; | n-1 n-2 + call &fibb ; | n-1 n-2 f(n-2) + clr 1 ; | n-1 f(n-2) + over ; | n-1 f(n-2) n-1 + call &fibb ; | n-1 f(n-2) n-1 f(n-1) + clr 1 ; | n-1 f(n-2) f(n-1) + add ; | n-1 f(n-2)+f(n-1) + ret -done1: pop - push 1 - ret +.done1: pop + push 1 + ret -done0: pop - push 1 - ret +.done0: pop + push 1 + ret ``` The result of execution: ``` diff --git a/app/Assembler/Emitter.hs b/app/Assembler/Emitter.hs index a55012e..55c6b80 100644 --- a/app/Assembler/Emitter.hs +++ b/app/Assembler/Emitter.hs @@ -2,27 +2,28 @@ module Assembler.Emitter where import Control.Monad (when) import Control.Monad.Trans (lift) -import Control.Monad.State (State, execState, get, put) +import Control.Monad.State (State, evalState, get, put) import Control.Monad.Except (throwError) import Control.Monad.Trans.Except (ExceptT, runExceptT) import Data.Word (Word8) import qualified Data.Map as M -import Assembler.Parser (AST(..)) +import Assembler.Parser (AST(..), Scope(..)) data Bean = Byte Word8 | Reference String deriving (Show, Eq) -data Context = Context { _beans :: [Bean] - , _labels :: M.Map String Int +data Context = Context { _beans :: [Bean] + , _labels :: M.Map String Int + , _currentLabel :: Maybe String } deriving (Show, Eq) type Emitter = AST -> ExceptT String (State Context) () empty :: Context -empty = Context { _beans = [], _labels = M.fromList [] } +empty = Context { _beans = [], _labels = M.fromList [], _currentLabel = Nothing } emitBean :: Bean -> ExceptT String (State Context) () emitBean bean = lift $ do @@ -35,17 +36,34 @@ emitByte byte = emitBean $ Byte $ byte emitParam :: Emitter emitParam (Param (Integer x)) = emitByte $ fromIntegral $ x -emitParam (Param (LabelRef l)) = emitBean $ Reference $ l +emitParam (Param (LabelRef Global l)) = emitBean $ Reference $ l +emitParam (Param (LabelRef Local l)) = do + ctx <- lift get + scope <- case _currentLabel ctx of + (Just s) -> return s + Nothing -> throwError $ "Local label ('." ++ l ++ "') reference is allowed only in the global label scope" + emitBean $ Reference $ (scope ++ "." ++ l) emitParam _ = throwError "Number or label reference expected" emitLabelDef :: Emitter -emitLabelDef (LabelDef label) = do +emitLabelDef (LabelDef Global label) = do ctx <- lift get let labels = _labels ctx let current = length (_beans ctx) when (label `M.member` labels) (throwError $ "Label '" ++ (label) ++ "' is already defined") - put ctx { _labels = M.insert label current labels } + put ctx { _labels = M.insert label current labels, _currentLabel = Just label } return () +emitLabelDef (LabelDef Local label) = do + ctx <- lift get + let labels = _labels ctx + scope <- case _currentLabel ctx of + (Just s) -> return s + Nothing -> throwError $ "Local label ('." ++ label ++ "') can be defined only in the global label scope" + let canonicalLabel = scope ++ "." ++ label + let current = length (_beans ctx) + when (canonicalLabel `M.member` labels) (throwError $ "Label '" ++ (label) ++ "' is already defined in the global label '" ++ scope ++ "' scope") + put ctx { _labels = M.insert canonicalLabel current labels } + return () emitLabelDef _ = throwError "Label definition expected" emitInstr :: Emitter diff --git a/app/Assembler/Parser.hs b/app/Assembler/Parser.hs index b264547..3201ff2 100644 --- a/app/Assembler/Parser.hs +++ b/app/Assembler/Parser.hs @@ -7,6 +7,7 @@ import qualified Assembler.Tokenizer as T (Token(..)) import VirtualMachine.VM (Op) import Util (explode) +data Scope = Local | Global deriving (Eq, Show, Enum, Bounded) data AST = Empty | Operator Op @@ -14,8 +15,9 @@ data AST = Empty | Identifier String | Colon | Ampersand - | LabelDef String - | LabelRef String + | Dot + | LabelDef Scope String + | LabelRef Scope String | Param AST | Params [AST] | Instruction AST AST @@ -53,15 +55,24 @@ parseAmpersand :: Parser parseAmpersand ((T.Ampersand):_) = Just $ ParseResult Ampersand 1 parseAmpersand _ = Nothing --- label_def := ID ':' +-- '.' +parseDot :: Parser +parseDot ((T.Dot):_) = Just $ ParseResult Dot 1 +parseDot _ = Nothing + +-- label_def := '.'? ID ':' parseLabelDef :: Parser -parseLabelDef = parseSeq [parseIdentifier, parseColon] combine - where combine = (\[(Identifier iden), _] -> LabelDef iden) +parseLabelDef = parseSeq [parseOptionally parseDot, parseIdentifier, parseColon] combine + where + combine [Dot, (Identifier iden), _] = LabelDef Local iden + combine [_, (Identifier iden), _] = LabelDef Global iden -- label_ref := '&' ID parseLabelRef :: Parser -parseLabelRef = parseSeq [parseAmpersand, parseIdentifier] combine - where combine = (\[_, (Identifier iden)] -> LabelRef iden) +parseLabelRef = parseSeq [parseAmpersand, parseOptionally parseDot, parseIdentifier] combine + where + combine [_, Dot, (Identifier iden)] = LabelRef Local iden + combine [_, _, (Identifier iden)] = LabelRef Global iden -- param := INT | label_ref parseParam :: Parser diff --git a/app/Assembler/Tokenizer.hs b/app/Assembler/Tokenizer.hs index f071fff..c106bfa 100644 --- a/app/Assembler/Tokenizer.hs +++ b/app/Assembler/Tokenizer.hs @@ -14,6 +14,7 @@ data Token = Operator Op | Identifier String | Colon | Ampersand + | Dot | NewLine | WhiteSpace | Comment String @@ -138,6 +139,7 @@ tokenize input = tokens >>= (\t -> Right $ filter tokenFilter t) , tokenizeIdentifier , keywordTokenizer False ":" Colon , keywordTokenizer False "&" Ampersand + , keywordTokenizer False "." Dot , tokenizeChar , tokenizeString ] diff --git a/test/Assembler/EmitterSpec.hs b/test/Assembler/EmitterSpec.hs index f95697a..efcce6f 100644 --- a/test/Assembler/EmitterSpec.hs +++ b/test/Assembler/EmitterSpec.hs @@ -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" \ No newline at end of file diff --git a/test/Assembler/ParserSpec.hs b/test/Assembler/ParserSpec.hs index 5d42c08..8ad69a4 100644 --- a/test/Assembler/ParserSpec.hs +++ b/test/Assembler/ParserSpec.hs @@ -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) \ No newline at end of file diff --git a/test/Assembler/TokenizerSpec.hs b/test/Assembler/TokenizerSpec.hs index bbddb9d..1b2aa9a 100644 --- a/test/Assembler/TokenizerSpec.hs +++ b/test/Assembler/TokenizerSpec.hs @@ -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'" $ diff --git a/test/VirtualMachineSpec.hs b/test/VirtualMachineSpec.hs index 28629a8..c110f5b 100644 --- a/test/VirtualMachineSpec.hs +++ b/test/VirtualMachineSpec.hs @@ -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 \ No newline at end of file