hoi
authorMart Lubbers <mart@martlubbers.net>
Fri, 22 Apr 2016 09:45:55 +0000 (11:45 +0200)
committerMart Lubbers <mart@martlubbers.net>
Fri, 22 Apr 2016 09:45:55 +0000 (11:45 +0200)
AST.dcl
AST.icl
grammar/grammar.txt
parse.icl
sem.icl

diff --git a/AST.dcl b/AST.dcl
index 3a61b54..bf6f54f 100644 (file)
--- 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 (file)
--- 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
index 6e9549d..78e5450 100644 (file)
@@ -1,36 +1,30 @@
-<Prog>         ::= <VarDecl>* <FunDecl>+
-
+<Prog>         ::= <FunDecl>+
 <FunDecl>      ::= <id> '(' <Type>* ')' ['::' <FunType] '{' <VarDecl>* <Stmt>+ '}'
-<FunType>      ::= <VoidType> ['->' <FunType>]  //in semantische analyse checken dat Void indien 
-                                                //aanwezig laatste type in de rij is
+<FunType>      ::= <VoidType> ['->' <FunType>]
 <Stmt>         ::= 'if' '(' <Expr> ')' '{' <Stmt>* '}' ['else' '{' <Stmt>* '}']
                  | 'while' '(' <Expr> ')' '{' <Stmt>* '}'
                  | <id> <FieldSels> '=' <Expr> ';'
                  | <FunCall> ';'
                  | 'return' [<Expr>] ';'
-
-<VarDecl>      ::= (<Type> | 'var') <id> '=' <Expr> ';'
+<VarDecl>      ::= <Type> <id> '=' <Expr> ';'
 <Expr>         ::= <BinOrExpr> [':' <Expr>]
 <BinOrExpr>    ::= <BinAndExpr> ['||' <BinOrExpr>]
 <BinAndExpr>   ::= <CompareExpr> ['&&' <BinAndExpr>]
 <CompareExpr>  ::= <PlusMinExpr> [('==' | '<' | '>' | '<=' | '>=' | '!=') <CompareExpr>]
 <PlusMinExpr>  ::= <TimesDivExpr> (('+' | '-') <TimesDivExpr>)*
 <TimesDivExpr> ::= <BasicExpr> (['*' | '/' | '%'] <BasicExpr>)*
-<BasicExpr>    ::= <id> <FieldSels>
-                 | <Op1> <Expr>
+<BasicExpr>    ::= <Op1> <Expr>
                  | <int>
                  | <char>
                  | 'False'
                  | 'True'
                  | '(' <Expr> ')'
-                 | <FunCall>
+                 | <FunCall> <FieldSels>
                  | '[]' <Expr>
                  | '(' <Expr> ',' <Expr> ')'
-
 <FieldSels>    ::= ('.' ('hd'|'tl'|'fst'|'snd))*
-<FunCall>      ::= <id> '(' [<ActArgs>] ')'
+<FunCall>      ::= <id> ['(' <ActArgs>+ ')']
 <ActArgs>      ::= <Expr> [',' ActArgs]
-
 <Type>         ::= 'Int'
                  | 'Bool'
                  | 'Char'
index a507ab3..ab575b6 100644 (file)
--- 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 (file)
--- 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)