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

Add support for local labels

Browse Source
This commit is contained in:
Bartłomiej Przemysław Pluta
2021-11-15 14:05:18 +01:00
parent 5ad4114405
commit 18ddfa611d
8 changed files with 344 additions and 255 deletions
Download Patch File Download Diff File Expand all files Collapse all files

126
README.md
View File

@@ -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:
```

34
app/Assembler/Emitter.hs
View File

@@ -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

25
app/Assembler/Parser.hs
View File

@@ -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

2
app/Assembler/Tokenizer.hs
View File

@@ -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
]

146
test/Assembler/EmitterSpec.hs
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"

104
test/Assembler/ParserSpec.hs
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)

2
test/Assembler/TokenizerSpec.hs
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'" $

160
test/VirtualMachineSpec.hs
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