git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Add inlining of semigroupoidArr composition
82a1f79Brian McKenna
src/Language/PureScript/CodeGen/JS/Optimizer.hs+4−3
compare with golang
unifiedsplit
@@ -38,6 +38,7 @@ module Language.PureScript.CodeGen.JS.Optimizer (
38) where
38) where
39
39
40import Control.Monad.Reader (MonadReader, ask, asks)
40import Control.Monad.Reader (MonadReader, ask, asks)
41+import Control.Monad.Supply.Class (MonadSupply)
41
42
42import Language.PureScript.CodeGen.JS.AST
43import Language.PureScript.CodeGen.JS.AST
43import Language.PureScript.Options
44import Language.PureScript.Options
@@ -53,15 +54,15 @@ import Language.PureScript.CodeGen.JS.Optimizer.Blocks
53-- |
54-- |
54-- Apply a series of optimizer passes to simplified Javascript code
55-- Apply a series of optimizer passes to simplified Javascript code
55--
56--
56−optimize :: (Monad m, MonadReader (Options mode) m) => JS -> m JS
57+optimize :: (Monad m, MonadReader (Options mode) m, MonadSupply m) => JS -> m JS
57optimize js = do
58optimize js = do
58 noOpt <- asks optionsNoOptimizations
59 noOpt <- asks optionsNoOptimizations
59 if noOpt then return js else optimize' js
60 if noOpt then return js else optimize' js
60
61
61−optimize' :: (Monad m, MonadReader (Options mode) m) => JS -> m JS
62+optimize' :: (Monad m, MonadReader (Options mode) m, MonadSupply m) => JS -> m JS
62optimize' js = do
63optimize' js = do
63 opts <- ask
64 opts <- ask
64− untilFixedPoint (return . applyAll
65+ untilFixedPoint (inlineArrComposition . applyAll
65 [ collapseNestedBlocks
66 [ collapseNestedBlocks
66 , collapseNestedIfs
67 , collapseNestedIfs
67 , tco opts
68 , tco opts
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+11
@@ -20,11 +20,13 @@ module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
20 inlineCommonOperators,
20 inlineCommonOperators,
21 inlineAppliedArrComposition,
21 inlineAppliedArrComposition,
22 inlineAppliedVars,
22 inlineAppliedVars,
23+ inlineArrComposition,
23 etaConvert,
24 etaConvert,
24 unThunk,
25 unThunk,
25 evaluateIifes
26 evaluateIifes
26) where
27) where
27
28
29+import Control.Monad.Supply.Class (MonadSupply, freshName)
28import Data.Maybe (fromMaybe)
30import Data.Maybe (fromMaybe)
29
31
30import Language.PureScript.CodeGen.JS.AST
32import Language.PureScript.CodeGen.JS.AST
@@ -254,6 +256,15 @@ inlineAppliedVars = everywhereOnJS convert
254 convert (JSApp (JSFunction Nothing [a] (JSBlock [JSReturn b])) [JSVar x]) = replaceIdent a (JSVar x) b
256 convert (JSApp (JSFunction Nothing [a] (JSBlock [JSReturn b])) [JSVar x]) = replaceIdent a (JSVar x) b
255 convert other = other
257 convert other = other
256
258
259+inlineArrComposition :: (MonadSupply m) => JS -> m JS
260+inlineArrComposition js = everywhereOnJSTopDownM convert js
261+ where
262+ convert :: (MonadSupply m) => JS -> m JS
263+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn = do
264+ arg <- freshName
265+ return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
266+ convert other = return other
267+
257isDict :: (String, String) -> JS -> Bool
268isDict :: (String, String) -> JS -> Bool
258isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
269isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
259isDict _ _ = False
270isDict _ _ = False