git.iko.soy/Idris-dev
on master help sign in
javascript: apply uses an extra stackframe, not good
66705c7raichoo
js/Runtime-common.js+9−8
compare with master
unifiedsplit
@@ -13,9 +13,8 @@ var __IDRRT__Forgot = new __IDRRT__Type('Forgot');
13
13
14
14
15/** @constructor */
15/** @constructor */
16−var __IDRRT__Tailcall = function(fun, args) {
16+var __IDRRT__Cont = function(k) {
17− this.fun = fun;
17+ this.k = k;
18− this.args = args;
19};
18};
20
19
21var __IDRRT__ffiWrap = function(fid) {
20var __IDRRT__ffiWrap = function(fid) {
@@ -25,7 +24,9 @@ var __IDRRT__ffiWrap = function(fid) {
25 var arg;
24 var arg;
26 while (res instanceof __IDRRT__Con){
25 while (res instanceof __IDRRT__Con){
27 arg = arguments[i];
26 arg = arguments[i];
27+ res = __IDRRT__tailcall(function(){
28− res = __IDRRT__tailcall(__IDR__mAPPLY0, [res, arg]);
28+ return __IDR__mAPPLY0(res, arg);
29+ });
29 ++i;
30 ++i;
30 }
31 }
31 return res;
32 return res;
@@ -38,10 +39,10 @@ var __IDRRT__Con = function(tag,vars) {
38 this.vars = vars;
39 this.vars = vars;
39};
40};
40
41
41−var __IDRRT__tailcall = function(fun, args) {
42+var __IDRRT__tailcall = function(k) {
42− var ret = new __IDRRT__Tailcall(fun, args);
43+ var ret = k();
43− while (ret instanceof __IDRRT__Tailcall)
44+ while (ret instanceof __IDRRT__Cont)
44− ret = ret.fun.apply(this, ret.args);
45+ ret = ret.k();
45
46
46 return ret;
47 return ret;
47};
48};
src/IRTS/CodegenJavaScript.hs+26−20
@@ -163,9 +163,11 @@ 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 :: String -> [JS] -> JS
166+jsTailcall :: JS -> JS
167−jsTailcall fun args =
167+jsTailcall call =
168− jsCall (idrRTNamespace ++ "tailcall") [JSRaw fun, JSArray args]
168+ jsCall (idrRTNamespace ++ "tailcall") [
169+ JSFunction [] (JSReturn call)
170+ ]
169
171
170jsCall :: String -> [JS] -> JS
172jsCall :: String -> [JS] -> JS
171jsCall fun = JSApp (JSRaw fun)
173jsCall fun = JSApp (JSRaw fun)
@@ -265,7 +267,7 @@ codegenJavaScript target definitions filename outputType = do
265 writeFile filename $ intercalate "\n" $ [ header
267 writeFile filename $ intercalate "\n" $ [ header
266 , idrRuntime
268 , idrRuntime
267 , tgtRuntime
269 , tgtRuntime
268− ] ++ functions ++ [mainLoop]
270+ ] ++ functions ++ [compileJS mainLoop]
269
271
270 setPermissions filename (emptyPermissions { readable = True
272 setPermissions filename (emptyPermissions { readable = True
271 , executable = target == Node
273 , executable = target == Node
@@ -276,15 +278,20 @@ codegenJavaScript target definitions filename outputType = do
276 def = map (first translateNamespace) definitions
278 def = map (first translateNamespace) definitions
277
279
278 functions :: [String]
280 functions :: [String]
279− functions = map (compileJS . optJS 1 . translateDeclaration) def
281+ functions = map (compileJS . translateDeclaration) def
280−
282+
281− mainLoop :: String
283+ mainLoop :: JS
282− mainLoop = compileJS $
284+ mainLoop =
285+ if target == Node
286+ then JSSeq [ loop
287+ , jsCall "main" []
288+ ]
289+ else loop
290+ where
291+ loop :: JS
283− JSSeq [ JSAlloc "main" $ Just $ JSFunction [] (
292+ loop = JSAlloc "main" $ Just $ JSFunction [] (
284− jsTailcall mainFun []
293+ jsTailcall $ jsCall mainFun []
285− )
294+ )
286− , jsCall "main" []
287− ]
288
295
289 mainFun :: String
296 mainFun :: String
290 mainFun = idrNamespace ++ translateName (MN 0 "runMain")
297 mainFun = idrNamespace ++ translateName (MN 0 "runMain")
@@ -503,15 +510,14 @@ translateExpression (SV var) =
503
510
504translateExpression (SApp tc name vars)
511translateExpression (SApp tc name vars)
505 | False <- tc =
512 | False <- tc =
506− jsTailcall (translateFunctionCall name) (map JSVar vars)
513+ jsTailcall $ translateFunctionCall name vars
507 | True <- tc =
514 | True <- tc =
508− JSNew (idrRTNamespace ++ "Tailcall")
515+ JSNew (idrRTNamespace ++ "Cont") [JSFunction [] (
509− [ JSRaw $ translateFunctionCall name
516+ JSReturn $ translateFunctionCall name vars
510− , JSArray $ map JSVar vars
511− ]
517+ )]
512 where
518 where
513− translateFunctionCall name =
519+ translateFunctionCall name vars =
514− translateNamespace name ++ translateName name
520+ jsCall (translateNamespace name ++ translateName name) (map JSVar vars)
515
521
516translateExpression (SOp op vars)
522translateExpression (SOp op vars)
517 | LNoOp <- op = JSVar (last vars)
523 | LNoOp <- op = JSVar (last vars)