X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=parse.icl;h=120935f13bbd515161f690b2031d553ce0eeb6ba;hb=6703509b4b132cee0f4c91dc23795d3d4ab131e8;hp=acd7d9c5941ada0eb377ad866065ca65d57b93e7;hpb=6b3981fb80952fe2c510b6f9b849adb0dff77d2c;p=cc1516.git

diff --git a/parse.icl b/parse.icl
index acd7d9c..120935f 100644
--- a/parse.icl
+++ b/parse.icl
@@ -5,7 +5,6 @@ import StdTuple
 import StdList
 from StdFunc import const, o
 import Data.Either
-import Data.Functor
 import Data.Maybe
 import Control.Monad
 import Control.Applicative
@@ -22,7 +21,7 @@ parser (Left e) = Left e
 parser (Right r) = fst $ runParser parseProgram r
 
 parseProgram :: Parser Token AST
-parseProgram = liftM2 AST (many parseVarDecl) (some parseFunDecl) 
+parseProgram = liftM2 AST (many parseVarDecl) (some parseFunDecl)
 
 parseFunDecl :: Parser Token FunDecl
 parseFunDecl = liftM5 FunDecl
@@ -45,19 +44,18 @@ parseStmt = parseIfStmt <|> parseWhileStmt <|>
 			satTok ReturnToken *> liftM ReturnStmt (optional parseExpr)
 
 		parseAssStmt :: Parser Token Stmt
-		parseAssStmt = 
+		parseAssStmt =
 			liftM2 AssStmt (parseVarDef <* satTok AssignmentToken) parseExpr
 
 		parseIfStmt :: Parser Token Stmt
 		parseIfStmt = liftM3 IfStmt
             (satTok IfToken *> parseBBraces parseExpr)
             (parseBlock <|> parseOneLine)
-            (liftM (fromMaybe []) 
+            (liftM (fromMaybe [])
                 (optional (satTok ElseToken *> (parseBlock<|> parseOneLine))))
 
-
 		parseWhileStmt :: Parser Token Stmt
-		parseWhileStmt = satTok WhileToken *> 
+		parseWhileStmt = satTok WhileToken *>
 			liftM2 WhileStmt (parseBBraces parseExpr) parseBlock
 
 		parseBlock :: Parser Token [Stmt]
@@ -68,15 +66,15 @@ parseStmt = parseIfStmt <|> parseWhileStmt <|>
 		parseOneLine = liftM pure parseStmt
 
 parseFunType :: Parser Token FunType
-parseFunType = satTok DoubleColonToken *> 
+parseFunType = satTok DoubleColonToken *>
 	(parseInOutType <|> (liftM (FunType []) parseVoidOrType))
 	where
 		parseInOutType :: Parser Token FunType
-		parseInOutType = liftM2 FunType 
+		parseInOutType = liftM2 FunType
 			(some parseType <* satTok ArrowToken) parseVoidOrType
 
 		parseVoidOrType :: Parser Token (Maybe Type)
-		parseVoidOrType = (satTok VoidToken *> pure Nothing) <|> 
+		parseVoidOrType = (satTok VoidToken *> pure Nothing) <|>
 			(liftM Just parseType) <|> pure Nothing
 
 parseVarDecl :: Parser Token VarDecl
@@ -86,7 +84,7 @@ parseVarDecl = liftM3 VarDecl
 	(parseExpr <* satTok SColonToken)
 
 parseType :: Parser Token Type
-parseType = 
+parseType =
 	trans1 IntTypeToken IntType <|>
 	trans1 CharTypeToken CharType <|>
 	trans1 BoolTypeToken BoolType <|>
@@ -122,7 +120,7 @@ parseExpr = //Operators in order of binding strength
 			) >>= \moe->foldM (\e->(\(op,e2)->pure $ Op2Expr e op e2)) e1 moe
 
 		parseBasicExpr :: Parser Token Expr
-		parseBasicExpr = 
+		parseBasicExpr =
 			(liftM TupleExpr (parseTuple parseExpr)) <|>
 			(liftM FunExpr parseFunCall) <|>
 			parseBBraces parseExpr <|>
@@ -140,7 +138,7 @@ parseFunCall = liftM2 FunCall
 
 parseVarDef :: Parser Token VarDef
 parseVarDef = liftM2 VarDef
-	parseIdent 
+	parseIdent
 	(many (satTok DotToken *> (
 		(parseIdent >>= (\i.if (i == "hd") (pure FieldHd) empty)) <|>
 		(parseIdent >>= \i.if (i == "tl") (pure FieldTl) empty) <|>
@@ -160,8 +158,8 @@ parseBSqBraces :: (Parser Token a) -> Parser Token a
 parseBSqBraces p = satTok SquareOpenToken *> p <* satTok SquareCloseToken
 
 parseTuple :: (Parser Token a) -> Parser Token (a, a)
-parseTuple p = satTok BraceOpenToken *> 
-	(liftM2 (\a->(\b->(a,b))) (p <* satTok CommaToken) p) 
+parseTuple p = satTok BraceOpenToken *>
+	(liftM2 (\a->(\b->(a,b))) (p <* satTok CommaToken) p)
 	<* satTok BraceCloseToken
 
 trans2 :: TokenValue (TokenValue -> a) -> Parser Token a
@@ -173,8 +171,9 @@ trans1 t r = trans2 t $ const r
 derive gPrint TokenValue
 derive gEq TokenValue
 satTok :: TokenValue -> Parser Token Token
-satTok t = top >>= \tok=:{line,column,token} -> if (eq t token) 
-	(return tok) (fail <?> PositionalError line column ("ParseError: Unexpected token: " +++ printToString token))
+satTok t = top >>= \tok=:{line,column,token} -> if (eq t token)
+	(pure tok) (fail <?> PositionalError line column
+		("ParseError: Unexpected token: " +++ printToString token))
 	where
 		eq (IdentToken _)  (IdentToken _) = True
 		eq (NumberToken _) (NumberToken _) = True
@@ -182,7 +181,7 @@ satTok t = top >>= \tok=:{line,column,token} -> if (eq t token)
 		eq x y = gEq {|*|} x y
 
 parseSepList :: TokenValue (Parser Token a) -> Parser Token [a]
-parseSepList sep p = 
+parseSepList sep p =
 	(liftM2 (\es->(\e->reverse [e:es])) (some (p <* satTok sep)) p) <|>
 	(liftM pure p) <|> pure empty
 
@@ -210,9 +209,9 @@ printStatements :: [Stmt] Int -> [String]
 printStatements [] i = []
 printStatements [s:ss] i = (case s of
 	(IfStmt b thens elses) = indent i ["if (":print b] ++ [")"] ++
-		printCodeBlock thens i ++ 
+		printCodeBlock thens i ++
 		indent i ["else ":printCodeBlock elses i] ++ ["\n"]
-	(WhileStmt b dos) = indent i ["while (":print b] ++ 
+	(WhileStmt b dos) = indent i ["while (":print b] ++
 		[")":printCodeBlock dos i]
 	(AssStmt vardef val) =
 		indent i $ print vardef ++ ["=":print val] ++ [";\n"]
@@ -248,7 +247,7 @@ instance print Type where
 instance print String where
 	print s = [s]
 
-instance print FieldSelector where	
+instance print FieldSelector where
 	print FieldHd = print "hd"
 	print FieldTl = print "tl"
 	print FieldSnd = print "snd"