Add support for infinite repeat

Simply making the number of repetitions optional everywhere works, as that is the format used in the compiled script.
adituv · Dec 18, 2016 · 653e890 · 653e890
1 parent 39f3efd
commit 653e890
Show file tree

Hide file tree

Showing 5 changed files with 16 additions and 9 deletions.
diff --git a/src/Compiler/QbScript/AST.hs b/src/Compiler/QbScript/AST.hs
@@ -12,7 +12,7 @@ data QbScript = QbScript (Maybe Struct) [Instruction] deriving (Show, Eq)
 data Instruction = BareExpr Expr
                  | Assign Name Expr
                  | IfElse (Expr, [Instruction]) [(Expr, [Instruction])] [Instruction]     -- ^ IfElse [(Condition, Body)] [ElseBody]
-                 | Repeat Expr [Instruction]                        -- ^ Repeat xExpr [Body]
+                 | Repeat (Maybe Expr) [Instruction]                        -- ^ Repeat xExpr [Body]
                  | Switch Expr [(SmallLit, [Instruction])] [Instruction] -- ^ Switch Expr [(Case, Body)] [DefaultBody]
                  | Break
                  | Return (Maybe (Maybe QbKey, Expr))
@@ -98,13 +98,12 @@ compressNegs (IfElse if' elseifs else') =
   IfElse (negLit *** fmap compressNegs $ if')
          (fmap (negLit *** fmap compressNegs) elseifs)
          (fmap compressNegs else')
-compressNegs (Repeat x body) = Repeat (negLit x) (fmap compressNegs body)
+compressNegs (Repeat (Just x) body) = Repeat (Just $ negLit x) (fmap compressNegs body)
 compressNegs (Switch x cases defaults) = Switch (negLit x)
                                             (fmap (second (fmap compressNegs)) cases)
                                             (fmap compressNegs defaults)
-compressNegs Break = Break
 compressNegs (Return (Just (k, x))) = Return (Just (k, negLit x))
-compressNegs (Return Nothing) = Return Nothing
+compressNegs instr = instr
 
 negLit :: Expr -> Expr
 negLit (Paren x) = Paren (negLit x)

diff --git a/src/Compiler/QbScript/CodeGen.hs b/src/Compiler/QbScript/CodeGen.hs
@@ -63,11 +63,13 @@ putInstr (IfElse if' elseifs else') = do
 
     fillOffsetHole nh
     mapM_ fillOffsetHole lhs
-putInstr (Repeat expr body) = do
+putInstr (Repeat reps body) = do
   putWord16BE 0x0120
   mapM_ putInstr body
   putWord16BE 0x0121
-  putExpr expr
+  case reps of
+    Nothing -> pure ()
+    Just e -> putExpr e
 putInstr (Switch expr cases default') = putSwitch expr cases default'
 putInstr Break = putWord16BE 0x0122
 putInstr (Return Nothing) = putWord16BE 0x0129

diff --git a/src/Compiler/QbScript/Parser.hs b/src/Compiler/QbScript/Parser.hs
@@ -272,7 +272,7 @@ else' =  rword "else" *> newline *> instructions
 
 repeat :: Parser Instruction
 repeat = flip Repeat <$> between (rword "begin" <* newline) (rword "repeat") instructions
-                     <*> parens expr
+                     <*> optional (parens expr)
 
 switch :: Parser Instruction
 switch = Switch <$> (rword "switch" *> expr <* newline)

diff --git a/test/Compiler/QbScript/CodeGen/Tests.hs b/test/Compiler/QbScript/CodeGen/Tests.hs
@@ -48,8 +48,11 @@ instrTests =
                    , 0x01, 0x27, 0x0B, 0x00, 0x0D, 0x00, 0x2C, 0x01, 0x2C
                    , 0x01, 0x48, 0x06, 0x00, 0x01, 0x2C, 0x01, 0x28 ]
     it "generates a repeat correctly" $
-      testPacking (putInstr (Repeat (ELit . SmallLit . LitN $ 4) [BareExpr $ ELit LitPassthrough]))
+      testPacking (putInstr (Repeat (Just . ELit . SmallLit . LitN $ 4) [BareExpr $ ELit LitPassthrough]))
         `shouldBe` [ 0x01, 0x20, 0x01, 0x2C, 0x01, 0x21, 0x17, 0x04, 0x00, 0x00, 0x00 ]
+    it "generates an infinite repeat correctly" $
+      testPacking (putInstr (Repeat Nothing [BareExpr $ ELit LitPassthrough]))
+        `shouldBe` [ 0x01, 0x20, 0x01, 0x2C, 0x01, 0x21 ]
     it "generates a switch/case/default correctly" $
       testPacking (putInstr (Switch (ELit . SmallLit . LitN $ 2)
                                    [(LitN 1, [BareExpr $ ELit LitPassthrough])

diff --git a/test/Compiler/QbScript/Parser/Tests.hs b/test/Compiler/QbScript/Parser/Tests.hs
@@ -137,7 +137,10 @@ instructionTests =
                              [BareExpr $ BareCall (QbName "doNothing") []]
     it "can parse a begin/repeat" $
       parse instruction "" "begin\n  doSomething()\nrepeat (4)" `shouldParse`
-        Repeat (ELit . SmallLit . LitN $ 4) [BareExpr $ BareCall (QbName "doSomething") []]
+        Repeat (Just . ELit . SmallLit . LitN $ 4) [BareExpr $ BareCall (QbName "doSomething") []]
+    it "can parse an infinite begin/repeat" $
+      parse instruction "" "begin\n doSomething()\nrepeat" `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")