Add ELIF statements and refactor IF blocks

1 files changed, 27 insertions, 10 deletions

diff --git a/DSL/Parsing.hs b/DSL/Parsing.hs
index 6dcc4bf..e0017bb 100644
--- a/DSL/Parsing.hs
+++ b/DSL/Parsing.hs
@@ -1,6 +1,7 @@
 module DSL.Parsing where
 
 import Data.Char (isDigit, isSpace)
+import Data.Maybe (fromMaybe)
 
 import DSL.Types
 import DSL.BaseParsers
@@ -28,6 +29,7 @@ commentL = buildDSLLexer go T_COMMENT
 keywordL :: DSLLexer
 keywordL = fromTableL [ ("PROC",  T_PROC)
                       , ("IF",    T_IF)
+                      , ("ELIF",  T_ELIF)
                       , ("ELSE",  T_ELSE)
                       , ("WHILE", T_WHILE)
                       , ("DO",    T_DO)
@@ -144,16 +146,32 @@ linearP = BLinear <$> mult1 operationP
 
 ifP :: DSLParser Block
 ifP = do
-  c <- tagP T_IF *> mult blockP <* tagP T_DO
-  b <- mult blockP <* tagP T_END
-  return $ BIf c b
+  first <- (tagP T_IF *> bp <* tagP T_DO) `plus` bp
+  elifs <- mult $ (tagP T_ELIF *> bp <* tagP T_DO) `plus` bp
+  elze  <- optionalMaybe $ tagP T_ELSE >> bp
+  _     <- tagP T_END
+  return $ go $ first:elifs ++ [elseToPair elze]
+  where
+    bp = mult blockP
+    go []          = BLinear []
+    go ((c, b):xs) = BIf c b $ [go xs]
+    elseToPair Nothing   = ([BLinear [OpPushData $ StackBool True]], [])
+    elseToPair (Just bs) = ([BLinear [OpPushData $ StackBool True]], bs)
+
+--ifP = do
+--  c <- tagP T_IF *> mult blockP <* tagP T_DO
+--  b <- mult blockP <* tagP T_END
+--  return $ BIf c b
+
+{-
+exactly 1: IF   [blocks] DO [blocks]
+0 or many: ELIF [blocks] DO [blocks]
+0 or 1:    ELSE [blocks]
+exactly 1: END
+
+IF c1 DO b1 ELIF c2 DO b2 ELIF c3 DO b3 ELSE b4
+-}
 
-ifElseP :: DSLParser Block
-ifElseP = do
-  c <- tagP T_IF *> mult blockP <* tagP T_DO
-  b1 <- mult blockP <* tagP T_ELSE
-  b2 <- mult blockP <* tagP T_END
-  return $ BIfElse c b1 b2
 
 whileP :: DSLParser Block
 whileP = do
@@ -169,7 +187,6 @@ procP = front `plus` back
 
 blockP :: DSLParser Block
 blockP = firstOf [ whileP
-                 , ifElseP
                  , ifP
                  , linearP
                  ]