git.iko.soy/Idris-dev
on master help sign in
javascript: refactored tailcalls
6d3e55braichoo
js/Runtime-common.js+18−25
compare with master
unifiedsplit
@@ -13,21 +13,22 @@ var __IDRRT__Forgot = new __IDRRT__Type('Forgot');
13
13
14
14
15/** @constructor */
15/** @constructor */
16−var __IDRRT__Tailcall = function(f) { this.f = f };
16+var __IDRRT__Tailcall = function(fun, args) {
17+ this.fun = fun;
18+ this.args = args;
19+};
17
20
18var __IDRRT__ffiWrap = function(fid) {
21var __IDRRT__ffiWrap = function(fid) {
19 return function(){
22 return function(){
20− var res = fid;
23+ var res = fid;
21− var i = 0;
24+ var i = 0;
22− var arg;
25+ var arg;
23− while (res instanceof __IDRRT__Con){
26+ while (res instanceof __IDRRT__Con){
24− arg = arguments[i];
27+ arg = arguments[i];
25− res = __IDRRT__tailcall(function(){
26− return __IDR__mAPPLY0(res, arg);
28+ res = __IDRRT__tailcall(__IDR__mAPPLY0, [res, arg]);
27− });
28− ++i;
29+ ++i;
29− }
30+ }
30− return res;
31+ return res;
31 }
32 }
32};
33};
33
34
@@ -37,20 +38,12 @@ var __IDRRT__Con = function(tag,vars) {
37 this.vars = vars;
38 this.vars = vars;
38};
39};
39
40
40−var __IDRRT__tailcall = function(f) {
41+var __IDRRT__tailcall = function(fun, args) {
41− var __f = f;
42+ var ret = new __IDRRT__Tailcall(fun, args);
42− var ret;
43+ while (ret instanceof __IDRRT__Tailcall)
43− while (__f) {
44+ ret = ret.fun.apply(this, ret.args);
44− f = __f;
45− __f = null;
46− ret = f();
47
45
48− if (ret instanceof __IDRRT__Tailcall) {
49− __f = ret.f;
50− } else {
51− return ret;
46+ return ret;
52− }
53− }
54};
47};
55
48
56/*
49/*
src/IRTS/CodegenJavaScript.hs+20−20
@@ -163,11 +163,9 @@ compileJS (JSTernary cond true false) =
163 f = compileJS false in
163 f = compileJS false in
164 "(" ++ c ++ ")?(" ++ t ++ "):(" ++ f ++ ")"
164 "(" ++ c ++ ")?(" ++ t ++ "):(" ++ f ++ ")"
165
165
166−jsTailcall :: JS -> JS
166+jsTailcall :: String -> [JS] -> JS
167−jsTailcall call =
167+jsTailcall fun args =
168− jsCall (idrRTNamespace ++ "tailcall") [
168+ jsCall (idrRTNamespace ++ "tailcall") [JSRaw fun, JSArray args]
169− JSFunction [] (JSReturn call)
170− ]
171
169
172jsCall :: String -> [JS] -> JS
170jsCall :: String -> [JS] -> JS
173jsCall fun = JSApp (JSRaw fun)
171jsCall fun = JSApp (JSRaw fun)
@@ -214,15 +212,16 @@ jsLet name value body =
214
212
215optimizeJS :: JS -> JS
213optimizeJS :: JS -> JS
216optimizeJS (JSApp
214optimizeJS (JSApp
217− (JSFunction [arg] (JSReturn (JSNew con [tag, JSArray vals])))
215+ (JSFunction [arg] (JSReturn ret))
218 [val]
216 [val]
219− ) =
217+ )
218+ | JSNew con [tag, JSArray vals] <- ret =
220− JSNew con [tag, JSArray $ subst arg vals (optimizeJS val)]
219+ JSNew con [tag, JSArray $ subst arg vals (optimizeJS val)]
221− where subst :: String -> [JS] -> JS -> [JS]
220+ where subst :: String -> [JS] -> JS -> [JS]
222− subst _ [] _ = []
221+ subst _ [] _ = []
223− subst var (x@(JSVar old) : xs) new
222+ subst var (x@(JSVar old) : xs) new
224− | var == translateVariableName old = new : xs
223+ | var == translateVariableName old = new : xs
225− | otherwise = x : subst var xs new
224+ | otherwise = x : subst var xs new
226
225
227optimizeJS (JSSeq seq) =
226optimizeJS (JSSeq seq) =
228 JSSeq (map optimizeJS seq)
227 JSSeq (map optimizeJS seq)
@@ -275,7 +274,7 @@ codegenJavaScript target definitions filename outputType = do
275 mainLoop :: String
274 mainLoop :: String
276 mainLoop = compileJS $
275 mainLoop = compileJS $
277 JSSeq [ JSAlloc "main" $ Just $ JSFunction [] (
276 JSSeq [ JSAlloc "main" $ Just $ JSFunction [] (
278− jsTailcall $ jsCall mainFun []
277+ jsTailcall mainFun []
279 )
278 )
280 , jsCall "main" []
279 , jsCall "main" []
281 ]
280 ]
@@ -497,14 +496,15 @@ translateExpression (SV var) =
497
496
498translateExpression (SApp tc name vars)
497translateExpression (SApp tc name vars)
499 | False <- tc =
498 | False <- tc =
500− jsTailcall $ translateFunctionCall name vars
499+ jsTailcall (translateFunctionCall name) (map JSVar vars)
501 | True <- tc =
500 | True <- tc =
502− JSNew (idrRTNamespace ++ "Tailcall") [JSFunction [] (
501+ JSNew (idrRTNamespace ++ "Tailcall")
503− JSReturn $ translateFunctionCall name vars
502+ [ JSRaw $ translateFunctionCall name
503+ , JSArray $ map JSVar vars
504− )]
504+ ]
505 where
505 where
506− translateFunctionCall name vars =
506+ translateFunctionCall name =
507− jsCall (translateNamespace name ++ translateName name) (map JSVar vars)
507+ translateNamespace name ++ translateName name
508
508
509translateExpression (SOp op vars)
509translateExpression (SOp op vars)
510 | LNoOp <- op = JSVar (last vars)
510 | LNoOp <- op = JSVar (last vars)