X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=src%2Fparse.icl;h=fc6e740b946a818a46a582ce3ce4197727ffefb3;hb=cdb033817c0b30f0ff27b0f4aa67b7cf93c36b4d;hp=b3046e0ff3e7b13a7265a4f99e774cdb696cdc20;hpb=798defc398c2e3df810cc8fd3dccf861103006a5;p=cc1516.git diff --git a/src/parse.icl b/src/parse.icl index b3046e0..fc6e740 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -12,6 +12,7 @@ import Control.Applicative import Data.Func from Data.List import intercalate, replicate, instance Functor [] from Text import class Text(concat), instance Text String +import GenPrint import yard import lex @@ -23,13 +24,14 @@ parser (Right r) = case runParser parseProgram r of (Left e, _) = Left $ toString e parseProgram :: Parser Token AST -parseProgram = liftM2 AST (many parseVarDecl) (some parseFunDecl) +parseProgram = liftM2 AST (many parseVarDecl) (some parseFunDecl) + <* satTok EndOfFileToken parseFunDecl :: Parser Token FunDecl parseFunDecl = liftM5 FunDecl (parseIdent <* satTok BraceOpenToken) (parseSepList CommaToken parseIdent <* satTok BraceCloseToken) - (parseFunType <* satTok CBraceOpenToken) + (optional parseFunType <* satTok CBraceOpenToken) (many parseVarDecl) (many parseStmt <* satTok CBraceCloseToken) @@ -68,7 +70,7 @@ parseStmt = parseIfStmt <|> parseWhileStmt <|> parseOneLine = liftM pure parseStmt parseFunType :: Parser Token FunType -parseFunType = satTok DoubleColonToken *> +parseFunType = satTok DoubleColonToken *> (parseInOutType <|> (liftM (FunType []) parseVoidOrType)) where parseInOutType :: Parser Token FunType @@ -77,7 +79,7 @@ parseFunType = satTok DoubleColonToken *> parseVoidOrType :: Parser Token (Maybe Type) parseVoidOrType = (satTok VoidToken *> pure Nothing) <|> - (liftM Just parseType) + (liftM Just parseType) <|> pure Nothing parseVarDecl :: Parser Token VarDecl parseVarDecl = liftM3 VarDecl @@ -171,9 +173,10 @@ trans2 t f = satTok t >>= \(_, r).pure (f r) trans1 :: TokenValue a -> Parser Token a trans1 t r = trans2 t $ const r +derive gPrint TokenValue derive gEq TokenValue satTok :: TokenValue -> Parser Token Token -satTok t = satisfy $ eq t +satTok t = top >>= \tok=:(pos, tv) -> if (eq t tok) (return tok) (fail (printToString tv, pos)) where eq (IdentToken _) (_, IdentToken _) = True eq (NumberToken _) (_, NumberToken _) = True @@ -182,7 +185,7 @@ satTok t = satisfy $ eq t parseSepList :: TokenValue (Parser Token a) -> Parser Token [a] parseSepList sep p = - (some (p <* satTok sep) >>= \es->p >>= \e.pure $ reverse [e:es]) <|> + (liftM2 (\es->(\e->reverse [e:es])) (some (p <* satTok sep)) p) <|> (liftM pure p) <|> pure empty parseIdent :: Parser Token String @@ -201,9 +204,9 @@ printersperse i j = intercalate [i] (map print j) instance print FunDecl where print (FunDecl i as t vs ss) = ["\n", i, " (":printersperse "," as] ++ - [") :: ":print t] ++ - ["{":printersperse "\n\t" vs] ++ - ["\n":printStatements ss 1] ++ ["}"] + [")"] ++ maybe [] (\tt->[" :: ":print tt]) t ++ + ["{\n\t":printersperse "\n\t" vs] ++ + ["\n":printStatements ss 1] ++ ["}\n"] printStatements :: [Stmt] Int -> [String] printStatements [] i = [] @@ -220,7 +223,7 @@ printStatements [s:ss] i = (case s of ) ++ printStatements ss i where printCodeBlock :: [Stmt] Int -> [String] - printCodeBlock [] _ = ["{}"] + printCodeBlock [] _ = ["{}\n"] printCodeBlock [x] i = ["\n":printStatements [x] (i+1)] printCodeBlock x i = ["{\n":printStatements x (i+1)] ++ indent i ["}\n"]