git.iko.soy/Idris-dev
on master help sign in
javascript: more work on inliner
4b6d184raichoo
src/IRTS/CodegenJavaScript.hs+93−12
compare with master
unifiedsplit
@@ -316,7 +316,10 @@ jsSubst _ _ js = js
316
316
317removeAllocations :: JS -> JS
317removeAllocations :: JS -> JS
318removeAllocations (JSSeq body) =
318removeAllocations (JSSeq body) =
319− JSSeq $ removeHelper (map removeAllocations body)
319+ let opt = removeHelper (map removeAllocations body) in
320+ case opt of
321+ [ret] -> ret
322+ _ -> JSSeq opt
320 where
323 where
321 removeHelper :: [JS] -> [JS]
324 removeHelper :: [JS] -> [JS]
322 removeHelper [js] = [js]
325 removeHelper [js] = [js]
@@ -690,27 +693,102 @@ removeIDs js =
690inlineFunctions :: [JS] -> [JS]
693inlineFunctions :: [JS] -> [JS]
691inlineFunctions js =
694inlineFunctions js =
692 let funs = collectFunctions js
695 let funs = collectFunctions js
693− occurences = map (id &&& countAll js) funs in
696+ occurences = map ((id . fst) &&& countAll js) funs in
694− -- (JSRaw $ "// " ++ show (map (id &&& countAll js) funs))
695 removeDeadFunctions occurences js
697 removeDeadFunctions occurences js
696 where
698 where
697− removeDeadFunctions :: [(String, Int)] -> [JS] -> [JS]
699+ removeDeadFunctions :: [(String, (Int, JS))] -> [JS] -> [JS]
698 removeDeadFunctions _ [] = []
700 removeDeadFunctions _ [] = []
699 removeDeadFunctions funOccur ((JSAlloc fun (Just (JSFunction _ _))):js)
701 removeDeadFunctions funOccur ((JSAlloc fun (Just (JSFunction _ _))):js)
700− | Just o <- lookup fun funOccur
702+ | Just (o, _) <- lookup fun funOccur
701 , o == 0 = removeDeadFunctions funOccur js
703 , o == 0 = removeDeadFunctions funOccur js
702
704
703 removeDeadFunctions funOccur (j:js) = j : removeDeadFunctions funOccur js
705 removeDeadFunctions funOccur (j:js) = j : removeDeadFunctions funOccur js
704
706
705
707
708+ inlineSingleOccur :: [(String, (Int, JS))] -> [JS] -> [JS]
709+ inlineSingleOccur occur js =
710+ let funs = map (id *** snd) $ filter ((== 1) . fst . snd) occur in
711+ inlineHelper funs js
712+
713+
714+ inlineHelper :: [(String, JS)] -> [JS] -> [JS]
715+ inlineHelper [] js = js
716+ inlineHelper ((name, fun):funs) js =
717+ let njs = map (inlineFun name fun) js
718+ nfuns = map (id *** (inlineFun name fun)) funs in
719+ inlineHelper nfuns njs
720+
721+
722+ inlineArgs [] _ js = js
723+ inlineArgs (a:as) (v:vs) js = jsSubst a v (inlineArgs as vs js)
724+
725+
726+ inlineFun :: String -> JS -> JS -> JS
727+ inlineFun name (JSFunction args (JSReturn js)) (JSApp (JSIdent lhs) rhs)
728+ | name == lhs = inlineArgs args rhs js
729+
730+ inlineFun name (JSFunction args (JSSeq js)) (JSReturn (JSApp (JSIdent lhs) rhs))
731+ | name == lhs = JSSeq $ map (inlineArgs args rhs) js
732+
733+ inlineFun name (JSFunction args (JSSeq js)) (JSApp (JSIdent lhs) rhs)
734+ | name == lhs = JSSeq $ map (inlineArgs args rhs) js
735+
736+ inlineFun name fun (JSFunction args body) =
737+ JSFunction args (inlineFun name fun body)
738+
739+ inlineFun name fun (JSSeq seq) =
740+ JSSeq $ map (inlineFun name fun) seq
741+
742+ inlineFun name fun (JSReturn ret) =
743+ JSReturn $ inlineFun name fun ret
744+
745+ inlineFun name fun (JSApp lhs rhs) =
746+ JSApp (inlineFun name fun lhs) $ map (inlineFun name fun) rhs
747+
748+ inlineFun name fun (JSNew con args) =
749+ JSNew con $ map (inlineFun name fun) args
750+
751+ inlineFun name fun (JSOp op lhs rhs) =
752+ JSOp op (inlineFun name fun lhs) (inlineFun name fun rhs)
753+
754+ inlineFun name fun (JSProj obj field) =
755+ JSProj (inlineFun name fun obj) field
756+
757+ inlineFun name fun (JSArray vals) =
758+ JSArray $ map (inlineFun name fun) vals
759+
760+ inlineFun name fun (JSAssign lhs rhs) =
761+ JSAssign (inlineFun name fun lhs) (inlineFun name fun rhs)
762+
763+ inlineFun name fun (JSAlloc var (Just val)) =
764+ JSAlloc var (Just $ inlineFun name fun val)
765+
766+ inlineFun name fun (JSIndex lhs rhs) =
767+ JSIndex (inlineFun name fun lhs) (inlineFun name fun rhs)
768+
769+ inlineFun name fun (JSCond conds) =
770+ JSCond $ map (inlineFun name fun *** inlineFun name fun) conds
771+
772+ inlineFun name fun (JSTernary c t f) =
773+ JSTernary (
774+ inlineFun name fun c
775+ ) (
776+ inlineFun name fun t
777+ ) (
778+ inlineFun name fun f
779+ )
780+
781+ inlineFun name fun js = js
782+
783+
706− collectFunctions :: [JS] -> [String]
784+ collectFunctions :: [JS] -> [(String, JS)]
707 collectFunctions js =
785 collectFunctions js =
708 catMaybes $ map collectHelper js
786 catMaybes $ map collectHelper js
709
787
710
788
711− collectHelper :: JS -> Maybe String
789+ collectHelper :: JS -> Maybe (String, JS)
712− collectHelper (JSAlloc fun (Just (JSFunction _ body)))
790+ collectHelper (JSAlloc fun (Just js@(JSFunction _ body)))
713− | fun /= "main" && nonRecur fun body = Just fun
791+ | fun /= "main" && nonRecur fun body = Just (fun, js)
714 collectHelper _ = Nothing
792 collectHelper _ = Nothing
715
793
716
794
@@ -718,8 +796,8 @@ inlineFunctions js =
718 nonRecur name body = countInvokations name body == 0
796 nonRecur name body = countInvokations name body == 0
719
797
720
798
721− countAll :: [JS] -> String -> Int
799+ countAll :: [JS] -> (String, JS) -> (Int, JS)
722− countAll js name = sum $ map (countInvokations name) js
800+ countAll js (name, fun) = (sum $ map (countInvokations name) js, fun)
723
801
724
802
725 countInvokations :: String -> JS -> Int
803 countInvokations :: String -> JS -> Int
@@ -1102,7 +1180,10 @@ translateDeclaration (path, SFun name params stackSize body)
1102 JSTernary (
1180 JSTernary (
1103 (JSIdent "arg0" `jsInstanceOf` jsCon) `jsAnd`
1181 (JSIdent "arg0" `jsInstanceOf` jsCon) `jsAnd`
1104 (hasProp lookupTableName "arg0")
1182 (hasProp lookupTableName "arg0")
1183+ ) (JSApp
1105− ) (JSRaw $ lookupTableName ++ "[arg0.tag](arg0)") (JSIdent "arg0")
1184+ (JSIndex (JSIdent lookupTableName) (JSProj (JSIdent "arg0") "tag"))
1185+ [JSIdent "arg0"]
1186+ ) (JSIdent "arg0")
1106 )
1187 )
1107 ]
1188 ]
1108 | otherwise =
1189 | otherwise =