Skip to content

Commit

Permalink
Change syntax to C-style braces
Browse files Browse the repository at this point in the history 
Lines are no longer newline-sensitive; they are terminated with
semicolon.  Blocks now are within braces rather than having an end
keyword terminator.
  • Loading branch information
@adituv
adituv committed Dec 20, 2016
1 parent 653e890 commit f94c4c0
Show file tree
Hide file tree
Showing 2 changed files with 73 additions and 82 deletions.
91 changes: 40 additions & 51 deletions src/Compiler/QbScript/Parser.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,27 +25,18 @@ ident = alpha ++ ['0'..'9'] ++ "_"
identChar :: Parser Char
identChar = oneOf ident

spaceChar' :: Parser ()
spaceChar' = void (char ' ' <|> char '\t')

opChar :: Parser Char
opChar = oneOf ".:+-*/=<>&|^"

spaceConsumer :: Parser ()
spaceConsumer = L.space spaceChar'
spaceConsumer = L.space (() <$ spaceChar)
(L.skipLineComment "//")
(L.skipBlockComment "/*" "*/")

blockKeywords :: [String]
blockKeywords = [ "if", "else", "elseif", "endif", "begin", "repeat", "script", "endscript"
, "switch", "case", "default", "endswitch" ]

blockKeyword :: Parser String
blockKeyword = choice $ fmap (try . symbol) blockKeywords

reservedWords :: [String]
reservedWords = blockKeywords ++ [ "break", "random", "random2"
, "randomrange", "randomrange2", "randompermute", "randomshuffle", "not"
reservedWords = [ "if", "else", "elseif", "repeat", "script", "switch", "case"
, "default", "break", "random", "random2", "randomrange"
, "randomrange2", "randompermute", "randomshuffle", "not"
, "useheap" ]

lexeme :: Parser a -> Parser a
Expand Down Expand Up @@ -129,9 +120,8 @@ passthrough = void (symbol "<...>")
-- * Parser

qbScript :: Parser QbScript
qbScript = QbScript <$> (rword "script" *> parens (optional struct) <* newline)
<*> many instruction
<* rword "endscript"
qbScript = QbScript <$> (rword "script" *> parens (optional struct))
<*> braces (many instruction)

-- * Literals

Expand Down Expand Up @@ -165,12 +155,10 @@ qbKey = QbCrc <$> checksum
<|> QbName <$> identifier

dict :: Parser Dict
dict = braces $ optional newline *>
(Dict <$> dict')
dict = Dict <$> braces dict'
where
dict' :: Parser [(Maybe QbKey, Expr)]
dict' = entry `sepBy` (comma <* optional newline)
<* optional newline
dict' = entry `sepBy` comma

entry :: Parser (Maybe QbKey, Expr)
entry = do
Expand All @@ -179,15 +167,12 @@ dict = braces $ optional newline *>
return (k,v)

array :: Parser Array
array = Array <$> brackets (optional newline *> expr `sepBy` (comma <* optional newline)
<* optional newline)
array = Array <$> brackets (expr `sepBy` comma)

-- ** Structs

struct :: Parser Struct
struct = Struct <$> braces (optional newline
*> structItem `sepBy` try (semicolon <* optional newline <* notFollowedBy (symbol "}"))
<* semicolon <* optional newline)
struct = Struct <$> braces (structItem `endBy` semicolon)

structItem :: Parser StructItem
structItem = do
Expand Down Expand Up @@ -231,66 +216,70 @@ qbValue QbTStringQs = QbStringQs <$> qbKey


qbArray :: QbType -> Parser QbArray
qbArray t = brackets $ QbArr t <$> qbValue t `sepBy` (comma <* optional newline)
qbArray t = brackets $ QbArr t <$> qbValue t `sepBy` comma

-- * Instructions

lineTerm :: Parser ()
lineTerm = newline <|> eof

instructions :: Parser [Instruction]
instructions = many instruction

instruction :: Parser Instruction
instruction = choice (fmap try
[ Assign <$> name <*> (equals *> expr)
[ Assign <$> name <*> (equals *> expr) <* semicolon
, ifelse
, repeat
, switch
, Break <$ rword "break"
, Return <$> (rword "return" *> optional (parens argument <|> argument))
, BareExpr <$> expr
]) <* lineTerm
, Break <$ rword "break" <* semicolon
, Return <$> (rword "return" *> optional (parens argument <|> argument)) <* semicolon
, BareExpr <$> expr <* semicolon
])

ifelse :: Parser Instruction
ifelse = IfElse <$> if'
<*> many elseif
<*> else'
<* rword "endif"

if' :: Parser (Expr, [Instruction])
if' = (,) <$> (rword "if" *> expr <* newline)
<*> instructions
if' = (,) <$> (rword "if" *> parenExpr)
<*> braces instructions

elseif :: Parser (Expr, [Instruction])
elseif = (,) <$> (rword "elseif" *> expr <* newline)
<*> instructions
elseif = (,) <$> (rword "elseif" *> parenExpr)
<*> braces instructions

else' :: Parser [Instruction]
else' = rword "else" *> newline *> instructions
else' = (rword "else" *> braces instructions)
<|> pure []

repeat :: Parser Instruction
repeat = flip Repeat <$> between (rword "begin" <* newline) (rword "repeat") instructions
<*> optional (parens expr)
repeat = Repeat <$> (rword "repeat" *> optional parenExpr)
<*> braces instructions

switch :: Parser Instruction
switch = Switch <$> (rword "switch" *> expr <* newline)
<*> many case'
<*> (rword "default:" *> newline *> instructions <|> pure [])
<* rword "endswitch"

case' :: Parser (SmallLit, [Instruction])
case' = (,) <$> (rword "case" *> (smallLit <* colon <* newline))
<*> instructions
switch = do
rword "switch"
sw <- parenExpr
(c, d) <- braces $ do
c' <- many case'
d' <- def
pure (c', d')
pure $ Switch sw c d
where
case' = (,) <$> (rword "case" *> smallLit <* colon)
<*> instructions
def = (rword "default" *> colon *> instructions)
<|> pure []

-- * Expressions
expr :: Parser Expr
expr = makeExprParser term opTable

parenExpr :: Parser Expr
parenExpr = Paren <$> parens expr

term :: Parser Expr
term = choice (fmap try
[ Paren <$> parens expr
[ parenExpr
, MethodCall <$> (name <* colon) <*> qbKey <*> parens (try argument `sepBy` comma)
, BareCall <$> qbKey <*> parens (try argument `sepBy` comma)
, ELit <$> lit
Expand Down
64 changes: 33 additions & 31 deletions test/Compiler/QbScript/Parser/Tests.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -112,57 +112,57 @@ instructionTests =
describe "instruction" $ do
it "can parse an assignment by name" $ property $
\(Ident xs) -> fmap toLower xs `notElem` reservedWords
==> parse instruction "" (fromString $ xs ++ " = 1.0") `shouldParse`
==> parse instruction "" (fromString $ xs ++ " = 1.0;") `shouldParse`
Assign (NonLocal $ QbName xs) (ELit (LitF 1))
it "can parse an assignment by checksum" $ property $
\c@(Checksum x) -> parse instruction "" (fromString $ "%$" ++ show c ++ " = 1.0") `shouldParse`
\c@(Checksum x) -> parse instruction "" (fromString $ "%$" ++ show c ++ " = 1.0;") `shouldParse`
Assign (Local $ QbCrc x) (ELit (LitF 1))
it "can parse an if with no else branches" $
parse instruction "" "if 1.0\n doSomething()\nendif" `shouldParse`
IfElse (ELit (LitF 1), [BareExpr $ BareCall (QbName "doSomething") []]) [] []
parse instruction "" "if (1.0) {\n doSomething();\n}" `shouldParse`
IfElse (Paren (ELit (LitF 1)), [BareExpr $ BareCall (QbName "doSomething") []]) [] []
it "can parse an if/elseif" $
parse instruction "" "if 1.0\n doSomething()\nelseif 2.0\n doNothing()\nendif"
`shouldParse` IfElse (ELit (LitF 1), [BareExpr $ BareCall (QbName "doSomething") []])
[(ELit (LitF 2), [BareExpr $ BareCall (QbName "doNothing") []])]
parse instruction "" "if (1.0) {\n doSomething();\n} elseif (2.0) {\n doNothing();\n}"
`shouldParse` IfElse (Paren (ELit (LitF 1)), [BareExpr $ BareCall (QbName "doSomething") []])
[(Paren (ELit (LitF 2)), [BareExpr $ BareCall (QbName "doNothing") []])]
[]
it "can parse an if/else" $
parse instruction "" "if 1.0\n doSomething()\nelse\n doNothing()\nendif"
`shouldParse` IfElse (ELit (LitF 1), [BareExpr $ BareCall (QbName "doSomething") []])
parse instruction "" "if (1.0) {\n doSomething();\n} else {\n doNothing();\n}"
`shouldParse` IfElse (Paren (ELit (LitF 1)), [BareExpr $ BareCall (QbName "doSomething") []])
[]
[BareExpr $ BareCall (QbName "doNothing") []]
it "can parse an if/elseif/else" $
parse instruction "" "if 1.0\n doSomething()\nelseif 2.0\n doNothing()\nelse\n doNothing()\nendif"
`shouldParse` IfElse (ELit (LitF 1), [BareExpr $ BareCall (QbName "doSomething") []])
[(ELit (LitF 2), [BareExpr $ BareCall (QbName "doNothing") []])]
parse instruction "" "if (1.0) {\n doSomething();\n} elseif (2.0) {\n doNothing();\n} else{ \n doNothing();\n}"
`shouldParse` IfElse (Paren (ELit (LitF 1)), [BareExpr $ BareCall (QbName "doSomething") []])
[(Paren (ELit (LitF 2)), [BareExpr $ BareCall (QbName "doNothing") []])]
[BareExpr $ BareCall (QbName "doNothing") []]
it "can parse a begin/repeat" $
parse instruction "" "begin\n doSomething()\nrepeat (4)" `shouldParse`
Repeat (Just . ELit . SmallLit . LitN $ 4) [BareExpr $ BareCall (QbName "doSomething") []]
parse instruction "" "repeat (4) {\n doSomething();\n}" `shouldParse`
Repeat (Just . Paren . ELit . SmallLit . LitN $ 4) [BareExpr $ BareCall (QbName "doSomething") []]
it "can parse an infinite begin/repeat" $
parse instruction "" "begin\n doSomething()\nrepeat" `shouldParse`
parse instruction "" "repeat {\n doSomething();\n}" `shouldParse`
Repeat Nothing [BareExpr $ BareCall (QbName "doSomething") []]
it "can parse a switch without default" $
parse instruction "" "switch %i\ncase 1:\n doSomething()\n break\nendswitch" `shouldParse`
Switch (ELit . SmallLit . LitKey . Local . QbName $ "i")
parse instruction "" "switch (%i) {\ncase 1:\n doSomething();\n break;\n}" `shouldParse`
Switch (Paren . ELit . SmallLit . LitKey . Local . QbName $ "i")
[(LitN 1, [BareExpr $ BareCall (QbName "doSomething") [], Break] )]
[]
it "can parse a switch with default" $
parse instruction "" "switch %i\ncase 1:\n doSomething()\n break\ndefault:\n doNothing()\nendswitch" `shouldParse`
Switch (ELit . SmallLit . LitKey . Local . QbName $ "i")
parse instruction "" "switch (%i) {\ncase 1:\n doSomething();\n break;\ndefault:\n doNothing();\n}" `shouldParse`
Switch (Paren . ELit . SmallLit . LitKey . Local . QbName $ "i")
[(LitN 1, [BareExpr $ BareCall (QbName "doSomething") [], Break] )]
[BareExpr $ BareCall (QbName "doNothing") []]
it "can parse a break" $
parse instruction "" "break" `shouldParse` Break
parse instruction "" "break;" `shouldParse` Break
it "can parse a no-value return" $
parse instruction "" "return" `shouldParse` Return Nothing
parse instruction "" "return;" `shouldParse` Return Nothing
it "can parse a non-keyword return" $
parse instruction "" "return 3" `shouldParse` Return (Just (Nothing, ELit (SmallLit (LitN 3))))
parse instruction "" "return 3;" `shouldParse` Return (Just (Nothing, ELit (SmallLit (LitN 3))))
it "can parse a keyword return" $
parse instruction "" "return (x=2.0)" `shouldParse` Return (Just (Just $ QbName "x", ELit (LitF 2)))
parse instruction "" "return (x=2.0);" `shouldParse` Return (Just (Just $ QbName "x", ELit (LitF 2)))
it "can parse a keyword return by crc" $
parse instruction "" "return ($1234abcd=2.0)" `shouldParse` Return (Just (Just $ QbCrc 0x1234abcd, ELit (LitF 2)))
parse instruction "" "return ($1234abcd=2.0);" `shouldParse` Return (Just (Just $ QbCrc 0x1234abcd, ELit (LitF 2)))
it "can parse a bare call expression" $
parse instruction "" "doSomething()"
parse instruction "" "doSomething();"
`shouldParse` BareExpr (BareCall (QbName "doSomething") [])

termTests :: Spec
Expand Down Expand Up @@ -244,15 +244,15 @@ structTests :: Spec
structTests =
describe "struct" $ do
it "should parse a 1-item struct" $ do
parse struct "" "{\n\tqbkey x = $00000000;\n}" `shouldParse`
parse struct "" "{qbkey x = $00000000;}" `shouldParse`
Struct [StructItem QbTKey (QbName "x") (QbKey $ QbCrc 0)]
parse struct "" "{\n\tqbkeyref x = $00000000;\n}" `shouldParse`
parse struct "" "{qbkeyref x = $00000000;}" `shouldParse`
Struct [StructItem QbTKeyRef (QbName "x") (QbKeyRef $ QbCrc 0)]
it "can parse arrays of all types" $ do
parse struct "" "{\n\tarray<int> _ = [1,2,3];\n}" `shouldParse`
parse struct "" "{array<int> _ = [1,2,3];}" `shouldParse`
Struct [StructItem (QbTArray QbTInteger) (QbCrc 0) (QbArray . QbArr QbTInteger
$ [QbInteger 1, QbInteger 2, QbInteger 3])]
parse struct "" "{\n\tarray<float> _ = [1.0, 2.0, 3.0];\n}" `shouldParse`
parse struct "" "{array<float> _ = [1.0, 2.0, 3.0];}" `shouldParse`
Struct [StructItem (QbTArray QbTFloat) (QbCrc 0) (QbArray . QbArr QbTFloat
$ [QbFloat 1, QbFloat 2, QbFloat 3])]
parse struct "" "{\n\tarray<string> _ = ['a', 'b'];\n}" `shouldParse`
Expand Down Expand Up @@ -283,6 +283,8 @@ qbScriptTests :: Spec
qbScriptTests =
describe "qbScript" $ do
it "should parse an empty script" $
parse qbScript "" "script()\nendscript" `shouldParse` QbScript Nothing []
parse qbScript "" "script () {\n}" `shouldParse` QbScript Nothing []
-- TODO: sample scripts
return ()
it "should parse repeat inside if" $
parse qbScript "" "script() { if(<...>) { repeat { break; }}}" `shouldParse`
QbScript Nothing [IfElse (Paren . ELit $ LitPassthrough, [Repeat Nothing [Break]]) [] []]

0 comments on commit f94c4c0

Please sign in to comment.