From: Mart Lubbers Date: Fri, 22 Apr 2016 09:45:55 +0000 (+0200) Subject: hoi X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=e34b5f088ff9a86da61afbbe91c2c88f895673c7;p=cc1516.git hoi --- diff --git a/AST.dcl b/AST.dcl index 3a61b54..bf6f54f 100644 --- a/AST.dcl +++ b/AST.dcl @@ -4,8 +4,8 @@ from Data.Maybe import :: Maybe from StdOverloaded import class toString, class == :: Pos = {line :: Int, col :: Int} -:: AST = AST [VarDecl] [FunDecl] -:: VarDecl = VarDecl Pos Type String Expr +:: AST = AST [FunDecl] +:: VarDecl = VarDecl Pos (Maybe Type) String Expr :: Type = TupleType (Type, Type) | ListType Type @@ -13,7 +13,6 @@ from StdOverloaded import class toString, class == | IntType | BoolType | CharType - | VarType | VoidType | (->>) infixl 7 Type Type :: Expr @@ -23,7 +22,7 @@ from StdOverloaded import class toString, class == | IntExpr Pos Int | CharExpr Pos Char | BoolExpr Pos Bool - | FunExpr Pos FunCall + | FunExpr Pos String [Expr] [FieldSelector] | EmptyListExpr Pos | TupleExpr Pos (Expr, Expr) :: VarDef = VarDef String [FieldSelector] @@ -32,12 +31,11 @@ from StdOverloaded import class toString, class == :: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser | BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons :: FunDecl = FunDecl Pos String [String] (Maybe Type) [VarDecl] [Stmt] -:: FunCall = FunCall String [Expr] :: Stmt = IfStmt Expr [Stmt] [Stmt] | WhileStmt Expr [Stmt] | AssStmt VarDef Expr - | FunStmt FunCall + | FunStmt String [Expr] | ReturnStmt (Maybe Expr) instance toString AST diff --git a/AST.icl b/AST.icl index 7b93acb..43c46f7 100644 --- a/AST.icl +++ b/AST.icl @@ -12,9 +12,7 @@ instance toString Pos where toString {line,col} = concat [toString line, ":", toString col, " "] instance toString AST where - toString (AST v f) = concat ( - ["\n":printersperse "\n" v] ++ - ["\n":printersperse "\n" f]) + toString (AST f) = concat ["\n":printersperse "\n" f] class print a :: a -> [String] @@ -38,7 +36,7 @@ printStatements [s:ss] i = (case s of [")":printCodeBlock dos i] (AssStmt vardef val) = indent i $ print vardef ++ ["=":print val] ++ [";\n"] - (FunStmt fc) = indent i $ print fc ++ [";\n"] + (FunStmt ident args) = indent i $ printFunCall ident args (ReturnStmt me) = indent i ["return ":maybe [""] print me] ++ [";\n"] ) ++ printStatements ss i where @@ -52,7 +50,7 @@ printStatements [s:ss] i = (case s of indent i rest = replicate i "\t" ++ rest instance print VarDecl where - print (VarDecl _ t i e) = print t ++ [" ":i:"=":print e] ++ [";"] + print (VarDecl _ t i e) = maybe ["var"] print t ++ [" ":i:"=":print e] ++ [";"] instance toString Type where toString t = concat $ print t @@ -64,7 +62,6 @@ instance print Type where print IntType = print "Int" print BoolType = print "Bool" print CharType = print "Char" - print VarType = print "var" print VoidType = print "Void" print (t1 ->> t2) = print t1 ++ [" -> ":print t2] @@ -77,15 +74,9 @@ instance print FieldSelector where print FieldSnd = print "snd" print FieldFst = print "fst" -instance toString FieldSelector where - toString fs = concat $ print fs - instance print VarDef where print (VarDef i fs) = printersperse "." [i:flatten $ map print fs] -instance print FunCall where - print (FunCall i args) = [i,"(":printersperse "," args] ++ [")"] - instance toString Op2 where toString o = case o of BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/" @@ -107,9 +98,15 @@ instance print Expr where c = if (c == toChar 7) "\\a" (toString c) ,"\'"] print (BoolExpr _ b) = [toString b] - print (FunExpr _ fc) = print fc + print (FunExpr _ id as fs) = printFunCall id as ++ printSelectors fs print (EmptyListExpr _) = ["[]"] print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"] +printSelectors :: [FieldSelector] -> [String] +printSelectors x = case x of [] = [""]; _ = [".":printersperse "." x] + +printFunCall :: String [Expr] -> [String] +printFunCall s args = [s, "(":printersperse "," args] ++ [")"] + derive gEq Op2 instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2 diff --git a/grammar/grammar.txt b/grammar/grammar.txt index 6e9549d..78e5450 100644 --- a/grammar/grammar.txt +++ b/grammar/grammar.txt @@ -1,36 +1,30 @@ - ::= * + - + ::= + ::= '(' * ')' ['::' * + '}' - ::= ['->' ] //in semantische analyse checken dat Void indien - //aanwezig laatste type in de rij is + ::= ['->' ] ::= 'if' '(' ')' '{' * '}' ['else' '{' * '}'] | 'while' '(' ')' '{' * '}' | '=' ';' | ';' | 'return' [] ';' - - ::= ( | 'var') '=' ';' + ::= '=' ';' ::= [':' ] ::= ['||' ] ::= ['&&' ] ::= [('==' | '<' | '>' | '<=' | '>=' | '!=') ] ::= (('+' | '-') )* ::= (['*' | '/' | '%'] )* - ::= - | + ::= | | | 'False' | 'True' | '(' ')' - | + | | '[]' | '(' ',' ')' - ::= ('.' ('hd'|'tl'|'fst'|'snd))* - ::= '(' [] ')' + ::= ['(' + ')'] ::= [',' ActArgs] - ::= 'Int' | 'Bool' | 'Char' diff --git a/parse.icl b/parse.icl index a507ab3..ab575b6 100644 --- a/parse.icl +++ b/parse.icl @@ -7,9 +7,11 @@ from StdFunc import const, o import Data.Either import Data.Maybe import Data.Functor +import Data.Tuple import Control.Monad import Control.Applicative import Data.Func +import StdMisc from Data.List import intercalate, replicate, instance Functor [] from Text import class Text(concat), instance Text String import GenPrint @@ -25,7 +27,7 @@ parser ts = case runParser parseProgram ts of x = fst x parseProgram :: Parser Token AST -parseProgram = AST <$> (many parseVarDecl) <*> (some parseFunDecl) +parseProgram = AST <$> some parseFunDecl parseFunDecl :: Parser Token FunDecl parseFunDecl = liftM6 FunDecl @@ -39,7 +41,7 @@ parseFunDecl = liftM6 FunDecl parseStmt :: Parser Token Stmt parseStmt = parseIfStmt <|> parseWhileStmt <|> parseSColon parseAssStmt <|> parseSColon parseReturnStmt <|> - (FunStmt <$> parseSColon parseFunCall) + (parseSColon parseFunCall >>= \(ident, args)->pure $ FunStmt ident args) where parseSColon :: (Parser Token a) -> Parser Token a parseSColon p = p <* satTok SColonToken @@ -78,7 +80,7 @@ parseFunType = satTok DoubleColonToken *> parseFT parseVarDecl :: Parser Token VarDecl parseVarDecl = liftM4 VarDecl peekPos - (parseType <|> trans1 VarToken VarType ) + ((parseType >>= \t->pure $ Just t)<|> trans1 VarToken Nothing) (parseIdent <* satTok AssignmentToken) (parseExpr <* satTok SColonToken) @@ -122,7 +124,8 @@ parseExpr = //Operators in order of binding strength parseBasicExpr :: Parser Token Expr parseBasicExpr = peekPos >>= \pos -> (TupleExpr pos <$> (parseTuple parseExpr)) <|> - (FunExpr pos <$> parseFunCall) <|> + (parseFunCall >>= \(ident, args)->parseFieldSelectors >>= \fs-> + pure $ FunExpr pos ident args fs) <|> parseBBraces parseExpr <|> trans1 EmptyListToken (EmptyListExpr pos) <|> trans1 TrueToken (BoolExpr pos True) <|> @@ -132,18 +135,19 @@ parseExpr = //Operators in order of binding strength (Op1Expr pos <$> parseOp1 <*> parseExpr) <|> (VarExpr pos <$> parseVarDef) -parseFunCall :: Parser Token FunCall -parseFunCall = FunCall <$> parseIdent <*> - (parseBBraces $ parseSepList CommaToken parseExpr) +parseFunCall :: Parser Token (String, [Expr]) +parseFunCall = tuple <$> parseIdent <*> ( + (parseBBraces $ parseSepList CommaToken parseExpr) <|> pure []) parseVarDef :: Parser Token VarDef -parseVarDef = liftM2 VarDef - parseIdent - (many (satTok DotToken *> ( +parseVarDef = liftM2 VarDef parseIdent parseFieldSelectors + +parseFieldSelectors :: Parser Token [FieldSelector] +parseFieldSelectors = 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)))) + (parseIdent >>= \i.if (i == "snd") (pure FieldSnd) empty))) parseOp1 :: Parser Token Op1 parseOp1 = trans1 DashToken UnMinus <|> trans1 ExclamationToken UnNegation diff --git a/sem.icl b/sem.icl index fa081d4..46749ba 100644 --- a/sem.icl +++ b/sem.icl @@ -37,7 +37,7 @@ variableStream :: [String] variableStream = map toString [1..] sem :: AST -> SemOutput -sem (AST vd fd) = Right $ (AST vd fd, 'Map'.newMap) +sem (AST fd) = Right $ (AST fd, 'Map'.newMap) instance toString Scheme where toString (Forall x t) = concat ["Forall ": map ((+++) "\n") x] +++ toString t @@ -81,7 +81,7 @@ instance infer Expr where infer (IntExpr _ _) = pure IntType infer (CharExpr _ _) = pure CharType infer (BoolExpr _ _) = pure BoolType - infer (FunExpr _ fc) = undef + infer (FunExpr _ _ _ _) = undef infer (EmptyListExpr _) = undef infer (TupleExpr _ (e1, e2)) = infer e1 >>= \et1->infer e2 >>= \et2->pure $ TupleType (et1, et2)