git.iko.soy/Idris-dev
on master help sign in
javascript: eliminate dead cases
cb1fab7raichoo
src/IRTS/CodegenJavaScript.hs+58−1
compare with master
unifiedsplit
@@ -477,6 +477,62 @@ reduceJS js = reduceLoop [] ([], js)
477funName :: JS -> String
477funName :: JS -> String
478funName (JSAlloc fun _) = fun
478funName (JSAlloc fun _) = fun
479
479
480+
481+deadEvalApplyCases :: [JS] -> [JS]
482+deadEvalApplyCases js =
483+ let tags = sort $ nub $ concatMap (getTags) js in
484+ map (removeHelper tags) js
485+ where
486+ getTags :: JS -> [Int]
487+ getTags (JSNew "__IDRRT__Con" [JSNum (JSInt tag), args]) =
488+ tag : getTags args
489+
490+ getTags (JSNew _ args) = concatMap getTags args
491+
492+ getTags (JSFunction _ body) = getTags body
493+
494+ getTags (JSReturn ret) = getTags ret
495+
496+ getTags (JSApp lhs rhs) = getTags lhs ++ concatMap getTags rhs
497+
498+ getTags (JSSeq seq) = concatMap getTags seq
499+
500+ getTags (JSOp _ lhs rhs) = getTags lhs ++ getTags rhs
501+
502+ getTags (JSProj obj _) = getTags obj
503+
504+ getTags (JSArray vals) = concatMap getTags vals
505+
506+ getTags (JSAssign lhs rhs) = getTags lhs ++ getTags rhs
507+
508+ getTags (JSAlloc _ (Just val)) = getTags val
509+
510+ getTags (JSCond conds) =
511+ concatMap (uncurry (++)) $ map (getTags *** getTags) conds
512+
513+ getTags (JSTernary c t f) = getTags c ++ getTags t ++ getTags f
514+
515+ getTags js = []
516+ removeHelper :: [Int] -> JS -> JS
517+ removeHelper tags (JSAlloc fun (Just (
518+ JSApp (JSFunction [] (JSSeq seq)) []))
519+ ) =
520+ (JSAlloc fun (Just (
521+ JSApp (JSFunction [] (JSSeq $ remover tags seq)) []))
522+ )
523+
524+ removeHelper _ js = js
525+
526+ remover :: [Int] -> [JS] -> [JS]
527+ remover tags (
528+ j@(JSAssign ((JSIndex (JSIdent "t") (JSNum (JSInt tag)))) _):js
529+ )
530+ | tag `notElem` tags = remover tags js
531+
532+ remover tags (j:js) = j : remover tags js
533+ remover _ [] = []
534+
535+
480initConstructors :: [JS] -> [JS]
536initConstructors :: [JS] -> [JS]
481initConstructors js =
537initConstructors js =
482 let tags = nub $ sort $ concat (map getTags js) in
538 let tags = nub $ sort $ concat (map getTags js) in
@@ -794,7 +850,8 @@ codegenJavaScript target definitions filename outputType = do
794 reduced = reduceJS idsRemoved
850 reduced = reduceJS idsRemoved
795 constRemoved = map reduceConstants reduced
851 constRemoved = map reduceConstants reduced
796 constrInit = initConstructors constRemoved
852 constrInit = initConstructors constRemoved
797− js = map removeAllocations constrInit in
853+ removeAlloc = map removeAllocations constrInit
854+ js = deadEvalApplyCases removeAlloc in
798 map compileJS js
855 map compileJS js
799
856
800 mainLoop :: String
857 mainLoop :: String