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
| IntType
| BoolType
| CharType
- | VarType
| VoidType
| (->>) infixl 7 Type Type
:: Expr
| 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]
:: 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
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]
[")":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
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
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]
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 = "/"
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
-<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'
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
x = fst x
parseProgram :: Parser Token AST
-parseProgram = AST <$> (many parseVarDecl) <*> (some parseFunDecl)
+parseProgram = AST <$> some parseFunDecl
parseFunDecl :: Parser Token FunDecl
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
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)
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) <|>
(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
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
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)