From f94c4c0b95dca03461a0fc1d5affe960c33feecc Mon Sep 17 00:00:00 2001 From: Iris Ward Date: Tue, 20 Dec 2016 21:01:13 +0000 Subject: [PATCH] Change syntax to C-style braces Lines are no longer newline-sensitive; they are terminated with semicolon. Blocks now are within braces rather than having an end keyword terminator. --- src/Compiler/QbScript/Parser.hs | 91 +++++++++++--------------- test/Compiler/QbScript/Parser/Tests.hs | 64 +++++++++--------- 2 files changed, 73 insertions(+), 82 deletions(-) diff --git a/src/Compiler/QbScript/Parser.hs b/src/Compiler/QbScript/Parser.hs index 36178e0..08b53b1 100644 --- a/src/Compiler/QbScript/Parser.hs +++ b/src/Compiler/QbScript/Parser.hs @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/test/Compiler/QbScript/Parser/Tests.hs b/test/Compiler/QbScript/Parser/Tests.hs index d3975b3..8c0674f 100644 --- a/test/Compiler/QbScript/Parser/Tests.hs +++ b/test/Compiler/QbScript/Parser/Tests.hs @@ -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 @@ -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 _ = [1,2,3];\n}" `shouldParse` + parse struct "" "{array _ = [1,2,3];}" `shouldParse` Struct [StructItem (QbTArray QbTInteger) (QbCrc 0) (QbArray . QbArr QbTInteger $ [QbInteger 1, QbInteger 2, QbInteger 3])] - parse struct "" "{\n\tarray _ = [1.0, 2.0, 3.0];\n}" `shouldParse` + parse struct "" "{array _ = [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 _ = ['a', 'b'];\n}" `shouldParse` @@ -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]]) [] []]