git.iko.soy/Idris-dev
on master help sign in
javascript: fix backend to support new inliner
24d7698raichoo
jsrts/Runtime-common.js+5
compare with master
unifiedsplit
@@ -24,6 +24,11 @@ var i$CON = function(tag,args,app,ev) {
24 this.ev = ev;
24 this.ev = ev;
25}
25}
26
26
27+/** @constructor */
28+var i$POINTER = function(addr) {
29+ this.addr = addr;
30+}
31+
27var i$SCHED = function(vm) {
32var i$SCHED = function(vm) {
28 i$vm = vm;
33 i$vm = vm;
29 i$valstack = vm.valstack;
34 i$valstack = vm.valstack;
src/IRTS/CodegenJavaScript.hs+29−15
@@ -244,7 +244,7 @@ codegenJS_all target definitions includes libs filename outputType = do
244 , JSApp (JSIdent "i$SCHED") [JSIdent "vm"]
244 , JSApp (JSIdent "i$SCHED") [JSIdent "vm"]
245 , JSApp (
245 , JSApp (
246 JSIdent (translateName (sMN 0 "runMain"))
246 JSIdent (translateName (sMN 0 "runMain"))
247− ) [JSNum (JSInt 0)]
247+ ) [JSNew "i$POINTER" [JSNum (JSInt 0)]]
248 , JSWhile (JSProj jsCALLSTACK "length") (
248 , JSWhile (JSProj jsCALLSTACK "length") (
249 JSSeq [ JSAlloc "func" (Just jsPOP)
249 JSSeq [ JSAlloc "func" (Just jsPOP)
250 , JSAlloc "args" (Just jsPOP)
250 , JSAlloc "args" (Just jsPOP)
@@ -328,24 +328,33 @@ splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do
328
328
329 splitSequence :: JS -> RWS () [(Int, JS)] Int JS
329 splitSequence :: JS -> RWS () [(Int, JS)] Int JS
330 splitSequence js@(JSSeq seq) =
330 splitSequence js@(JSSeq seq) =
331− let (pre,post) = break isCall seq in
331+ let (pre,post) = break isBranch seq in
332 case post of
332 case post of
333− [] -> JSSeq <$> traverse splitCondition seq
333+ [_] -> JSSeq <$> traverse splitCondition seq
334+ [call@(JSCond _),rest@(JSApp _ _)] -> do
335+ rest' <- splitCondition rest
334− [js@(JSCond _)] -> splitCondition js
336+ call' <- splitCondition call
337+ return $ JSSeq (pre ++ [rest', call'])
338+ [call@(JSSwitch _ _ _),rest@(JSApp _ _)] -> do
335− [js@(JSSwitch {})] -> splitCondition js
339+ rest' <- splitCondition rest
336− [_] -> return js
340+ call' <- splitCondition call
341+ return $ JSSeq (pre ++ [rest', call'])
337 (call:rest) -> do
342 (call:rest) -> do
338 depth <- get
343 depth <- get
339 put (depth + 1)
344 put (depth + 1)
340 new <- splitFunction (newFun rest)
345 new <- splitFunction (newFun rest)
341 tell [(depth, new)]
346 tell [(depth, new)]
347+ call' <- splitCondition call
342− return $ JSSeq (pre ++ (newCall depth : [call]))
348+ return $ JSSeq (pre ++ (newCall depth : [call']))
349+ _ -> JSSeq <$> traverse splitCondition seq
343
350
344 splitSequence js = return js
351 splitSequence js = return js
345
352
346− isCall :: JS -> Bool
353+ isBranch :: JS -> Bool
347− isCall (JSApp (JSIdent "i$CALL") _) = True
354+ isBranch (JSApp (JSIdent "i$CALL") _) = True
355+ isBranch (JSCond _) = True
356+ isBranch (JSSwitch _ _ _) = True
348− isCall _ = False
357+ isBranch _ = False
349
358
350 newCall :: Int -> JS
359 newCall :: Int -> JS
351 newCall depth =
360 newCall depth =
@@ -366,7 +375,7 @@ translateDecl info (name@(MN 0 fun), bc)
366 ++ [ JSAlloc (
375 ++ [ JSAlloc (
367 translateName name
376 translateName name
368 ) (Just $ JSFunction ["oldbase"] (
377 ) (Just $ JSFunction ["oldbase"] (
369− JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
378+ JSSeq $ jsFUNPRELUDE ++ map (translateBC info) (fst body) ++ [
370 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "app")
379 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "app")
371 , JSApp (JSProj (translateReg $ caseReg (snd body)) "app") [jsOLDBASE, jsMYOLDBASE]
380 , JSApp (JSProj (translateReg $ caseReg (snd body)) "app") [jsOLDBASE, jsMYOLDBASE]
372 )
381 )
@@ -384,7 +393,7 @@ translateDecl info (name@(MN 0 fun), bc)
384 ++ [ JSAlloc (
393 ++ [ JSAlloc (
385 translateName name
394 translateName name
386 ) (Just $ JSFunction ["oldbase"] (
395 ) (Just $ JSFunction ["oldbase"] (
387− JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
396+ JSSeq $ jsFUNPRELUDE ++ map (translateBC info) (fst body) ++ [
388 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "ev")
397 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "ev")
389 , JSApp (JSProj (translateReg $ caseReg (snd body)) "ev") [jsOLDBASE, jsMYOLDBASE]
398 , JSApp (JSProj (translateReg $ caseReg (snd body)) "ev") [jsOLDBASE, jsMYOLDBASE]
390 )
399 )
@@ -431,11 +440,16 @@ translateDecl info (name, bc) =
431 [ JSAlloc (
440 [ JSAlloc (
432 translateName name
441 translateName name
433 ) (Just $ JSFunction ["oldbase"] (
442 ) (Just $ JSFunction ["oldbase"] (
434− JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info)bc
443+ JSSeq $ jsFUNPRELUDE ++ map (translateBC info)bc
435 )
444 )
436 )
445 )
437 ]
446 ]
438
447
448+jsFUNPRELUDE :: [JS]
449+jsFUNPRELUDE = [jsALLOCMYOLDBASE]
450+
451+jsALLOCMYOLDBASE :: JS
452+jsALLOCMYOLDBASE = JSAlloc "myoldbase" (Just $ JSNew "i$POINTER" [])
439
453
440translateReg :: Reg -> JS
454translateReg :: Reg -> JS
441translateReg reg
455translateReg reg
@@ -567,10 +581,10 @@ jsFOREIGN _ reg n args
567 translateReg reg
581 translateReg reg
568
582
569jsREBASE :: CompileInfo -> JS
583jsREBASE :: CompileInfo -> JS
570−jsREBASE _ = JSAssign jsSTACKBASE jsOLDBASE
584+jsREBASE _ = JSAssign jsSTACKBASE (JSProj jsOLDBASE "addr")
571
585
572jsSTOREOLD :: CompileInfo ->JS
586jsSTOREOLD :: CompileInfo ->JS
573−jsSTOREOLD _ = JSAssign jsMYOLDBASE jsSTACKBASE
587+jsSTOREOLD _ = JSAssign (JSProj jsMYOLDBASE "addr") jsSTACKBASE
574
588
575jsADDTOP :: CompileInfo -> Int -> JS
589jsADDTOP :: CompileInfo -> Int -> JS
576jsADDTOP info n
590jsADDTOP info n