merge master

diff --git a/AST.dcl b/AST.dcl
index 4a5a6cb..e9afa4f 100644 (file)
--- a/AST.dcl
+++ b/AST.dcl
@@ -27,6 +27,7 @@ from StdOverloaded import class toString, class ==, class zero, class <
        | FunExpr Pos String [Expr] [FieldSelector]
        | EmptyListExpr Pos 
        | TupleExpr Pos (Expr, Expr)
+    | LambdaExpr Pos [String] Expr
 :: VarDef = VarDef String [FieldSelector]
 :: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd
 :: Op1 = UnNegation | UnMinus

diff --git a/AST.icl b/AST.icl
index 6436619..774e158 100644 (file)
--- a/AST.icl
+++ b/AST.icl
@@ -110,6 +110,7 @@ instance print Expr where
        print (FunExpr _ id as fs) = printFunCall id as fs
        print (EmptyListExpr _) = ["[]"]
        print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"]
+    print (LambdaExpr _ args e) = ["\\":args] ++ ["->": print e]
 instance toString Expr where
     toString e = concat $ print e
 

diff --git a/examples/tempTest.spl b/examples/tempTest.spl
index 3658ca3..e8be43b 100644 (file)
--- a/examples/tempTest.spl
+++ b/examples/tempTest.spl
@@ -1,21 +1,3 @@
-//Let Int a = 4;//
-
-//mapP1(xs) {
-//    if(isEmpty(xs)) {
-//        return [];
-//    } else {
-//        return (xs.hd + 1) : mapP1(xs.tl);
-//    }
-//}
-//main() {
-//    [Int] x = [];
-//    [Int] y = [];
-//    Int z = a();
-//    x = mapP1(x);
-//    y = mapP1(x);
-//    return a() + 5;
-//}
-
 plus(x,y){
     return x+y;
 }
@@ -42,4 +24,5 @@ main() {
     var x = foldr(plus, 0, 1:2:[]);
     print(x);
     return;
+>>>>>>> master
 }
\ No newline at end of file

diff --git a/gen.icl b/gen.icl
index 48ec099..ebc4754 100644 (file)
--- a/gen.icl
+++ b/gen.icl
@@ -178,6 +178,7 @@ instance g Expr where
                        ,Instr "ldc" [Lit 0] ""
                        ,Instr "sth" [] ""
                        ,Instr "ajs" [Lit -1] ""]
+    g (LambdaExpr _ _ _) = liftT $ Left $ Error "PANIC: Lambdas should be unfolded"
     g (FunExpr _ k es fs) = funnyStuff k es fs
 
 funnyStuff :: String [Expr] [FieldSelector] -> Gen ()

diff --git a/grammar/grammar.txt b/grammar/grammar.txt
index e63a3f6..b399311 100644 (file)
--- a/grammar/grammar.txt
+++ b/grammar/grammar.txt
@@ -11,6 +11,7 @@
                  | 'return' [<Expr>] ';'
 <VarDecl>      ::= <Type> <id> '=' <Expr> ';'
 <Expr>         ::= <BinOrExpr> [':' <Expr>]
+                 | <LambdaExpr>
 <BinOrExpr>    ::= <BinAndExpr> ['||' <BinOrExpr>]
 <BinAndExpr>   ::= <CompareExpr> ['&&' <BinAndExpr>]
 <CompareExpr>  ::= <PlusMinExpr> [('==' | '<' | '>' | '<=' | '>=' | '!=') <CompareExpr>]
@@ -26,6 +27,7 @@
                  | '[]' <Expr>
                  | '(' <Expr> ',' <Expr> ')'
                  | '"' <char> '"'
+<LamdaExpr>    ::= '\'<id>+ '->' <Expr>
 <FieldSels>    ::= ('.' ('hd'|'tl'|'fst'|'snd))*
 <FunCall>      ::= <id> ['(' <ActArgs>+ ')']
 <ActArgs>      ::= <Expr> [',' ActArgs]

diff --git a/lex.dcl b/lex.dcl
index dd7d28e..f524047 100644 (file)
--- a/lex.dcl
+++ b/lex.dcl
@@ -54,6 +54,7 @@ from AST import :: Pos
        | LesserToken       // <
        | BiggerToken       // >
        | ExclamationToken  // !
+    | BackslashToken    // \
 
 :: LexerOutput :== Either Error [Token]
 

diff --git a/lex.icl b/lex.icl
index 6072bce..6cb2e92 100644 (file)
--- a/lex.icl
+++ b/lex.icl
@@ -67,7 +67,7 @@ lexToken =
        lexWord "/" SlashToken <|> lexWord "%" PercentToken <|>
        lexWord "=" AssignmentToken <|> lexWord "<" LesserToken <|>
        lexWord ">" BiggerToken <|> lexWord "!" ExclamationToken <|>
-       lexWord "-" DashToken <|>
+       lexWord "-" DashToken <|> lexWord "\\" BackslashToken <|>
        //Number and identifier tokens
        lexString <|> lexNumber <|> lexIdentifier <|>
        (item '\n' >>| pure LexNL) <|>

diff --git a/parse.icl b/parse.icl
index 30a13a9..a79ad2f 100644 (file)
--- a/parse.icl
+++ b/parse.icl
@@ -113,7 +113,9 @@ parseType =
        (IdType <$> parseIdent)
 
 parseExpr :: Parser Token Expr
-parseExpr = //Operators in order of binding strength
+parseExpr = parseValueExpr <|> parseLambda
+parseValueExpr :: Parser Token Expr
+parseValueExpr = //Operators in order of binding strength
        parseOpR (trans1 ColonToken BiCons) $
        parseOpR (trans1 PipesToken BiOr) $
        parseOpR (trans1 AmpersandsToken BiAnd) $
@@ -154,6 +156,11 @@ parseExpr = //Operators in order of binding strength
                                pure $ FunExpr pos ident args fs) <|>
                        (VarExpr pos <$> parseVarDef)
 
+parseLambda :: Parser Token Expr
+parseLambda = LambdaExpr <$> peekPos 
+                        <*> (satTok BackslashToken *> some parseIdent)
+                        <*> (satTok ArrowToken *> parseExpr)
+
 makeStrExpr :: Pos [Char] -> Expr
 makeStrExpr p [] = EmptyListExpr p
 makeStrExpr p [x:xs] = Op2Expr p (CharExpr zero x) BiCons (makeStrExpr p xs)

diff --git a/sem.icl b/sem.icl
index f9de4fe..364eac4 100644 (file)
--- a/sem.icl
+++ b/sem.icl
@@ -5,6 +5,7 @@ import qualified Data.Map as Map
 from Data.Func import $
 from StdFunc import o, flip, const, id
 
+import Control.Applicative
 import Control.Monad
 import Control.Monad.Trans
 import Control.Monad.State
@@ -88,6 +89,21 @@ where
                                _ = Left $ SanityError p "main has to return Void")
                isNiceMain _ = pure ()
 
+unfoldLambda :: [FunDecl] -> Typing [FunDecl]
+unfoldLambda [fd:fds] = unf_ fd >>= \fds1-> 
+                        unfoldLambda fds >>= \fds2->
+                        pure $ fds1 ++ fds2
+where
+    unf_ :: FunDecl -> Typing [FunDecl]
+    unf_ fd=:(FunDecl _ _ _ _ vds stmts) = 
+        flatten <$> mapM unfv_ vds >>= \fds1->
+        flatten <$> mapM unfs_ stmts >>= \fds2->
+        pure $ [fd:fds1] ++ fds2
+    unfv_ :: VarDecl -> Typing [FunDecl]
+    unfv_ (VarDecl _ _ _ e) = pure []
+    unfs_ :: Stmt -> Typing [FunDecl]
+    unfs_ _ = pure []
+
 class Typeable a where
     ftv :: a -> [TVar]
     subst :: Substitution a -> a
@@ -225,6 +241,8 @@ instance infer Expr where
         infer e2 >>= \(s2, t2, e2_) ->
         pure (compose s2 s1, TupleType (t1,t2), TupleExpr p (e1_,e2_))
 
+    LambdaExpr _ _ _ = liftT $ Left $ Error "PANIC: lambdas should be Unfolded"
+
     FunExpr p f args fs =
         lookup f >>= \expected ->
         let accST = (\(s,ts,es) e->infer e >>= \(s_,et,e_)-> pure (compose s_ s,ts++[et],es++[e_])) in