From: pimjager Date: Thu, 26 May 2016 14:50:44 +0000 (+0200) Subject: merge master X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=6b40e2512220130342cf8a883887aed0de72b42b;p=cc1516.git merge master --- 6b40e2512220130342cf8a883887aed0de72b42b diff --cc examples/tempTest.spl index 21545ae,3658ca3..e8be43b --- a/examples/tempTest.spl +++ b/examples/tempTest.spl @@@ -1,18 -1,45 +1,28 @@@ - Let Int a = 4; -//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; + } - mapP1(xs) { - if(isEmpty(xs)) { + map(f, xs) { + if (isEmpty(xs)) { return []; } else { - return (xs.hd + 1) : mapP1(xs.tl); + return f(xs.hd) : map(f, xs.tl); + } + } + + foldr(f, acc, xs) { + if(isEmpty(xs)) { + return acc; + } else { + return foldr(f, f(xs.hd, acc), xs.tl); } } + main() { - [Int] x = []; - [Int] y = []; - Int z = a(); - var f = \x -> x+1; - x = mapP1(x); - y = mapP1(x); - return a() + 5; + var f = plus(1); + var z = map(f, 1:2:[]); + var x = foldr(plus, 0, 1:2:[]); + print(x); + return; ++>>>>>>> master } diff --cc gen.icl index c85643e,48ec099..ebc4754 --- a/gen.icl +++ b/gen.icl @@@ -174,130 -174,136 +174,137 @@@ instance g Expr wher Just (ADDR t arity) = tell [Instr "ldl" [Lit t] ""] >>| mapM_ g fs >>| pure () Just (LAB l _ fn) = tell [Instr "ldc" [Lit fn] "" + ,Instr "sth" [] "" ,Instr "ldc" [Lit 0] "" - ,Instr "stmh" [Lit 2] ""] - g (LambdaExpr _ _ _) = liftT $ Left $ Error "PANIC: Lambdas should be Unfolded" - g (FunExpr _ k es fs) = getAdressbook >>= \ab->case 'Map'.get k ab of - //Identifier points to function - Just (LAB l arity fn) = if (arity <> (length es)) - //Function is not complete - ( tell - [Instr "ldc" [Lit fn] "Store function number" - ,Instr "sth" [] "" - ,Instr "ldc" [Lit $ length es] "Store arity" - ,Instr "sth" [] "" - ,Instr "ajs" [Lit -1] ""] - >>| mapM_ g es - >>| if (isEmpty es) (pure ()) (tell - [Instr "stmh" [Lit $ length es] "Store arguments" - ,Instr "ajs" [Lit -1] ""])) - //Function is complete - ( mapM_ g es - >>| jump "bsr" k - >>| tell - [Instr "ajs" [Lit $ ~(length es)] "Clean arguments" - ,Instr "ldr" [Raw "RR"] ""]) - //Identifier points to variable, thus higher order function - Just (ADDR t arity) = if (arity <> (length es)) - //Function is still not complete - ( fresh >>= \finish->fresh >>= \start->tell [ - //Store function number - Instr "ldl" [Lit t] "STARTING HIGHER ORDER UPDATE" - ,Instr "ldh" [Lit 0] "get function number" - ,Instr "sth" [] "Store" - //Store function arity - ,Instr "ldl" [Lit t] "get pointer again" - ,Instr "ldh" [Lit 1] "get function arity" - ,Instr "ldc" [Lit $ length es] "add argument number" - ,Instr "add" [] "add" - ,Instr "sth" [] "Store" - ,Instr "ajs" [Lit -1] "Adjust pointer" - //load the arguments - ,Instr "ldl" [Lit t] "" - ,Instr "ldh" [Lit 1] "Load available arguments" - ,Instr "str" [Raw "R5"] "Store available args in register" - ,Instr "ldc" [Lit 0] "Store offset" - ,Instr "str" [Raw "R6"] "Store offset in register" - ,Lab start - ,Instr "ldr" [Raw "R5"] "" - ,Instr "ldc" [Lit 0] "" - ,Instr "eq" [] "" - ,Instr "brt" [L finish] "Done pushing arg, bye" - //Load heapadress - ,Instr "ldl" [Lit t] "" - ,Instr "ldr" [Raw "R6"] "" - ,Instr "add" [] "Corrected heapaddress" - ,Instr "ldh" [Lit 2] "Load argument" - ,Instr "sth" [] "And store it immediatly after" - //Decrease available arguments - ,Instr "ldr" [Raw "R5"] "" - ,Instr "ldc" [Lit 1] "" - ,Instr "sub" [] "" - ,Instr "str" [Raw "R5"] "" - //Increase available arguments - ,Instr "ldr" [Raw "R6"] "" - ,Instr "ldc" [Lit 1] "" - ,Instr "add" [] "" - ,Instr "str" [Raw "R6"] "" - ,Instr "bra" [L start] "" - ,Lab finish - ] - >>| mapM_ g es - >>| tell - [Instr "stmh" [Lit $ length es] "Store extra args" - ,Instr "ajs" [Lit -1] ""] - ) - //Function is complete - ( fresh >>= \finish->fresh >>= \start->tell [ - Instr "ldl" [Lit t] "STARTING HIGHER ORDER CALL" - ,Instr "ldh" [Lit 1] "Load available arguments" - ,Instr "str" [Raw "R5"] "Store available args in register" - ,Instr "ldc" [Lit 0] "Store offset" - ,Instr "str" [Raw "R6"] "Store offset in register" - - ,Lab start - ,Instr "ldr" [Raw "R5"] "" - ,Instr "ldc" [Lit 0] "" - ,Instr "eq" [] "" - ,Instr "brt" [L finish] "Done pushing arg, bye" - //Load heapadress - ,Instr "ldl" [Lit t] "" - ,Instr "ldr" [Raw "R6"] "" - ,Instr "add" [] "Corrected heapaddress" - ,Instr "ldh" [Lit 2] "Load argument" - //Decrease available arguments - ,Instr "ldr" [Raw "R5"] "" - ,Instr "ldc" [Lit 1] "" - ,Instr "sub" [] "" - ,Instr "str" [Raw "R5"] "" - //Increase available arguments - ,Instr "ldr" [Raw "R6"] "" - ,Instr "ldc" [Lit 1] "" - ,Instr "add" [] "" - ,Instr "str" [Raw "R6"] "" - ,Instr "bra" [L start] "" - ,Lab finish - ] - >>| mapM_ g es - >>| tell - [Instr "ldl" [Lit t] "" - ,Instr "ldh" [Lit 0] "Get function number" - ,Instr "str" [Raw "R5"] "" - ,Instr "bsr" [L "1func"] "" - ,Instr "ldr" [Raw "MP"] "" - ,Instr "ldc" [Lit t] "" - ,Instr "add" [] "" - ,Instr "str" [Raw "SP"] "" - ,Instr "ldr" [Raw "RR"] "" - ] - ) - Nothing = liftT (Left $ Error "Undefined function!!!") + ,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 - jump :: String String -> Gen () - jump instr k = getAdressbook >>= \ab->case 'Map'.get k ab of - Nothing = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"]) - Just (LAB t _ _) = tell [Instr instr [L t] (k +++"()")] - Just (ADDR t arity) = abort "NO ADDRESS JUMPING FFS" + funnyStuff :: String [Expr] [FieldSelector] -> Gen () + funnyStuff k es fs = getAdressbook >>= \ab->case 'Map'.get k ab of + //Identifier points to function + Just (LAB l arity fn) = if (arity <> (length es)) + //Function is not complete + ( tell + [Instr "ldc" [Lit fn] "Store function number" + ,Instr "sth" [] "" + ,Instr "ldc" [Lit $ length es] "Store arity" + ,Instr "sth" [] "" + ,Instr "ajs" [Lit -1] ""] + >>| mapM_ g es + >>| if (isEmpty es) (pure ()) (tell + [Instr "stmh" [Lit $ length es] "Store arguments" + ,Instr "ajs" [Lit -1] ""])) + //Function is complete + ( mapM_ g es + >>| getAdressbook >>= \ab->(case 'Map'.get k ab of + Nothing = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"]) + Just (LAB t _ _) = tell [Instr "bsr" [L t] (k +++"()")] + Just (ADDR t arity) = liftT (Left $ Error "NO ADDRESS JUMPING FFS") + ) + >>| tell + [Instr "ajs" [Lit $ ~(length es)] "Clean arguments" + ,Instr "ldr" [Raw "RR"] ""]) + //Identifier points to variable, thus higher order function + Just (ADDR t arity) = if (arity <> (length es)) + //Function is still not complete + ( fresh >>= \finish->fresh >>= \start->tell [ + //Store function number + Instr "ldl" [Lit t] "STARTING HIGHER ORDER UPDATE" + ,Instr "ldh" [Lit 0] "get function number" + ,Instr "sth" [] "Store" + //Store function arity + ,Instr "ldl" [Lit t] "get pointer again" + ,Instr "ldh" [Lit 1] "get function arity" + ,Instr "ldc" [Lit $ length es] "add argument number" + ,Instr "add" [] "add" + ,Instr "sth" [] "Store" + ,Instr "ajs" [Lit -1] "Adjust pointer" + //load the arguments + ,Instr "ldl" [Lit t] "" + ,Instr "ldh" [Lit 1] "Load available arguments" + ,Instr "str" [Raw "R5"] "Store available args in register" + ,Instr "ldc" [Lit 0] "Store offset" + ,Instr "str" [Raw "R6"] "Store offset in register" + ,Lab start + ,Instr "ldr" [Raw "R5"] "" + ,Instr "ldc" [Lit 0] "" + ,Instr "eq" [] "" + ,Instr "brt" [L finish] "Done pushing arg, bye" + //Load heapadress + ,Instr "ldl" [Lit t] "" + ,Instr "ldr" [Raw "R6"] "" + ,Instr "add" [] "Corrected heapaddress" + ,Instr "ldh" [Lit 2] "Load argument" + ,Instr "sth" [] "And store it immediatly after" + //Decrease available arguments + ,Instr "ldr" [Raw "R5"] "" + ,Instr "ldc" [Lit 1] "" + ,Instr "sub" [] "" + ,Instr "str" [Raw "R5"] "" + //Increase available arguments + ,Instr "ldr" [Raw "R6"] "" + ,Instr "ldc" [Lit 1] "" + ,Instr "add" [] "" + ,Instr "str" [Raw "R6"] "" + ,Instr "bra" [L start] "" + ,Lab finish + ] + >>| mapM_ g es + >>| tell + [Instr "stmh" [Lit $ length es] "Store extra args" + ,Instr "ajs" [Lit -1] ""] + ) + //Function is complete + ( fresh >>= \finish->fresh >>= \start->tell [ + Instr "ldl" [Lit t] "STARTING HIGHER ORDER CALL" + ,Instr "ldh" [Lit 1] "Load available arguments" + ,Instr "str" [Raw "R5"] "Store available args in register" + ,Instr "ldc" [Lit 0] "Store offset" + ,Instr "str" [Raw "R6"] "Store offset in register" + + ,Lab start + ,Instr "ldr" [Raw "R5"] "" + ,Instr "ldc" [Lit 0] "" + ,Instr "eq" [] "" + ,Instr "brt" [L finish] "Done pushing arg, bye" + //Load heapadress + ,Instr "ldl" [Lit t] "" + ,Instr "ldr" [Raw "R6"] "" + ,Instr "add" [] "Corrected heapaddress" + ,Instr "ldh" [Lit 2] "Load argument" + //Decrease available arguments + ,Instr "ldr" [Raw "R5"] "" + ,Instr "ldc" [Lit 1] "" + ,Instr "sub" [] "" + ,Instr "str" [Raw "R5"] "" + //Increase available arguments + ,Instr "ldr" [Raw "R6"] "" + ,Instr "ldc" [Lit 1] "" + ,Instr "add" [] "" + ,Instr "str" [Raw "R6"] "" + ,Instr "bra" [L start] "" + ,Lab finish + ] + >>| mapM_ g es + >>| tell + [Instr "ldl" [Lit t] "" + ,Instr "ldh" [Lit 0] "Get function number" + ,Instr "str" [Raw "R5"] "" + ,Instr "bsr" [L "1func"] "HIGHER ORDER END" + ,Instr "ldl" [Lit t] "" + ,Instr "ldh" [Lit 1] "" + ,Instr "neg" [] "" + ,Instr "ldr" [Raw "SP"] "" + ,Instr "add" [] "" + ,Instr "ldc" [Lit $ length es + 1] "" + ,Instr "sub" [] "" + ,Instr "str" [Raw "SP"] "" + ,Instr "ldr" [Raw "RR"] "" + ] + ) + Nothing = liftT (Left $ Error "Undefined function!!!") instance g Stmt where g (IfStmt cond th el) = diff --cc sem.icl index 9d9b5fe,f9de4fe..364eac4 --- a/sem.icl +++ b/sem.icl @@@ -5,6 -5,6 +5,7 @@@ import qualified Data.Map as Ma 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,19 -88,6 +89,21 @@@ wher _ = Left $ SanityError p "main has to return Void") isNiceMain _ = pure () +unfoldLambda :: [FunDecl] -> Typing [FunDecl] +unfoldLambda [fd:fds] = unf_ fd >>= \fds1-> - unfoldLambda fds2 >>= \fds2-> ++ unfoldLambda fds >>= \fds2-> + pure $ fds1 ++ fds2 +where ++ unf_ :: FunDecl -> Typing [FunDecl] + unf_ fd=:(FunDecl _ _ _ _ vds stmts) = - mapM_ unfv_ vds >>= \fds1-> - mapM_ unfs_ stmts >>= \fds2-> - pure [fd:fds] ++ fds2 - unfv_ :: Typing [FunDecl] - unfv_ (VarDecl _ _ _ e) = abort "" - unfs_ _ = abort "" ++ 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