diff options
Diffstat (limited to 'DSL/Parsing.hs')
| -rw-r--r-- | DSL/Parsing.hs | 37 |
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 ] |