Fixed if/then/else/while block bug

diff --git a/src/parse.icl b/src/parse.icl
index d04b0f9..e22cba4 100644 (file)
--- a/src/parse.icl
+++ b/src/parse.icl
@@ -39,10 +39,13 @@ parseFunDecl = parseIdent <* satTok BraceOpenToken
 parseStmt :: Parser Token Stmt
 parseStmt = parseIfStmt <|>
        parseWhileStmt <|>
-       (parseAssStmt <* satTok SColonToken) <|>
-       (parseReturnStmt <* satTok SColonToken) <|>
-       (parseFunCall <* satTok SColonToken >>= \fc->pure $ FunStmt fc)
+       parseSColon parseAssStmt <|>
+       parseSColon parseReturnStmt <|>
+       (parseSColon parseFunCall >>= \fc->pure $ FunStmt fc)
        where
+               parseSColon :: (Parser Token a) -> Parser Token a
+               parseSColon p = p <* satTok SColonToken
+
                parseReturnStmt :: Parser Token Stmt
                parseReturnStmt = satTok ReturnToken 
                        *> optional parseExpr >>= \me->pure $ ReturnStmt me
@@ -54,15 +57,20 @@ parseStmt = parseIfStmt <|>
                parseIfStmt :: Parser Token Stmt
                parseIfStmt = satTok IfToken 
                        *> parseBBraces parseExpr
-                       >>= \pred->parseBCBraces (many parseStmt)
+                       >>= \pred->(parseBlock <|> parseOneLine)
                        >>= \thens->optional (
-                               satTok ElseToken *> parseBCBraces (many parseStmt)
+                               satTok ElseToken *> (parseBlock <|> parseOneLine)
                        )>>= \elses->pure $ IfStmt pred thens (fromMaybe [] elses)
 
                parseWhileStmt :: Parser Token Stmt
                parseWhileStmt = satTok WhileToken *> parseBBraces parseExpr
-                       >>= \pred->parseBCBraces (many parseStmt)
-                       >>= \body->pure $ WhileStmt pred body
+                       >>= \pred->parseBlock >>= \body->pure $ WhileStmt pred body
+
+               parseBlock :: Parser Token [Stmt]
+               parseBlock = parseBCBraces (many parseStmt)
+
+               parseOneLine :: Parser Token [Stmt]
+               parseOneLine = parseStmt >>= \s->pure [s]
 
 parseBBraces :: (Parser Token a) -> Parser Token a
 parseBBraces p = satTok BraceOpenToken *> p <* satTok BraceCloseToken
@@ -194,26 +202,31 @@ instance print FunDecl where
        print (FunDecl i as t vs ss) =
                ["\n", i, " (":printersperse "," as] ++
                [") :: ":print t] ++
-               ["{\n\t":printersperse "\n\t" vs] ++
-               ["\n":printStatements ss 1] ++ ["\n}"]
+               ["{":printersperse "\n\t" vs] ++
+               ["\n":printStatements ss 1] ++ ["}"]
 
 printStatements :: [Stmt] Int -> [String]
 printStatements [] i = []
 printStatements [s:ss] i = (case s of
-       (IfStmt b thens elses) = indent i ["if (":print b] ++ ["){\n"] ++
-               printStatements thens (i+1) ++ 
-               indent i ["} else {\n":printStatements elses (i+1)] ++ 
-               indent i ["}\n"]
+       (IfStmt b thens elses) = indent i ["if (":print b] ++ [")"] ++
+               printCodeBlock thens i ++ 
+               indent i ["else ":printCodeBlock elses i] ++ ["\n"]
        (WhileStmt b dos) = indent i ["while (":print b] ++ 
-               ["){\n":printStatements dos (i+1)] ++ indent i ["}\n"]
+               [")":printCodeBlock dos i]
        (AssStmt vardef val) =
                indent i $ print vardef ++ ["=":print val] ++ [";\n"]
        (FunStmt fc) = indent i $ print fc ++ [";\n"]
        (ReturnStmt me) = indent i ["return ":maybe [""] print me] ++ [";\n"]
        ) ++ printStatements ss i
-
-indent :: Int [String] -> [String]
-indent i rest = replicate i "\t" ++ rest
+       where
+               printCodeBlock :: [Stmt] Int -> [String]
+               printCodeBlock [] _ = ["{}"]
+               printCodeBlock [x] i = ["\n":printStatements [x] (i+1)]
+               printCodeBlock x i =
+                       ["{\n":printStatements x (i+1)] ++ indent i ["}"]
+
+               indent :: Int [String] -> [String]
+               indent i rest = replicate i "\t" ++ rest
 
 instance print FunType where
        print (FunType at rt) = printersperse " " at ++