add fieldselectors to funExpr and funStmt

diff --git a/AST.dcl b/AST.dcl
index 1592143..ad3196f 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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