git.iko.soy/Idris-dev
on master help sign in
Merge pull request #514 from raichoo/javascript

Javascript

commitff726fe3e93d3135ff419b27eb6282536fbf6ad0 authorEdwin Brady <edwin.brady@gmail.com> dateThu 3 Oct 2013, 03:09 (13 years ago) parentf2f0eedbfc4a91
2 files changed+67−38
compare with master
unifiedsplit
js/Runtime-common.js+18−25 src/IRTS/CodegenJavaScript.hs+49−13
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+49−13
@@ -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)
@@ -212,6 +210,43 @@ jsLet name value body =
212210 )
213211 ) [value]
214212
213+jsSubst :: String -> [JS] -> JS -> [JS]
214+jsSubst _ [] _ = []
215+jsSubst var (x@(JSVar old) : xs) new
216+ | var == translateVariableName old = new : xs
217+ | otherwise = x : jsSubst var xs new
218+jsSubst _ xs _ = xs
219+
220+optimizeJS :: JS -> JS
221+optimizeJS (JSApp
222+ (JSFunction [arg] (JSReturn ret))
223+ [val]
224+ )
225+ | JSNew con [tag, JSArray vals] <- ret =
226+ JSNew con [tag, JSArray $ jsSubst arg vals (optimizeJS val)]
227+ | JSApp (JSRaw tc@"__IDRRT__tailcall") [fun, JSArray args] <- ret =
228+ JSApp (JSRaw tc) [fun, JSArray $ jsSubst arg args (optimizeJS val)]
229+
230+optimizeJS (JSSeq seq) =
231+ JSSeq (map optimizeJS seq)
232+
233+optimizeJS (JSFunction args body) =
234+ JSFunction args (optimizeJS body)
235+
236+optimizeJS (JSApp fun args) =
237+ JSApp (optimizeJS fun) (map optimizeJS args)
238+
239+optimizeJS (JSReturn js) =
240+ JSReturn $ optimizeJS js
241+
242+optimizeJS (JSAlloc name (Just js)) =
243+ JSAlloc name (Just $ optimizeJS js)
244+
245+optimizeJS js = js
246+
247+optJS :: Int -> JS -> JS
248+optJS c = foldr (.) id $ take c $ repeat optimizeJS
249+
215250codegenJavaScript
216251 :: JSTarget
217252 -> [(Name, SDecl)]
@@ -241,12 +276,12 @@ codegenJavaScript target definitions filename outputType = do
241276 def = map (first translateNamespace) definitions
242277
243278 functions :: [String]
244− functions = map (compileJS . translateDeclaration) def
279+ functions = map (compileJS . optJS 1 . translateDeclaration) def
245280
246281 mainLoop :: String
247282 mainLoop = compileJS $
248283 JSSeq [ JSAlloc "main" $ Just $ JSFunction [] (
249− jsTailcall $ jsCall mainFun []
284+ jsTailcall mainFun []
250285 )
251286 , jsCall "main" []
252287 ]
@@ -468,14 +503,15 @@ translateExpression (SV var) =
468503
469504translateExpression (SApp tc name vars)
470505 | False <- tc =
471− jsTailcall $ translateFunctionCall name vars
506+ jsTailcall (translateFunctionCall name) (map JSVar vars)
472507 | True <- tc =
473− JSNew (idrRTNamespace ++ "Tailcall") [JSFunction [] (
474− JSReturn $ translateFunctionCall name vars
475− )]
508+ JSNew (idrRTNamespace ++ "Tailcall")
509+ [ JSRaw $ translateFunctionCall name
510+ , JSArray $ map JSVar vars
511+ ]
476512 where
477− translateFunctionCall name vars =
478− jsCall (translateNamespace name ++ translateName name) (map JSVar vars)
513+ translateFunctionCall name =
514+ translateNamespace name ++ translateName name
479515
480516translateExpression (SOp op vars)
481517 | LNoOp <- op = JSVar (last vars)