git.iko.soy/Idris-dev
on master help sign in
javascript: refactored tailcalls
commit6d3e55b4847b54a8a55e04bb271b18ecd9d97e65 authorraichoo <raichoo@googlemail.com> dateThu 3 Oct 2013, 00:12 (13 years ago) parente391db0
2 files changed+38−45
compare with master
unifiedsplit
js/Runtime-common.js+18−25 src/IRTS/CodegenJavaScript.hs+20−20
js/Runtime-common.js+18−25
@@ -13,21 +13,22 @@ var __IDRRT__Forgot = new __IDRRT__Type('Forgot');
1313
1414
1515/** @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+};
1720
1821var __IDRRT__ffiWrap = function(fid) {
1922 return function(){
20− var res = fid;
21− var i = 0;
22− var arg;
23− while (res instanceof __IDRRT__Con){
24− arg = arguments[i];
25− res = __IDRRT__tailcall(function(){
26− return __IDR__mAPPLY0(res, arg);
27− });
28− ++i;
29− }
30− return res;
23+ var res = fid;
24+ var i = 0;
25+ var arg;
26+ while (res instanceof __IDRRT__Con){
27+ arg = arguments[i];
28+ res = __IDRRT__tailcall(__IDR__mAPPLY0, [res, arg]);
29+ ++i;
30+ }
31+ return res;
3132 }
3233};
3334
@@ -37,20 +38,12 @@ var __IDRRT__Con = function(tag,vars) {
3738 this.vars = vars;
3839};
3940
40−var __IDRRT__tailcall = function(f) {
41− var __f = f;
42− var ret;
43− while (__f) {
44− f = __f;
45− __f = null;
46− ret = f();
41+var __IDRRT__tailcall = function(fun, args) {
42+ var ret = new __IDRRT__Tailcall(fun, args);
43+ while (ret instanceof __IDRRT__Tailcall)
44+ ret = ret.fun.apply(this, ret.args);
4745
48− if (ret instanceof __IDRRT__Tailcall) {
49− __f = ret.f;
50− } else {
51− return ret;
52− }
53− }
46+ return ret;
5447};
5548
5649/*
src/IRTS/CodegenJavaScript.hs+20−20
@@ -163,11 +163,9 @@ compileJS (JSTernary cond true false) =
163163 f = compileJS false in
164164 "(" ++ c ++ ")?(" ++ t ++ "):(" ++ f ++ ")"
165165
166−jsTailcall :: JS -> JS
167−jsTailcall call =
168− jsCall (idrRTNamespace ++ "tailcall") [
169− JSFunction [] (JSReturn call)
170− ]
166+jsTailcall :: String -> [JS] -> JS
167+jsTailcall fun args =
168+ jsCall (idrRTNamespace ++ "tailcall") [JSRaw fun, JSArray args]
171169
172170jsCall :: String -> [JS] -> JS
173171jsCall fun = JSApp (JSRaw fun)
@@ -214,15 +212,16 @@ jsLet name value body =
214212
215213optimizeJS :: JS -> JS
216214optimizeJS (JSApp
217− (JSFunction [arg] (JSReturn (JSNew con [tag, JSArray vals])))
215+ (JSFunction [arg] (JSReturn ret))
218216 [val]
219− ) =
220− JSNew con [tag, JSArray $ subst arg vals (optimizeJS val)]
221− where subst :: String -> [JS] -> JS -> [JS]
222− subst _ [] _ = []
223− subst var (x@(JSVar old) : xs) new
224− | var == translateVariableName old = new : xs
225− | otherwise = x : subst var xs new
217+ )
218+ | JSNew con [tag, JSArray vals] <- ret =
219+ JSNew con [tag, JSArray $ subst arg vals (optimizeJS val)]
220+ where subst :: String -> [JS] -> JS -> [JS]
221+ subst _ [] _ = []
222+ subst var (x@(JSVar old) : xs) new
223+ | var == translateVariableName old = new : xs
224+ | otherwise = x : subst var xs new
226225
227226optimizeJS (JSSeq seq) =
228227 JSSeq (map optimizeJS seq)
@@ -275,7 +274,7 @@ codegenJavaScript target definitions filename outputType = do
275274 mainLoop :: String
276275 mainLoop = compileJS $
277276 JSSeq [ JSAlloc "main" $ Just $ JSFunction [] (
278− jsTailcall $ jsCall mainFun []
277+ jsTailcall mainFun []
279278 )
280279 , jsCall "main" []
281280 ]
@@ -497,14 +496,15 @@ translateExpression (SV var) =
497496
498497translateExpression (SApp tc name vars)
499498 | False <- tc =
500− jsTailcall $ translateFunctionCall name vars
499+ jsTailcall (translateFunctionCall name) (map JSVar vars)
501500 | True <- tc =
502− JSNew (idrRTNamespace ++ "Tailcall") [JSFunction [] (
503− JSReturn $ translateFunctionCall name vars
504− )]
501+ JSNew (idrRTNamespace ++ "Tailcall")
502+ [ JSRaw $ translateFunctionCall name
503+ , JSArray $ map JSVar vars
504+ ]
505505 where
506− translateFunctionCall name vars =
507− jsCall (translateNamespace name ++ translateName name) (map JSVar vars)
506+ translateFunctionCall name =
507+ translateNamespace name ++ translateName name
508508
509509translateExpression (SOp op vars)
510510 | LNoOp <- op = JSVar (last vars)