From 3ca56ec76529508b1e6a3c10c145b15312f571f7 Mon Sep 17 00:00:00 2001 From: pimjager Date: Fri, 11 Mar 2016 17:44:38 +0100 Subject: [PATCH] Added position info to the AST for function declarations, var declarations and expressions --- AST.dcl | 30 +++++++++++++++++++----------- AST.icl | 22 +++++++++++----------- parse.icl | 51 +++++++++++++++++++++++++++++++-------------------- 3 files changed, 61 insertions(+), 42 deletions(-) diff --git a/AST.dcl b/AST.dcl index e0687c3..9132067 100644 --- a/AST.dcl +++ b/AST.dcl @@ -3,10 +3,18 @@ definition module AST from Data.Maybe import :: Maybe from StdOverloaded import class toString +/* + * Type errors can happen in either + * - variable declarations (x :: Int = True) + * - function declarations (f :: (Char -> Int) = (+)1) + * - Expressions (1 + 'a') + * So these are the items that will get position metadata + */ + :: Pos = {line :: Int, col :: Int} :: AST = AST [VarDecl] [FunDecl] -:: VarDecl = VarDecl Type String Expr +:: VarDecl = VarDecl Pos Type String Expr :: Type = TupleType (Type, Type) | ListType Type @@ -16,22 +24,22 @@ from StdOverloaded import class toString | CharType | VarType :: Expr - = VarExpr VarDef - | Op2Expr Expr Op2 Expr - | Op1Expr Op1 Expr - | IntExpr Int - | CharExpr Char - | BoolExpr Bool - | FunExpr FunCall - | EmptyListExpr - | TupleExpr (Expr, Expr) + = VarExpr Pos VarDef + | Op2Expr Pos Expr Op2 Expr + | Op1Expr Pos Op1 Expr + | IntExpr Pos Int + | CharExpr Pos Char + | BoolExpr Pos Bool + | FunExpr Pos FunCall + | EmptyListExpr Pos + | TupleExpr Pos (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 -:: FunDecl = FunDecl String [String] (Maybe FunType) [VarDecl] [Stmt] +:: FunDecl = FunDecl Pos String [String] (Maybe FunType) [VarDecl] [Stmt] :: FunType = FunType [Type] (Maybe Type) :: FunCall = FunCall String [Expr] :: Stmt diff --git a/AST.icl b/AST.icl index 6023056..fb4c405 100644 --- a/AST.icl +++ b/AST.icl @@ -18,7 +18,7 @@ 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) = + print (FunDecl _ i as t vs ss) = ["\n", i, " (":printersperse "," as] ++ [")"] ++ maybe [] (\tt->[" :: ":print tt]) t ++ ["{\n\t":printersperse "\n\t" vs] ++ @@ -52,7 +52,7 @@ instance print FunType where [if (isEmpty at) "" "->":maybe ["Void"] print rt] instance print VarDecl where - print (VarDecl t i e) = print t ++ [" ":i:"=":print e] ++ [";"] + print (VarDecl _ t i e) = print t ++ [" ":i:"=":print e] ++ [";"] instance print Type where print (TupleType (t1, t2)) = ["(":print t1] ++ [",":print t2] ++ [")"] @@ -79,23 +79,23 @@ instance print FunCall where print (FunCall i args) = [i,"(":printersperse "," args] ++ [")"] instance print Expr where - print (VarExpr vd) = print vd - 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 (Op1Expr o e) = ["(",case o of + print (Op1Expr _ o e) = ["(",case o of UnNegation = "!"; UnMinus = "-" :print e] ++ [")"] - print (IntExpr i) = [toString i] - print (CharExpr c) = ["\'", case c of + print (IntExpr _ i) = [toString i] + print (CharExpr _ c) = ["\'", case c of '\b' = "\\b"; '\f' = "\\f"; '\n' = "\\n" '\r' = "\\r"; '\t' = "\\t"; '\v' = "\\v" c = if (c == toChar 7) "\\a" (toString c) ,"\'"] - print (BoolExpr b) = [toString b] - print (FunExpr fc) = print fc - print EmptyListExpr = ["[]"] - print (TupleExpr (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"] + print (BoolExpr _ b) = [toString b] + print (FunExpr _ fc) = print fc + print (EmptyListExpr _) = ["[]"] + print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"] diff --git a/parse.icl b/parse.icl index dfb0708..8c4a25e 100644 --- a/parse.icl +++ b/parse.icl @@ -23,12 +23,13 @@ parser (Left e) = Left e parser (Right r) = fst $ runParser parseProgram r parseProgram :: Parser Token AST -parseProgram = liftM2 AST (many parseVarDecl) (some parseFunDecl) +parseProgram = AST <$> (many parseVarDecl) <*> (some parseFunDecl) parseFunDecl :: Parser Token FunDecl -parseFunDecl = liftM5 FunDecl - (parseIdent <* satTok BraceOpenToken) - (parseSepList CommaToken parseIdent <* satTok BraceCloseToken) +parseFunDecl = liftM6 FunDecl + (peekPos) + (parseIdent) + (satTok BraceOpenToken *> parseSepList CommaToken parseIdent <* satTok BraceCloseToken) (optional parseFunType <* satTok CBraceOpenToken) (many parseVarDecl) (many parseStmt <* satTok CBraceCloseToken) @@ -79,7 +80,8 @@ parseFunType = satTok DoubleColonToken *> (Just <$> parseType) <|> pure Nothing parseVarDecl :: Parser Token VarDecl -parseVarDecl = liftM3 VarDecl +parseVarDecl = liftM4 VarDecl + peekPos (parseType <|> trans1 VarToken VarType ) (parseIdent <* satTok AssignmentToken) (parseExpr <* satTok SColonToken) @@ -111,27 +113,27 @@ parseExpr = //Operators in order of binding strength trans1 PercentToken BiMod) $ parseBasicExpr where parseOpR :: (Parser Token Op2) (Parser Token Expr) -> Parser Token Expr - parseOpR ops prev = prev >>= \e1->optional ( + parseOpR ops prev = peekPos >>= \pos-> prev >>= \e1->optional ( ops >>= \op->parseOpR ops prev >>= \e->pure (op, e) - ) >>= \moe->pure $ maybe e1 (\(op,e2)->Op2Expr e1 op e2) moe + ) >>= \moe->pure $ maybe e1 (\(op,e2)->Op2Expr pos e1 op e2) moe parseOpL :: (Parser Token Op2) (Parser Token Expr) -> Parser Token Expr - parseOpL ops prev = prev >>= \e1->many ( + parseOpL ops prev = peekPos >>= \pos-> prev >>= \e1->many ( ops >>= \op->prev >>= \e->pure (op, e) - ) >>= \moe->foldM (\e->(\(op,e2)->pure $ Op2Expr e op e2)) e1 moe + ) >>= \moe->foldM (\e->(\(op,e2)->pure $ Op2Expr pos e op e2)) e1 moe parseBasicExpr :: Parser Token Expr - parseBasicExpr = - (TupleExpr <$> (parseTuple parseExpr)) <|> - (FunExpr <$> parseFunCall) <|> + parseBasicExpr = peekPos >>= \pos -> + (TupleExpr pos <$> (parseTuple parseExpr)) <|> + (FunExpr pos <$> parseFunCall) <|> parseBBraces parseExpr <|> - trans1 EmptyListToken EmptyListExpr <|> - trans1 TrueToken (BoolExpr True) <|> - trans1 FalseToken (BoolExpr False) <|> - trans2 (NumberToken zero) (\(NumberToken i)->IntExpr i) <|> - trans2 (CharToken zero) (\(CharToken c)->CharExpr c) <|> - (Op1Expr <$> parseOp1 <*> parseExpr) <|> - (VarExpr <$> parseVarDef) + trans1 EmptyListToken (EmptyListExpr pos) <|> + trans1 TrueToken (BoolExpr pos True) <|> + trans1 FalseToken (BoolExpr pos False) <|> + trans2 (NumberToken zero) (\(NumberToken i)->IntExpr pos i) <|> + trans2 (CharToken zero) (\(CharToken c)->CharExpr pos c) <|> + (Op1Expr pos <$> parseOp1 <*> parseExpr) <|> + (VarExpr pos <$> parseVarDef) parseFunCall :: Parser Token FunCall parseFunCall = FunCall <$> parseIdent <*> (parseBBraces $ parseSepList CommaToken parseExpr) @@ -162,12 +164,18 @@ parseTuple p = satTok BraceOpenToken *> (liftM2 (\a->(\b->(a,b))) (p <* satTok CommaToken) p) <* satTok BraceCloseToken +trans :: TokenValue (TokenValue -> a) -> Parser Token (Pos, a) +trans t f = (\(pos,token)->(pos, f token)) <$> satTok t + trans2 :: TokenValue (TokenValue -> a) -> Parser Token a -trans2 t f = (\(_,token)->f token) <$> satTok t +trans2 t f = snd <$> trans t f trans1 :: TokenValue a -> Parser Token a trans1 t r = trans2 t $ const r +peekPos :: Parser Token Pos +peekPos = fst <$> peek + derive gPrint TokenValue derive gEq TokenValue satTok :: TokenValue -> Parser Token Token @@ -187,3 +195,6 @@ parseSepList sep p = parseIdent :: Parser Token String parseIdent = trans2 (IdentToken "") (\(IdentToken e).toString e) + +//liftM only goes to liftM5 +liftM6 f m1 m2 m3 m4 m5 m6 = f <$> m1 <*> m2 <*> m3 <*> m4 <*> m5 <*> m6 \ No newline at end of file -- 2.20.1