From 653e8905ba72e61f79ff4fdb58ac4be788652e74 Mon Sep 17 00:00:00 2001 From: Iris Ward Date: Sun, 18 Dec 2016 01:35:07 +0000 Subject: [PATCH] Add support for infinite repeat Simply making the number of repetitions optional everywhere works, as that is the format used in the compiled script. --- src/Compiler/QbScript/AST.hs | 7 +++---- src/Compiler/QbScript/CodeGen.hs | 6 ++++-- src/Compiler/QbScript/Parser.hs | 2 +- test/Compiler/QbScript/CodeGen/Tests.hs | 5 ++++- test/Compiler/QbScript/Parser/Tests.hs | 5 ++++- 5 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/Compiler/QbScript/AST.hs b/src/Compiler/QbScript/AST.hs index 8ca6b3c..34c48f7 100644 --- 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 index 16514af..fce19f4 100644 --- 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 index b9bcf05..36178e0 100644 --- 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 index e574d6c..6befba2 100644 --- 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 index d21f534..d3975b3 100644 --- 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")