on master help sign in
javascript: more work on inliner
commit4b6d1847d4e42dcbe7edbc27633b8abe6fa7f019 authorraichoo <raichoo@googlemail.com> dateMon 27 Jan 2014, 18:17 (13 years ago) parent36204f6
1 file changed+93−12
src/IRTS/CodegenJavaScript.hs+93−12
src/IRTS/CodegenJavaScript.hs+93−12
@@ -316,7 +316,10 @@ jsSubst _ _ js = js
316316
317317removeAllocations :: JS -> JS
318318removeAllocations (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
320323 where
321324 removeHelper :: [JS] -> [JS]
322325 removeHelper [js] = [js]
@@ -690,27 +693,102 @@ removeIDs js =
690693inlineFunctions :: [JS] -> [JS]
691694inlineFunctions js =
692695 let funs = collectFunctions js
693− occurences = map (id &&& countAll js) funs in
694− -- (JSRaw $ "// " ++ show (map (id &&& countAll js) funs))
696+ occurences = map ((id . fst) &&& countAll js) funs in
695697 removeDeadFunctions occurences js
696698 where
697− removeDeadFunctions :: [(String, Int)] -> [JS] -> [JS]
699+ removeDeadFunctions :: [(String, (Int, JS))] -> [JS] -> [JS]
698700 removeDeadFunctions _ [] = []
699701 removeDeadFunctions funOccur ((JSAlloc fun (Just (JSFunction _ _))):js)
700− | Just o <- lookup fun funOccur
702+ | Just (o, _) <- lookup fun funOccur
701703 , o == 0 = removeDeadFunctions funOccur js
702704
703705 removeDeadFunctions funOccur (j:js) = j : removeDeadFunctions funOccur js
704706
705707
706− collectFunctions :: [JS] -> [String]
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+
784+ collectFunctions :: [JS] -> [(String, JS)]
707785 collectFunctions js =
708786 catMaybes $ map collectHelper js
709787
710788
711− collectHelper :: JS -> Maybe String
712− collectHelper (JSAlloc fun (Just (JSFunction _ body)))
713− | fun /= "main" && nonRecur fun body = Just fun
789+ collectHelper :: JS -> Maybe (String, JS)
790+ collectHelper (JSAlloc fun (Just js@(JSFunction _ body)))
791+ | fun /= "main" && nonRecur fun body = Just (fun, js)
714792 collectHelper _ = Nothing
715793
716794
@@ -718,8 +796,8 @@ inlineFunctions js =
718796 nonRecur name body = countInvokations name body == 0
719797
720798
721− countAll :: [JS] -> String -> Int
722− countAll js name = sum $ map (countInvokations name) js
799+ countAll :: [JS] -> (String, JS) -> (Int, JS)
800+ countAll js (name, fun) = (sum $ map (countInvokations name) js, fun)
723801
724802
725803 countInvokations :: String -> JS -> Int
@@ -1102,7 +1180,10 @@ translateDeclaration (path, SFun name params stackSize body)
11021180 JSTernary (
11031181 (JSIdent "arg0" `jsInstanceOf` jsCon) `jsAnd`
11041182 (hasProp lookupTableName "arg0")
1105− ) (JSRaw $ lookupTableName ++ "[arg0.tag](arg0)") (JSIdent "arg0")
1183+ ) (JSApp
1184+ (JSIndex (JSIdent lookupTableName) (JSProj (JSIdent "arg0") "tag"))
1185+ [JSIdent "arg0"]
1186+ ) (JSIdent "arg0")
11061187 )
11071188 ]
11081189 | otherwise =