@@ -755,6 +755,29 @@ removeIDs js =
755755 removeIDCall ids js = transformJS (removeIDCall ids) js
756756
757757
758+inlineFunction :: String -> [String] -> JS -> JS -> JS
759+inlineFunction fun args body js = inline' js
760+ where
761+ inline' :: JS -> JS
762+ inline' (JSApp (JSIdent name) vals)
763+ | name == fun =
764+ let (js, phs) = insertPlaceHolders args body in
765+ inline' $ foldr (uncurry jsSubst) js (zip phs vals)
766+
767+ inline' js = transformJS inline' js
768+
769+ insertPlaceHolders :: [String] -> JS -> (JS, [JS])
770+ insertPlaceHolders args body = insertPlaceHolders' args body []
771+ where
772+ insertPlaceHolders' :: [String] -> JS -> [JS] -> (JS, [JS])
773+ insertPlaceHolders' (a:as) body ph
774+ | (body', ph') <- insertPlaceHolders' as body ph =
775+ let phvar = JSIdent $ "__PH_" ++ show (length ph') in
776+ (jsSubst (JSIdent a) phvar body', phvar : ph')
777+
778+ insertPlaceHolders' [] body ph = (body, ph)
779+
780+
758781inlineFunctions :: [JS] -> [JS]
759782inlineFunctions js =
760783 inlineHelper ([], js)
@@ -766,7 +789,7 @@ inlineFunctions js =
766789 | Just new <- inlineAble (
767790 countAll fun front + countAll fun back
768791 ) fun args body =
769− let f = map (inline fun args new) in
792+ let f = map (inlineFunction fun args new) in
770793 inlineHelper (f front, f back)
771794
772795 inlineHelper (front, next:back) = inlineHelper (front ++ [next], back)
@@ -783,29 +806,6 @@ inlineFunctions js =
783806 inlineAble _ _ _ _ = Nothing
784807
785808
786− inline :: String -> [String] -> JS -> JS -> JS
787− inline fun args body js = inline' js
788− where
789− inline' :: JS -> JS
790− inline' (JSApp (JSIdent name) vals)
791− | name == fun =
792− let (js, phs) = insertPlaceHolders args body in
793− inline' $ foldr (uncurry jsSubst) js (zip phs vals)
794−
795− inline' js = transformJS inline' js
796−
797− insertPlaceHolders :: [String] -> JS -> (JS, [JS])
798− insertPlaceHolders args body = insertPlaceHolders' args body []
799− where
800− insertPlaceHolders' :: [String] -> JS -> [JS] -> (JS, [JS])
801− insertPlaceHolders' (a:as) body ph
802− | (body', ph') <- insertPlaceHolders' as body ph =
803− let phvar = JSIdent $ "__PH_" ++ show (length ph') in
804− (jsSubst (JSIdent a) phvar body', phvar : ph')
805−
806− insertPlaceHolders' [] body ph = (body, ph)
807−
808−
809809 nonRecur :: String -> JS -> Bool
810810 nonRecur name body = countInvokations name body == 0
811811
@@ -1416,6 +1416,54 @@ evalCons js =
14161416 match js = transformJS match js
14171417
14181418
1419+elimConds :: [JS] -> [JS]
1420+elimConds js =
1421+ let (conds, rest) = partition isCond js in
1422+ foldl' eraseCond rest conds
1423+ where
1424+ isCond :: JS -> Bool
1425+ isCond (JSAlloc
1426+ fun (Just (JSFunction args (JSCond
1427+ [ (JSBinOp "==" (JSNum (JSInt tag)) _, JSReturn (JSIdent _))
1428+ , (JSNoop, JSReturn (JSIdent _))
1429+ ]))
1430+ )) = True
1431+
1432+ isCond (JSAlloc
1433+ fun (Just (JSFunction args (JSCond
1434+ [ (JSBinOp "==" _ (JSNum (JSInt tag)), JSReturn (JSIdent _))
1435+ , (JSNoop, JSReturn (JSIdent _))
1436+ ]))
1437+ )) = True
1438+
1439+ isCond _ = False
1440+
1441+
1442+ eraseCond :: [JS] -> JS -> [JS]
1443+ eraseCond js (JSAlloc
1444+ fun (Just (JSFunction args (JSCond
1445+ [ (c, JSReturn t)
1446+ , (_, JSReturn f)
1447+ ])
1448+ )
1449+ )) = map (inlineFunction fun args (JSTernary c t f)) js
1450+
1451+
1452+removeUselessCons :: [JS] -> [JS]
1453+removeUselessCons js =
1454+ let (cons, rest) = partition isUseless js in
1455+ foldl' eraseCon rest cons
1456+ where
1457+ isUseless :: JS -> Bool
1458+ isUseless (JSAlloc fun (Just JSNull)) = True
1459+ isUseless (JSAlloc fun (Just (JSIdent _))) = True
1460+ isUseless _ = False
1461+
1462+
1463+ eraseCon :: [JS] -> JS -> [JS]
1464+ eraseCon js (JSAlloc fun (Just val)) = map (jsSubst (JSIdent fun) val) js
1465+
1466+
14191467getGlobalCons :: JS -> [(String, JS)]
14201468getGlobalCons js = foldJS match (++) [] js
14211469 where
@@ -1517,6 +1565,8 @@ codegenJS_all target definitions includes filename outputType = do
15171565 , extractLocalConstructors
15181566 , unfoldLookupTable
15191567 , evalCons
1568+ , elimConds
1569+ , removeUselessCons
15201570 ]
15211571
15221572 functions :: [String]