git.iko.soy/Idris-dev
on master help sign in
javascript: function splitter
8459253raichoo
jsrts/Runtime-common.js+4
compare with master
unifiedsplit
@@ -26,6 +26,10 @@ var i$PROJECT = function(vm,val,loc,arity) {
26 vm.valstack[vm.valstack_base + i + loc] = val.args[i];
26 vm.valstack[vm.valstack_base + i + loc] = val.args[i];
27}
27}
28
28
29+var i$CALL = function(vm,fun,args) {
30+ fun.apply(this,args);
31+}
32+
29var __IDRRT__charCode = function(str) {
33var __IDRRT__charCode = function(str) {
30 if (typeof str == "string")
34 if (typeof str == "string")
31 return str.charCodeAt(0);
35 return str.charCodeAt(0);
src/IRTS/CodegenJavaScript.hs+66−8
@@ -12,6 +12,7 @@ import Util.System
12
12
13import Control.Arrow
13import Control.Arrow
14import Control.Applicative ((<$>), (<*>), pure)
14import Control.Applicative ((<$>), (<*>), pure)
15+import Control.Monad.RWS
15import Data.Char
16import Data.Char
16import Numeric
17import Numeric
17import Data.List
18import Data.List
@@ -303,7 +304,8 @@ codegenJS_all
303codegenJS_all target definitions includes filename outputType = do
304codegenJS_all target definitions includes filename outputType = do
304 let bytecode = map toBC definitions
305 let bytecode = map toBC definitions
305 let info = initCompileInfo bytecode
306 let info = initCompileInfo bytecode
306− let code = concat $ map ((concatMap compileJS) . (translateDecl info)) bytecode
307+ let js = concatMap (translateDecl info) bytecode
308+ let code = concatMap ((map compileJS) . collectSplitFunctions . (\x -> evalRWS (splitFunction x) () 0)) js
307 let (header, rt) = case target of
309 let (header, rt) = case target of
308 Node ->
310 Node ->
309 ("#!/usr/bin/env node\n", "-node")
311 ("#!/usr/bin/env node\n", "-node")
@@ -314,7 +316,7 @@ codegenJS_all target definitions includes filename outputType = do
314 tgtRuntime <- readFile $ concat [path, "Runtime", rt, ".js"]
316 tgtRuntime <- readFile $ concat [path, "Runtime", rt, ".js"]
315 jsbn <- readFile $ path ++ "jsbn/jsbn.js"
317 jsbn <- readFile $ path ++ "jsbn/jsbn.js"
316 let runtime = header ++ jsbn ++ idrRuntime ++ tgtRuntime
318 let runtime = header ++ jsbn ++ idrRuntime ++ tgtRuntime
317− writeFile filename $ runtime ++ code ++ main ++ invokeMain
319+ writeFile filename $ runtime ++ concat code ++ main ++ invokeMain
318 setPermissions filename (emptyPermissions { readable = True
320 setPermissions filename (emptyPermissions { readable = True
319 , executable = target == Node
321 , executable = target == Node
320 , writable = True
322 , writable = True
@@ -326,15 +328,59 @@ codegenJS_all target definitions includes filename outputType = do
326 JSSeq [ JSAlloc "vm" (Just $ JSNew "i$VM" [])
328 JSSeq [ JSAlloc "vm" (Just $ JSNew "i$VM" [])
327 , JSApp (
329 , JSApp (
328 JSIdent (translateName (sMN 0 "runMain"))
330 JSIdent (translateName (sMN 0 "runMain"))
329− ) [ JSIdent "vm"
331+ ) [ JSIdent "vm"
330− , JSNum (JSInt 0)
332+ , JSNum (JSInt 0)
331− ]
333+ ]
332 ]
334 ]
333 )
335 )
334
336
335 invokeMain :: String
337 invokeMain :: String
336 invokeMain = compileJS $ JSApp (JSIdent "main") []
338 invokeMain = compileJS $ JSApp (JSIdent "main") []
337
339
340+collectSplitFunctions :: (JS, [(Int,JS)]) -> [JS]
341+collectSplitFunctions (fun, splits) = map generateSplitFunction splits ++ [fun]
342+ where
343+ generateSplitFunction :: (Int,JS) -> JS
344+ generateSplitFunction (depth, JSAlloc name fun) =
345+ JSAlloc (name ++ "$" ++ show depth) fun
346+
347+splitFunction :: JS -> RWS () [(Int,JS)] Int JS
348+splitFunction (JSAlloc name (Just (JSFunction args body))) = do
349+ b <- splitSequence body
350+ return $ JSAlloc name (Just (JSFunction args b))
351+ where
352+ splitSequence :: JS -> RWS () [(Int, JS)] Int JS
353+ splitSequence js@(JSSeq seq) = do
354+ let (pre,post) = break isCall seq in
355+ case post of
356+ [] -> return js
357+ [_] -> return js
358+ (call:rest) -> do
359+ depth <- get
360+ put (depth + 1)
361+ new <- splitFunction (newFun rest)
362+ tell [(depth, new)]
363+ {-return $ JSSeq (pre ++ [newCall depth, call])-}
364+ return $ JSSeq (pre ++ [call, newCall depth])
365+
366+ isCall :: JS -> Bool
367+ isCall (JSApp (JSIdent "i$CALL") _) = True
368+ isCall _ = False
369+
370+ newCall :: Int -> JS
371+ newCall depth =
372+ JSApp (JSIdent "i$CALL") [ JSIdent "vm"
373+ , JSIdent $ name ++ "$" ++ show depth
374+ , JSArray [JSIdent "vm"
375+ , JSIdent "oldbase"
376+ , JSIdent "myoldbase"
377+ ]
378+ ]
379+
380+ newFun :: [JS] -> JS
381+ newFun seq =
382+ JSAlloc name (Just $ JSFunction ["vm", "oldbase", "myoldbase"] (JSSeq seq))
383+
338
384
339translateDecl :: CompileInfo -> (Name, [BC]) -> [JS]
385translateDecl :: CompileInfo -> (Name, [BC]) -> [JS]
340translateDecl info (name@(MN 0 fun), bc)
386translateDecl info (name@(MN 0 fun), bc)
@@ -457,9 +503,9 @@ translateConstant (AType ATFloat) = JSType JSFloatTy
457translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
503translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
458translateConstant PtrType = JSType JSPtrTy
504translateConstant PtrType = JSType JSPtrTy
459translateConstant Forgot = JSType JSForgotTy
505translateConstant Forgot = JSType JSForgotTy
460−translateConstant (BI i) = jsBigInt (JSString $ show i)
461translateConstant (BI 0) = JSNum (JSInteger JSBigZero)
506translateConstant (BI 0) = JSNum (JSInteger JSBigZero)
462translateConstant (BI 1) = JSNum (JSInteger JSBigOne)
507translateConstant (BI 1) = JSNum (JSInteger JSBigOne)
508+translateConstant (BI i) = jsBigInt (JSString $ show i)
463translateConstant (B8 b) = JSWord (JSWord8 b)
509translateConstant (B8 b) = JSWord (JSWord8 b)
464translateConstant (B16 b) = JSWord (JSWord16 b)
510translateConstant (B16 b) = JSWord (JSWord16 b)
465translateConstant (B32 b) = JSWord (JSWord32 b)
511translateConstant (B32 b) = JSWord (JSWord32 b)
@@ -508,10 +554,22 @@ jsASSIGNCONST :: CompileInfo -> Reg -> Const -> JS
508jsASSIGNCONST _ r c = JSAssign (translateReg r) (translateConstant c)
554jsASSIGNCONST _ r c = JSAssign (translateReg r) (translateConstant c)
509
555
510jsCALL :: CompileInfo -> Name -> JS
556jsCALL :: CompileInfo -> Name -> JS
557+jsCALL _ n =
558+ JSApp (
559+ JSIdent "i$CALL"
511−jsCALL _ n = JSApp (JSIdent (translateName n)) [JSIdent "vm", JSIdent "myoldbase"]
560+ ) [ JSIdent "vm", JSIdent (translateName n), JSArray [ JSIdent "vm"
561+ , JSIdent "myoldbase"
562+ ]
563+ ]
512
564
513jsTAILCALL :: CompileInfo -> Name -> JS
565jsTAILCALL :: CompileInfo -> Name -> JS
566+jsTAILCALL _ n =
567+ JSApp (
568+ JSIdent "i$CALL"
514−jsTAILCALL _ n = JSApp (JSIdent (translateName n)) [JSIdent "vm", JSIdent "oldbase"]
569+ ) [ JSIdent "vm", JSIdent (translateName n), JSArray [ JSIdent "vm"
570+ , JSIdent "oldbase"
571+ ]
572+ ]
515
573
516jsFOREIGN :: CompileInfo -> Reg -> String -> [(FType, Reg)] -> JS
574jsFOREIGN :: CompileInfo -> Reg -> String -> [(FType, Reg)] -> JS
517jsFOREIGN _ reg n args =
575jsFOREIGN _ reg n args =