From f37f138cce001a8feedc2660bdbbe648c600a643 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 20 May 2016 11:50:20 +0200
Subject: [PATCH] add fieldselectors to funExpr and funStmt

---
 AST.dcl              |  2 +-
 AST.icl              | 11 ++++++-----
 examples/codeGen.spl |  1 +
 gen.icl              |  5 +++--
 parse.icl            | 22 +++++++++++++---------
 sem.icl              |  2 +-
 6 files changed, 25 insertions(+), 18 deletions(-)

diff --git a/AST.dcl b/AST.dcl
index 1592143..ad3196f 100644
--- a/AST.dcl
+++ b/AST.dcl
@@ -36,7 +36,7 @@ from StdOverloaded import class toString, class ==, class zero, class <
 	= IfStmt Expr [Stmt] [Stmt]
 	| WhileStmt Expr [Stmt]
 	| AssStmt VarDef Expr
-	| FunStmt String [Expr]
+	| FunStmt String [Expr] [FieldSelector]
 	| ReturnStmt (Maybe Expr)
 
 instance toString Pos
diff --git a/AST.icl b/AST.icl
index e1f5bc5..305e8f3 100644
--- a/AST.icl
+++ b/AST.icl
@@ -36,7 +36,7 @@ printStatements [s:ss] i = (case s of
 		[")":printCodeBlock dos i]
 	(AssStmt vardef val) =
 		indent i $ print vardef ++ ["=":print val] ++ [";\n"]
-	(FunStmt ident args) = indent i $ printFunCall ident args
+	(FunStmt ident args fs) = indent i $ printFunCall ident args fs ++ [";\n"]
 	(ReturnStmt me) = indent i ["return ":maybe [""] print me] ++ [";\n"]
 	) ++ printStatements ss i
 	where
@@ -106,7 +106,7 @@ instance print Expr where
 		c = if (c == toChar 7) "\\a" (toString c)
 		,"\'"]
 	print (BoolExpr _ b) = [toString b]
-	print (FunExpr _ id as fs) = printFunCall id as ++ printSelectors fs
+	print (FunExpr _ id as fs) = printFunCall id as fs
 	print (EmptyListExpr _) = ["[]"]
 	print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]
 instance toString Expr where
@@ -115,8 +115,9 @@ instance toString Expr where
 printSelectors :: [FieldSelector] -> [String]
 printSelectors x = case x of [] = [""]; _ = [".":printersperse "." x]
 
-printFunCall :: String [Expr] -> [String]
-printFunCall s args = [s, "(":printersperse "," args] ++ [")"]
+printFunCall :: String [Expr] [FieldSelector] -> [String]
+printFunCall s args fs = [s, "(":printersperse "," args] ++ [")"] ++
+	printSelectors fs
 
 derive gEq Op2
 instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2
@@ -130,4 +131,4 @@ instance < Op2 where (<) o1 o2 = toString o1 < toString o2
 instance < Op1 where (<) o1 o2 = toString o1 < toString o2
 
 derive gEq Type
-instance == Type where (==) t1 t2 = gEq{|*|} t1 t2
\ No newline at end of file
+instance == Type where (==) t1 t2 = gEq{|*|} t1 t2
diff --git a/examples/codeGen.spl b/examples/codeGen.spl
index 5008ef9..e92260f 100644
--- a/examples/codeGen.spl
+++ b/examples/codeGen.spl
@@ -33,5 +33,6 @@ main() {
  //   //Bool y1 = isEmpty(x2); //gives weird type error, not sure why
 //    isEmpty(x2);
     [Int] x1 = 8 : 2 : [];
+	isE(True).hd;
     return x1.hd;
 }
diff --git a/gen.icl b/gen.icl
index 8981738..76085ab 100644
--- a/gen.icl
+++ b/gen.icl
@@ -182,10 +182,11 @@ instance g Stmt where
             Nothing = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as var"])
             Just (LAB t) = liftT (Left $ Error $ "PANIC: cannot assign to function")
             Just (ADDR t) = tell [Instr "stl" [Lit t] ""]
-    g (FunStmt k es) = mapM_ g es 
+    g (FunStmt k es fs) = mapM_ g es 
         >>| jump "bsr" k
         >>| mapM_ (const $ tell [Instr "ajs" [Lit -1] ""]) es //clean up args
-        >>| pure ()
+        >>| mapM_ g fs
+		>>| pure ()
     g (ReturnStmt Nothing) = tell [Instr "unlink" [] ""]
 		>>| tell [Instr "ret" [] ""]
     g (ReturnStmt (Just e)) = g e
diff --git a/parse.icl b/parse.icl
index 46a92e3..bea680b 100644
--- a/parse.icl
+++ b/parse.icl
@@ -41,7 +41,8 @@ parseFunDecl = liftM6 FunDecl
 parseStmt :: Parser Token Stmt
 parseStmt = parseIfStmt <|> parseWhileStmt <|>
 	parseSColon parseAssStmt <|> parseSColon parseReturnStmt <|>
-	(parseSColon parseFunCall >>= \(ident, args)->pure $ FunStmt ident args)
+	(parseSColon parseFunCall 
+		>>= \(ident, args, fs)->pure $ FunStmt ident args fs)
 	where
 		parseSColon :: (Parser Token a) -> Parser Token a
 		parseSColon p = p <* satTok SColonToken
@@ -134,24 +135,27 @@ parseExpr = //Operators in order of binding strength
 			trans2 (NumberToken zero) (\(NumberToken i)->IntExpr pos i) <|>
 			trans2 (CharToken zero) (\(CharToken c)->CharExpr pos c) <|>
 			(Op1Expr pos <$> parseOp1 <*> parseExpr) <|>
-			(parseFunCall >>= \(ident, args)->parseFieldSelectors >>= \fs->
+			(parseFunCall >>= \(ident, args, fs)->
 				pure $ FunExpr pos ident args fs) <|>
 			(VarExpr pos <$> parseVarDef)
 
-parseFunCall :: Parser Token (String, [Expr])
-parseFunCall = liftM2 tuple 
+parseFunCall :: Parser Token (String, [Expr], [FieldSelector])
+parseFunCall = liftM3 (\x y z->(x, y, z))
 	parseIdent 
 	(parseBBraces $ parseSepList CommaToken parseExpr)
+	parseFieldSelectors
 
 parseVarDef :: Parser Token VarDef
 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)))
+parseFieldSelectors = many (satTok DotToken *> 
+	parseIdent >>= \i->case i of
+		"hd" = pure FieldHd
+		"tl" = pure FieldTl 
+		"fst" = pure FieldFst
+		"snd" = pure FieldSnd 
+		_ = empty)
 
 parseOp1 :: Parser Token Op1
 parseOp1 = trans1 DashToken UnMinus <|> trans1 ExclamationToken UnNegation
diff --git a/sem.icl b/sem.icl
index 0da9c77..85d3ac1 100644
--- a/sem.icl
+++ b/sem.icl
@@ -284,7 +284,7 @@ instance infer Stmt where
         changeGamma (extend k (Forall [] given)) >>| //todo: fieldselectors
         pure (s, VoidType)
 
-    FunStmt f es = pure (zero, VoidType) 
+    FunStmt f es _ = pure (zero, VoidType) 
 
     ReturnStmt Nothing = pure (zero, VoidType)
     ReturnStmt (Just e) = infer e
-- 
2.20.1