From: Mart Lubbers Date: Sun, 28 Feb 2016 20:10:37 +0000 (+0100) Subject: alles werkt, alleen if/else/while nog met 1 line en dus geen {} X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=3faf0ef4123af219f9f10560b5fe1aa041a37c4a;p=cc1516.git alles werkt, alleen if/else/while nog met 1 line en dus geen {} --- diff --git a/src/exVarDecl.spl b/src/exVarDecl.spl index 4879075..8873515 100644 --- a/src/exVarDecl.spl +++ b/src/exVarDecl.spl @@ -13,6 +13,7 @@ var v5 = 1 * 2 - 3 * 4; var v6 = 1 * (2 - 3) * 4; var v7 = 1 * 2 % 3 * 4; var v8 = a * 4; +var v9 = a.tl.fst * 4; var v9 = a.tl * 4; var w0 = a.fst * 4; var w1 = a.snd * 4; @@ -21,5 +22,46 @@ var w3 = [] + 5; var w4 = func(); var w5 = func(1); var w5 = func(1, [], 1+2); +a a = 4; var w6 = ([] + 5, func(1)); ([a], [(b, (c, [[[(d, e)]]]))]) t = f(1+2-3*4%5/6+(6+(6+1)), g(h(a.fst), [])); +t() :: Void {} +t(a) :: Void {} +t(a, b, c) :: Void {} +t() :: Int { + var v1 = True; + ([a], [(b, (c, [[[(d, e)]]]))]) t = f(1+2-3*4%5/6+(6+(6+1)), g(h(a.fst), [])); + + if(True){ + } + if(True){ + abc(); + abc(1); + abc(1, 1, 1); + } else { + if((x*x)+(y+y)){ + } else { + abcd(); + } + } + + while(True){} + while(True){ + if(True){ + abc(); + abc(1); + abc(1, 1, 1); + } else { + if((x*x)+(y+y)){ + } else { + abcd(); + } + } + } + + abc(); + abc(1); + abc(1, 1, 1); + return (1, 2); + return; +} diff --git a/src/grammar.txt b/src/grammar.txt index ab2e4db..3eb7146 100644 --- a/src/grammar.txt +++ b/src/grammar.txt @@ -1,27 +1,38 @@ + ::= '(' * ')' ['::' * + '}' + ::= + '->' + | + ::= 'if' '(' ')' '{' * '}' ['else' '{' * '}'] + | 'while' '(' ')' '{' * '}' + | '=' ';' + | ';' + | 'return' [] ';' + + ::= ( | 'var') '=' ';' ::= [':' ] ::= ['||' ] ::= ['&&' ] ::= [('==' | '<' | '>' | '<=' | '>=' | '!=') ] ::= (('+' | '-') )* ::= ('*' | '/' | '%'] )* - ::= ['hd'|'tl'|'fst'|'snd] + ::= | | | | 'False' | 'True' | '(' ')' - | '(' [] ')' + | | '[]' | '(' ',' ')' + ::= ('.' ('hd'|'tl'|'fst'|'snd))* + ::= '(' [] ')' ::= [',' ActArgs] - ::= ( | 'var') '=' ';' - ::= 'Int' | 'Bool' | 'Char' | '(' Type ',' Type ')' | '[' Type ']' | + ::= 'Void' | Type diff --git a/src/parse.dcl b/src/parse.dcl index 8a368ba..baef545 100644 --- a/src/parse.dcl +++ b/src/parse.dcl @@ -17,28 +17,30 @@ import lex | BoolType | CharType | VarType - :: Expr - = VarExpr String (Maybe FieldSelector) + = VarExpr VarDef | Op2Expr Expr Op2 Expr | Op1Expr Op1 Expr | IntExpr Int | CharExpr Char | BoolExpr Bool - | FunExpr String [Expr] + | FunExpr FunCall | EmptyListExpr | TupleExpr Expr Expr - +:: VarDef = VarDef String [FieldSelector] :: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd :: Op1 = UnNegation | UnMinus :: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser | BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons - -//TODO - :: FunDecl = FunDecl String [String] FunType [VarDecl] [Stmt] -:: FunType = Stub -:: Stmt = Stubbel +:: FunType = FunType [Type] (Maybe Type) +:: FunCall = FunCall String [Expr] +:: Stmt + = IfStmt Expr [Stmt] [Stmt] + | WhileStmt Expr [Stmt] + | AssStmt VarDef Expr + | FunStmt FunCall + | ReturnStmt (Maybe Expr) instance toString AST diff --git a/src/parse.icl b/src/parse.icl index aca2489..d04b0f9 100644 --- a/src/parse.icl +++ b/src/parse.icl @@ -10,6 +10,7 @@ import Data.Maybe import Control.Monad import Control.Applicative import Data.Func +from Data.List import intercalate, replicate from Text import class Text(concat), instance Text String import yard @@ -22,11 +23,65 @@ parser (Right r) = case runParser parseProgram r of (Left e, _) = Left $ toString e parseProgram :: Parser Token AST -parseProgram = some parseVarDecl - >>= \vd->pure $ AST vd [] +parseProgram = many parseVarDecl + >>= \vd->some parseFunDecl + >>= \fd->pure $ AST vd fd parseFunDecl :: Parser Token FunDecl -parseFunDecl = empty +parseFunDecl = parseIdent <* satTok BraceOpenToken + >>= \ident->parseSepList CommaToken parseIdent <* satTok BraceCloseToken + >>= \args->parseFunType <* satTok CBraceOpenToken + >>= \funtype->many parseVarDecl + >>= \vardecls->many parseStmt + <* satTok CBraceCloseToken + >>= \stmts->pure $ FunDecl ident args funtype vardecls stmts + +parseStmt :: Parser Token Stmt +parseStmt = parseIfStmt <|> + parseWhileStmt <|> + (parseAssStmt <* satTok SColonToken) <|> + (parseReturnStmt <* satTok SColonToken) <|> + (parseFunCall <* satTok SColonToken >>= \fc->pure $ FunStmt fc) + where + parseReturnStmt :: Parser Token Stmt + parseReturnStmt = satTok ReturnToken + *> optional parseExpr >>= \me->pure $ ReturnStmt me + + parseAssStmt :: Parser Token Stmt + parseAssStmt = parseVarDef <* satTok AssignmentToken + >>= \var-> parseExpr >>= \expr->pure $ AssStmt var expr + + parseIfStmt :: Parser Token Stmt + parseIfStmt = satTok IfToken + *> parseBBraces parseExpr + >>= \pred->parseBCBraces (many parseStmt) + >>= \thens->optional ( + satTok ElseToken *> parseBCBraces (many parseStmt) + )>>= \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 + +parseBBraces :: (Parser Token a) -> Parser Token a +parseBBraces p = satTok BraceOpenToken *> p <* satTok BraceCloseToken + +parseBCBraces :: (Parser Token a) -> Parser Token a +parseBCBraces p = satTok CBraceOpenToken *> p <* satTok CBraceCloseToken + +parseFunType :: Parser Token FunType +parseFunType = satTok DoubleColonToken *> + (parseInOutType <|> (parseVoidOrType >>= \t->pure $ FunType [] t)) + where + parseInOutType :: Parser Token FunType + parseInOutType = some parseType <* satTok ArrowToken + >>= \intypes-> parseVoidOrType + >>= \outtypes->pure $ FunType intypes outtypes + + parseVoidOrType :: Parser Token (Maybe Type) + parseVoidOrType = (satTok VoidToken *> pure Nothing) <|> + (parseType >>= \type->pure $ Just type) parseVarDecl :: Parser Token VarDecl parseVarDecl = @@ -50,29 +105,28 @@ parseType = parseExpr :: Parser Token Expr parseExpr = //Operators in order of binding strength - parseOpRight (trans1 ColonToken BiCons) $ - parseOpRight (trans1 PipesToken BiOr) $ - parseOpRight (trans1 AmpersandsToken BiAnd) $ - parseOpRight (trans1 EqualsToken BiEquals <|> + parseOpR (trans1 ColonToken BiCons) $ + parseOpR (trans1 PipesToken BiOr) $ + parseOpR (trans1 AmpersandsToken BiAnd) $ + parseOpR (trans1 EqualsToken BiEquals <|> trans1 LesserToken BiLesser <|> trans1 BiggerToken BiGreater <|> trans1 LesserEqToken BiLesserEq <|> trans1 GreaterEqToken BiGreaterEq <|> trans1 NotEqualToken BiUnEqual) $ - parseOpLeft (trans1 PlusToken BiPlus <|> + parseOpL (trans1 PlusToken BiPlus <|> trans1 DashToken BiMinus) $ - parseOpLeft (trans1 StarToken BiTimes <|> + parseOpL (trans1 StarToken BiTimes <|> trans1 SlashToken BiDivide <|> - trans1 PercentToken BiMod) $ - parseBasicExpr + trans1 PercentToken BiMod) $ parseBasicExpr where - parseOpRight :: (Parser Token Op2) (Parser Token Expr) -> Parser Token Expr - parseOpRight ops prev = prev >>= \e1->optional ( - ops >>= \op->parseOpRight ops prev >>= \e->pure (op, e) + parseOpR :: (Parser Token Op2) (Parser Token Expr) -> Parser Token Expr + parseOpR ops prev = prev >>= \e1->optional ( + ops >>= \op->parseOpR ops prev >>= \e->pure (op, e) ) >>= \moe->pure $ maybe e1 (\(op,e2)->Op2Expr e1 op e2) moe - parseOpLeft :: (Parser Token Op2) (Parser Token Expr) -> Parser Token Expr - parseOpLeft ops prev = prev >>= \e1->many ( + parseOpL :: (Parser Token Op2) (Parser Token Expr) -> Parser Token Expr + parseOpL ops prev = prev >>= \e1->many ( ops >>= \op->prev >>= \e->pure (op, e) ) >>= \moe->foldM (\e->(\(op,e2)->pure $ Op2Expr e op e2)) e1 moe @@ -81,29 +135,34 @@ parseExpr = //Operators in order of binding strength (satTok BraceOpenToken *> parseExpr <* satTok CommaToken >>= \e1->parseExpr <* satTok BraceCloseToken >>= \e2->pure $ TupleExpr e1 e2) <|> - (parseIdent <* satTok BraceOpenToken - >>= \i->parseSepList CommaToken parseExpr <* satTok BraceCloseToken - >>= \es->pure $ FunExpr i es) <|> - (satTok BraceOpenToken *> parseExpr <* satTok BraceCloseToken) <|> + (parseFunCall >>= \fc->pure $ FunExpr fc) <|> + parseBBraces parseExpr <|> trans1 EmptyListToken EmptyListExpr <|> trans2 TrueToken (const $ BoolExpr True) <|> trans2 FalseToken (const $ BoolExpr False) <|> trans2 (NumberToken zero) (\(NumberToken i)->IntExpr i) <|> trans2 (CharToken zero) (\(CharToken c)->CharExpr c) <|> (parseOp1 >>= \o->parseExpr >>= \e.pure $ Op1Expr o e) <|> - (parseIdent >>= \i->parseFieldSelector >>= \f.pure $ VarExpr i f) + (parseVarDef >>= \ve->pure $ VarExpr ve) + +parseFunCall :: Parser Token FunCall +parseFunCall = parseIdent <* satTok BraceOpenToken + >>= \i->parseSepList CommaToken parseExpr + <* satTok BraceCloseToken >>= \es->pure $ FunCall i es + +parseVarDef :: Parser Token VarDef +parseVarDef = parseIdent + >>= \i-> many (satTok DotToken *> ( + (parseIdent >>= (\i.if (i == "hd") (pure FieldHd) empty)) <|> + (parseIdent >>= \i.if (i == "tl") (pure FieldTl) empty) <|> + (parseIdent >>= \i.if (i == "fst") (pure FieldFst) empty) <|> + (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty)) + ) >>= \f->pure $ VarDef i f parseOp1 :: Parser Token Op1 parseOp1 = trans1 DashToken UnMinus <|> trans1 ExclamationToken UnNegation -parseFieldSelector :: Parser Token (Maybe FieldSelector) -parseFieldSelector = optional (satTok DotToken *> ( - (parseIdent >>= (\i.if (i == "hd") (pure FieldHd) empty)) <|> - (parseIdent >>= \i.if (i == "tl") (pure FieldTl) empty) <|> - (parseIdent >>= \i.if (i == "fst") (pure FieldFst) empty) <|> - (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty))) - trans2 :: TokenValue (TokenValue -> a) -> Parser Token a trans2 t f = satTok t >>= \(_, r).pure (f r) @@ -123,56 +182,78 @@ parseIdent = trans2 (IdentToken []) (\(IdentToken e).toString e) instance toString AST where toString (AST v f) = concat ( - ["\n":strJoin "\n" (map print v)] ++ - ["\n":strJoin "\n" (map print f)]) + ["\n":printersperse "\n" v] ++ + ["\n":printersperse "\n" f]) class print a :: a -> [String] +printersperse :: String [a] -> [String] | print a +printersperse i j = intercalate [i] (map print j) + instance print FunDecl where print (FunDecl i as t vs ss) = - ["\n", i, " (":strJoin "," (map (\i->[i]) as)] ++ + ["\n", i, " (":printersperse "," as] ++ [") :: ":print t] ++ - ["{\n\t":strJoin "\n\t" (map print vs)] ++ + ["{\n\t":printersperse "\n\t" vs] ++ ["\n":printStatements ss 1] ++ ["\n}"] printStatements :: [Stmt] Int -> [String] -printStatements _ _ = [] +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"] + (WhileStmt b dos) = indent i ["while (":print b] ++ + ["){\n":printStatements dos (i+1)] ++ indent i ["}\n"] + (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 -//TODO -instance print FunType where - print _ = [] +indent :: Int [String] -> [String] +indent i rest = replicate i "\t" ++ rest -//TODO -instance print Stmt where - print _ = [] +instance print FunType where + print (FunType at rt) = printersperse " " at ++ + [if (isEmpty at) "" "->":maybe ["Void"] print rt] instance print VarDecl where print (VarDecl i t e) = print t ++ [" ":i:"=":print e] ++ [";"] instance print Type where - print (TupleType t1 t2) = ["(":print t1] ++ [", ":print t2] ++ [")"] + print (TupleType t1 t2) = ["(":print t1] ++ [",":print t2] ++ [")"] print (ListType t) = ["[":print t] ++ ["]"] - print (IdType s) = [s] - print IntType = ["Int"] - print BoolType = ["Bool"] - print CharType = ["Char"] - print VarType = ["var"] + print (IdType s) = print s + print IntType = print "Int" + print BoolType = print "Bool" + print CharType = print "Char" + print VarType = print "var" + +instance print String where + print s = [s] + +instance print FieldSelector where + print FieldHd = print "hd" + print FieldTl = print "tl" + print FieldSnd = print "snd" + print FieldFst = print "fst" + +instance print VarDef where + print (VarDef i fs) = printersperse "." [i:flatten $ map print fs] -strJoin :: String [[String]] -> [String] -strJoin _ [] = [] -strJoin j [s:rest] = s ++ flatten [[j:ss]\\ss<-rest] +instance print FunCall where + print (FunCall i args) = [i,"(":printersperse "," args] ++ [")"] instance print Expr where - print (VarExpr i Nothing) = [i] - print (VarExpr i (Just mf)) = [i, case mf of - FieldHd = ".hd"; FieldTl = ".tl" - FieldSnd = ".snd"; FieldFst = ".fst"] - print (Op2Expr e1 o e2) = ["(":print e1] ++ [case o of + print (VarExpr vd) = print vd + print (Op2Expr e1 o e2) = ["(":print e1] ++ [" ",case o of BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/" BiMod = "%"; BiEquals = "="; BiLesser = "<"; BiGreater = ">" BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!="; BiAnd = "&&"; BiOr = "||"; BiCons = ":" - :print e2] ++ [")"] + ," ":print e2] ++ [")"] print (Op1Expr o e) = ["(",case o of UnNegation = "!"; UnMinus = "-" :print e] ++ [")"] @@ -183,6 +264,6 @@ instance print Expr where c = if (c == toChar 7) "\\a" (toString c) ,"\'"] print (BoolExpr b) = [toString b] - print (FunExpr i es) = [i,"(":strJoin "," (map print es)] ++ [")"] + print (FunExpr fc) = print fc print EmptyListExpr = ["[]"] print (TupleExpr e1 e2) = ["(":print e1] ++ [",":print e2] ++ [")"]