Combine function composition optimisations

puffnfresh · puffnfresh · commit 58cfc6ca7b56 · 2015-04-21T07:30:33.000-06:00
They messed with each other when separate. Work really well combined.
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer.hs b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
@@ -79,7 +79,6 @@ optimize' js = do
     , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
     , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
     , inlineCommonOperators
-    , inlineAppliedArrComposition
     , inlineAppliedVars ]) js
 
 untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
@@ -18,7 +18,6 @@ module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
   inlineValues,
   inlineOperator,
   inlineCommonOperators,
-  inlineAppliedArrComposition,
   inlineAppliedVars,
   inlineArrComposition,
   etaConvert,
@@ -241,29 +240,27 @@ inlineCommonOperators = applyAll $
     go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
     go _ _   _ = Nothing
 
--- (f << g $ x) = f (g x)
-inlineAppliedArrComposition :: JS -> JS
-inlineAppliedArrComposition = everywhereOnJS convert
-  where
-  convert :: JS -> JS
-  convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn = JSApp x [JSApp y [z]]
-  convert other = other
-
 inlineAppliedVars :: JS -> JS
 inlineAppliedVars = everywhereOnJS convert
   where
   convert :: JS -> JS
   convert (JSApp (JSFunction Nothing [a] (JSBlock [JSReturn b])) [JSVar x]) = replaceIdent a (JSVar x) b
   convert other = other
 
+-- (f <<< g $ x) = f (g x)
+-- (f <<< g)     = \x -> f (g x)
 inlineArrComposition :: (MonadSupply m) => JS -> m JS
-inlineArrComposition js = everywhereOnJSTopDownM convert js
+inlineArrComposition = everywhereOnJSTopDownM convert
   where
   convert :: (MonadSupply m) => JS -> m JS
-  convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn = do
+  convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isArrCompose dict' fn =
+    return $ JSApp x [JSApp y [z]]
+  convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isArrCompose dict' fn = do
     arg <- freshName
     return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
   convert other = return other
+  isArrCompose :: JS -> JS -> Bool
+  isArrCompose dict' fn = isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn
 
 isDict :: (String, String) -> JS -> Bool
 isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
