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.

Author: adituv

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

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<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`
@@ -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]]) [] []]