git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Combine function composition optimisations
58cfc6cBrian McKenna
src/Language/PureScript/CodeGen/JS/Optimizer.hs−1
@@ -79,7 +79,6 @@ optimize' js = do
79 , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
79 , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
80 , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
80 , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
81 , inlineCommonOperators
81 , inlineCommonOperators
82− , inlineAppliedArrComposition
83 , inlineAppliedVars ]) js
82 , inlineAppliedVars ]) js
84
83
85untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
84untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+8−11
@@ -18,7 +18,6 @@ module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
18 inlineValues,
18 inlineValues,
19 inlineOperator,
19 inlineOperator,
20 inlineCommonOperators,
20 inlineCommonOperators,
21− inlineAppliedArrComposition,
22 inlineAppliedVars,
21 inlineAppliedVars,
23 inlineArrComposition,
22 inlineArrComposition,
24 etaConvert,
23 etaConvert,
@@ -241,14 +240,6 @@ inlineCommonOperators = applyAll $
241 go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
240 go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
242 go _ _ _ = Nothing
241 go _ _ _ = Nothing
243
242
244−-- (f << g $ x) = f (g x)
245−inlineAppliedArrComposition :: JS -> JS
246−inlineAppliedArrComposition = everywhereOnJS convert
247− where
248− convert :: JS -> JS
249− convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn = JSApp x [JSApp y [z]]
250− convert other = other
251−
252inlineAppliedVars :: JS -> JS
243inlineAppliedVars :: JS -> JS
253inlineAppliedVars = everywhereOnJS convert
244inlineAppliedVars = everywhereOnJS convert
254 where
245 where
@@ -256,14 +247,20 @@ inlineAppliedVars = everywhereOnJS convert
256 convert (JSApp (JSFunction Nothing [a] (JSBlock [JSReturn b])) [JSVar x]) = replaceIdent a (JSVar x) b
247 convert (JSApp (JSFunction Nothing [a] (JSBlock [JSReturn b])) [JSVar x]) = replaceIdent a (JSVar x) b
257 convert other = other
248 convert other = other
258
249
250+-- (f <<< g $ x) = f (g x)
251+-- (f <<< g) = \x -> f (g x)
259inlineArrComposition :: (MonadSupply m) => JS -> m JS
252inlineArrComposition :: (MonadSupply m) => JS -> m JS
260−inlineArrComposition js = everywhereOnJSTopDownM convert js
253+inlineArrComposition = everywhereOnJSTopDownM convert
261 where
254 where
262 convert :: (MonadSupply m) => JS -> m JS
255 convert :: (MonadSupply m) => JS -> m JS
263− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn = do
256+ convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isArrCompose dict' fn =
257+ return $ JSApp x [JSApp y [z]]
258+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isArrCompose dict' fn = do
264 arg <- freshName
259 arg <- freshName
265 return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
260 return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
266 convert other = return other
261 convert other = return other
262+ isArrCompose :: JS -> JS -> Bool
263+ isArrCompose dict' fn = isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn
267
264
268isDict :: (String, String) -> JS -> Bool
265isDict :: (String, String) -> JS -> Bool
269isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
266isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName