@@ -1,28 +1,16 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.Inliner
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
111-- |
122-- This module provides basic inlining capabilities
133--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
17− inlineVariables,
18− inlineValues,
19− inlineOperator,
20− inlineCommonOperators,
21− inlineFnComposition,
22− etaConvert,
23− unThunk,
24− evaluateIifes
25−) where
4+module Language.PureScript.CodeGen.JS.Optimizer.Inliner
5+ ( inlineVariables
6+ , inlineValues
7+ , inlineOperator
8+ , inlineCommonOperators
9+ , inlineFnComposition
10+ , etaConvert
11+ , unThunk
12+ , evaluateIifes
13+ ) where
2614
2715import Prelude ()
2816import Prelude.Compat
@@ -93,26 +81,26 @@ inlineValues :: JS -> JS
9381inlineValues = everywhereOnJS convert
9482 where
9583 convert :: JS -> JS
96− convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
97− | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)
98− | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)
99− | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)
100− | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
101− | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
84+ convert (JSApp fn [dict])
85+ | isDict' (semiringNumber ++ semiringInt) dict && isFn' fnZero fn = JSNumericLiteral (Left 0)
86+ | isDict' (semiringNumber ++ semiringInt) dict && isFn' fnOne fn = JSNumericLiteral (Left 1)
87+ | isDict' boundedBoolean dict && isFn' fnBottom fn = JSBooleanLiteral False
88+ | isDict' boundedBoolean dict && isFn' fnTop fn = JSBooleanLiteral True
10289 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])
103− | isDict semiringInt dict && isFn fnAdd fn = JSBinary BitwiseOr (JSBinary Add x y) (JSNumericLiteral (Left 0))
104− | isDict semiringInt dict && isFn fnMultiply fn = JSBinary BitwiseOr (JSBinary Multiply x y) (JSNumericLiteral (Left 0))
105− | isDict moduloSemiringInt dict && isFn fnDivide fn = JSBinary BitwiseOr (JSBinary Divide x y) (JSNumericLiteral (Left 0))
106− | isDict ringInt dict && isFn fnSubtract fn = JSBinary BitwiseOr (JSBinary Subtract x y) (JSNumericLiteral (Left 0))
90+ | isDict' semiringInt dict && isFn' fnAdd fn = intOp Add x y
91+ | isDict' semiringInt dict && isFn' fnMultiply fn = intOp Multiply x y
92+ | isDict' moduloSemiringInt dict && isFn' fnDivide fn = intOp Divide x y
93+ | isDict' ringInt dict && isFn' fnSubtract fn = intOp Subtract x y
10794 convert other = other
108− fnZero = (C.prelude, C.zero)
109− fnOne = (C.prelude, C.one)
110− fnBottom = (C.prelude, C.bottom)
111− fnTop = (C.prelude, C.top)
112− fnAdd = (C.prelude, (C.+))
113− fnDivide = (C.prelude, (C./))
114− fnMultiply = (C.prelude, (C.*))
115− fnSubtract = (C.prelude, (C.-))
95+ fnZero = [(C.prelude, C.zero), (C.dataSemiring, C.zero)]
96+ fnOne = [(C.prelude, C.one), (C.dataSemiring, C.one)]
97+ fnBottom = [(C.prelude, C.bottom), (C.dataBounded, C.bottom)]
98+ fnTop = [(C.prelude, C.top), (C.dataBounded, C.top)]
99+ fnAdd = [(C.prelude, (C.+)), (C.prelude, (C.add)), (C.dataSemiring, (C.+)), (C.dataSemiring, (C.add))]
100+ fnDivide = [(C.prelude, (C./)), (C.prelude, (C.div)), (C.dataModuloSemiring, C.div)]
101+ fnMultiply = [(C.prelude, (C.*)), (C.prelude, (C.mul)), (C.dataSemiring, (C.*)), (C.dataSemiring, (C.mul))]
102+ fnSubtract = [(C.prelude, (C.-)), (C.prelude, C.sub), (C.dataRing, C.sub)]
103+ intOp op x y = JSBinary BitwiseOr (JSBinary op x y) (JSNumericLiteral (Left 0))
116104
117105inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
118106inlineOperator (m, op) f = everywhereOnJS convert
@@ -126,43 +114,54 @@ inlineOperator (m, op) f = everywhereOnJS convert
126114
127115inlineCommonOperators :: JS -> JS
128116inlineCommonOperators = applyAll $
129− [ binary semiringNumber (C.+) Add
130− , binary semiringNumber (C.*) Multiply
131−
132− , binary ringNumber (C.-) Subtract
133− , unary ringNumber C.negate Negate
134− , binary ringInt (C.-) Subtract
135− , unary ringInt C.negate Negate
136−
137− , binary moduloSemiringNumber (C./) Divide
138− , binary moduloSemiringInt C.mod Modulus
139−
140− , binary eqNumber (C.==) EqualTo
141− , binary eqNumber (C./=) NotEqualTo
142− , binary eqInt (C.==) EqualTo
143− , binary eqInt (C./=) NotEqualTo
144− , binary eqString (C.==) EqualTo
145− , binary eqString (C./=) NotEqualTo
146− , binary eqBoolean (C.==) EqualTo
147− , binary eqBoolean (C./=) NotEqualTo
148−
149− , binary ordNumber (C.<) LessThan
150− , binary ordNumber (C.>) GreaterThan
151− , binary ordNumber (C.<=) LessThanOrEqualTo
152− , binary ordNumber (C.>=) GreaterThanOrEqualTo
153− , binary ordInt (C.<) LessThan
154− , binary ordInt (C.>) GreaterThan
155− , binary ordInt (C.<=) LessThanOrEqualTo
156− , binary ordInt (C.>=) GreaterThanOrEqualTo
157−
158− , binary semigroupString (C.<>) Add
159− , binary semigroupString (C.++) Add
160−
161− , binary booleanAlgebraBoolean (C.&&) And
162− , binary booleanAlgebraBoolean (C.||) Or
163− , binaryFunction booleanAlgebraBoolean C.conj And
164− , binaryFunction booleanAlgebraBoolean C.disj Or
165− , unary booleanAlgebraBoolean C.not Not
117+ [ binary semiringNumber opAdd Add
118+ , binary semiringNumber opMul Multiply
119+
120+ , binary ringNumber opSub Subtract
121+ , unary ringNumber opNegate Negate
122+ , binary ringInt opSub Subtract
123+ , unary ringInt opNegate Negate
124+
125+ , binary moduloSemiringNumber opDiv Divide
126+ , binary moduloSemiringInt opMod Modulus
127+
128+ , binary eqNumber opEq EqualTo
129+ , binary eqNumber opNotEq NotEqualTo
130+ , binary eqInt opEq EqualTo
131+ , binary eqInt opNotEq NotEqualTo
132+ , binary eqString opEq EqualTo
133+ , binary eqString opNotEq NotEqualTo
134+ , binary eqChar opEq EqualTo
135+ , binary eqChar opNotEq NotEqualTo
136+ , binary eqBoolean opEq EqualTo
137+ , binary eqBoolean opNotEq NotEqualTo
138+
139+ , binary ordBoolean opLessThan LessThan
140+ , binary ordBoolean opLessThanOrEq LessThanOrEqualTo
141+ , binary ordBoolean opGreaterThan GreaterThan
142+ , binary ordBoolean opGreaterThanOrEq GreaterThanOrEqualTo
143+ , binary ordChar opLessThan LessThan
144+ , binary ordChar opLessThanOrEq LessThanOrEqualTo
145+ , binary ordChar opGreaterThan GreaterThan
146+ , binary ordChar opGreaterThanOrEq GreaterThanOrEqualTo
147+ , binary ordInt opLessThan LessThan
148+ , binary ordInt opLessThanOrEq LessThanOrEqualTo
149+ , binary ordInt opGreaterThan GreaterThan
150+ , binary ordInt opGreaterThanOrEq GreaterThanOrEqualTo
151+ , binary ordNumber opLessThan LessThan
152+ , binary ordNumber opLessThanOrEq LessThanOrEqualTo
153+ , binary ordNumber opGreaterThan GreaterThan
154+ , binary ordNumber opGreaterThanOrEq GreaterThanOrEqualTo
155+ , binary ordString opLessThan LessThan
156+ , binary ordString opLessThanOrEq LessThanOrEqualTo
157+ , binary ordString opGreaterThan GreaterThan
158+ , binary ordString opGreaterThanOrEq GreaterThanOrEqualTo
159+
160+ , binary semigroupString opAppend Add
161+
162+ , binary booleanAlgebraBoolean opConj And
163+ , binary booleanAlgebraBoolean opDisj Or
164+ , unary booleanAlgebraBoolean opNot Not
166165
167166 , binary' C.dataIntBits (C..|.) BitwiseOr
168167 , binary' C.dataIntBits (C..&.) BitwiseAnd
@@ -174,11 +173,11 @@ inlineCommonOperators = applyAll $
174173 ] ++
175174 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
176175 where
177− binary :: (String, String) -> String -> BinaryOperator -> JS -> JS
178− binary dict opString op = everywhereOnJS convert
176+ binary :: [(String, String)] -> [(String, String)] -> BinaryOperator -> JS -> JS
177+ binary dict fns op = everywhereOnJS convert
179178 where
180179 convert :: JS -> JS
181− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = JSBinary op x y
180+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict' dict dict' && isFn' fns fn = JSBinary op x y
182181 convert other = other
183182 binary' :: String -> String -> BinaryOperator -> JS -> JS
184183 binary' moduleName opString op = everywhereOnJS convert
@@ -186,17 +185,11 @@ inlineCommonOperators = applyAll $
186185 convert :: JS -> JS
187186 convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y
188187 convert other = other
189− binaryFunction :: (String, String) -> String -> BinaryOperator -> JS -> JS
190− binaryFunction dict fnName op = everywhereOnJS convert
191− where
192− convert :: JS -> JS
193− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = JSBinary op x y
194− convert other = other
195− unary :: (String, String) -> String -> UnaryOperator -> JS -> JS
196− unary dict fnName op = everywhereOnJS convert
188+ unary :: [(String, String)] -> [(String, String)] -> UnaryOperator -> JS -> JS
189+ unary dicts fns op = everywhereOnJS convert
197190 where
198191 convert :: JS -> JS
199− convert (JSApp (JSApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = JSUnary op x
192+ convert (JSApp (JSApp fn [dict']) [x]) | isDict' dicts dict' && isFn' fns fn = JSUnary op x
200193 convert other = other
201194 unary' :: String -> String -> UnaryOperator -> JS -> JS
202195 unary' moduleName fnName op = everywhereOnJS convert
@@ -246,71 +239,130 @@ inlineFnComposition :: (Applicative m, MonadSupply m) => JS -> m JS
246239inlineFnComposition = everywhereOnJSTopDownM convert
247240 where
248241 convert :: (MonadSupply m) => JS -> m JS
249− convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isFnCompose dict' fn =
250− return $ JSApp x [JSApp y [z]]
251− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isFnCompose dict' fn = do
252− arg <- freshName
253− return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
242+ convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z])
243+ | isFnCompose dict' fn = return $ JSApp x [JSApp y [z]]
244+ | isFnComposeFlipped dict' fn = return $ JSApp y [JSApp x [z]]
245+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y])
246+ | isFnCompose dict' fn = do
247+ arg <- freshName
248+ return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
249+ | isFnComposeFlipped dict' fn = do
250+ arg <- freshName
251+ return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp y [JSApp x [JSVar arg]]])
254252 convert other = return other
255253 isFnCompose :: JS -> JS -> Bool
256− isFnCompose dict' fn = isDict semigroupoidFn dict' && (isPreludeFn (C.<<<) fn || isPreludeFn C.compose fn)
254+ isFnCompose dict' fn = isDict' semigroupoidFn dict' && isFn' fnCompose fn
255+ isFnComposeFlipped :: JS -> JS -> Bool
256+ isFnComposeFlipped dict' fn = isDict' semigroupoidFn dict' && isFn' fnComposeFlipped fn
257+ fnCompose :: [(String, String)]
258+ fnCompose = [(C.prelude, C.compose), (C.prelude, (C.<<<)), (C.controlSemigroupoid, C.compose)]
259+ fnComposeFlipped :: [(String, String)]
260+ fnComposeFlipped = [(C.prelude, (C.>>>)), (C.controlSemigroupoid, C.composeFlipped)]
261+
262+semiringNumber :: [(String, String)]
263+semiringNumber = [(C.prelude, C.semiringNumber), (C.dataSemiring, C.semiringNumber)]
264+
265+semiringInt :: [(String, String)]
266+semiringInt = [(C.prelude, C.semiringInt), (C.dataSemiring, C.semiringInt)]
267+
268+ringNumber :: [(String, String)]
269+ringNumber = [(C.prelude, C.ringNumber), (C.dataRing, C.ringNumber)]
270+
271+ringInt :: [(String, String)]
272+ringInt = [(C.prelude, C.ringInt), (C.dataRing, C.ringInt)]
273+
274+moduloSemiringNumber :: [(String, String)]
275+moduloSemiringNumber = [(C.prelude, C.moduloSemiringNumber), (C.dataModuloSemiring, C.moduloSemiringNumber)]
276+
277+moduloSemiringInt :: [(String, String)]
278+moduloSemiringInt = [(C.prelude, C.moduloSemiringInt), (C.dataModuloSemiring, C.moduloSemiringInt)]
279+
280+eqNumber :: [(String, String)]
281+eqNumber = [(C.prelude, C.eqNumber), (C.dataEq, C.eqNumber)]
282+
283+eqInt :: [(String, String)]
284+eqInt = [(C.prelude, C.eqInt), (C.dataEq, C.eqInt)]
285+
286+eqString :: [(String, String)]
287+eqString = [(C.prelude, C.eqString), (C.dataEq, C.eqString)]
288+
289+eqChar :: [(String, String)]
290+eqChar = [(C.prelude, C.eqChar), (C.dataEq, C.eqChar)]
291+
292+eqBoolean :: [(String, String)]
293+eqBoolean = [(C.prelude, C.eqBoolean), (C.dataEq, C.eqBoolean)]
294+
295+ordBoolean :: [(String, String)]
296+ordBoolean = [(C.prelude, C.ordBoolean), (C.dataOrd, C.ordBoolean)]
297+
298+ordNumber :: [(String, String)]
299+ordNumber = [(C.prelude, C.ordNumber), (C.dataOrd, C.ordNumber)]
300+
301+ordInt :: [(String, String)]
302+ordInt = [(C.prelude, C.ordInt), (C.dataOrd, C.ordInt)]
303+
304+ordString :: [(String, String)]
305+ordString = [(C.prelude, C.ordString), (C.dataOrd, C.ordString)]
306+
307+ordChar :: [(String, String)]
308+ordChar = [(C.prelude, C.ordChar), (C.dataOrd, C.ordChar)]
309+
310+semigroupString :: [(String, String)]
311+semigroupString = [(C.prelude, C.semigroupString), (C.dataSemigroup, C.semigroupString)]
257312
258−isDict :: (String, String) -> JS -> Bool
259−isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
260−isDict _ _ = False
313+boundedBoolean :: [(String, String)]
314+boundedBoolean = [(C.prelude, C.boundedBoolean), (C.dataBounded, C.boundedBoolean)]
261315
262−isFn :: (String, String) -> JS -> Bool
263−isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName
264−isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName
265−isFn _ _ = False
316+booleanAlgebraBoolean :: [(String, String)]
317+booleanAlgebraBoolean = [(C.prelude, C.booleanAlgebraBoolean), (C.dataBooleanAlgebra, C.booleanAlgebraBoolean)]
266318
267−isPreludeFn :: String -> JS -> Bool
268−isPreludeFn fnName = isFn (C.prelude, fnName)
319+semigroupoidFn :: [(String, String)]
320+semigroupoidFn = [(C.prelude, C.semigroupoidFn), (C.controlSemigroupoid, C.semigroupoidFn)]
269321
270−semiringNumber :: (String, String)
271−semiringNumber = (C.prelude, C.semiringNumber)
322+opAdd :: [(String, String)]
323+opAdd = [(C.prelude, (C.+)), (C.prelude, C.add), (C.dataSemiring, C.add)]
272324
273−semiringInt :: (String, String)
274−semiringInt = (C.prelude, C.semiringInt)
325+opMul :: [(String, String)]
326+opMul = [(C.prelude, (C.*)), (C.prelude, C.mul), (C.dataSemiring, C.mul)]
275327
276−ringNumber :: (String, String)
277−ringNumber = (C.prelude, C.ringNumber)
328+opEq :: [(String, String)]
329+opEq = [(C.prelude, (C.==)), (C.prelude, C.eq), (C.dataEq, C.eq)]
278330
279−ringInt :: (String, String)
280−ringInt = (C.prelude, C.ringInt)
331+opNotEq :: [(String, String)]
332+opNotEq = [(C.prelude, (C./=)), (C.dataEq, C.notEq)]
281333
282−moduloSemiringNumber :: (String, String)
283−moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
334+opLessThan :: [(String, String)]
335+opLessThan = [(C.prelude, (C.<)), (C.dataOrd, C.lessThan)]
284336
285−moduloSemiringInt :: (String, String)
286−moduloSemiringInt = (C.prelude, C.moduloSemiringInt)
337+opLessThanOrEq :: [(String, String)]
338+opLessThanOrEq = [(C.prelude, (C.<=)), (C.dataOrd, C.lessThanOrEq)]
287339
288−eqNumber :: (String, String)
289−eqNumber = (C.prelude, C.eqNumber)
340+opGreaterThan :: [(String, String)]
341+opGreaterThan = [(C.prelude, (C.>)), (C.dataOrd, C.greaterThan)]
290342
291−eqInt :: (String, String)
292−eqInt = (C.prelude, C.eqInt)
343+opGreaterThanOrEq :: [(String, String)]
344+opGreaterThanOrEq = [(C.prelude, (C.>=)), (C.dataOrd, C.greaterThanOrEq)]
293345
294−eqString :: (String, String)
295−eqString = (C.prelude, C.eqNumber)
346+opAppend :: [(String, String)]
347+opAppend = [(C.prelude, (C.<>)), (C.prelude, (C.++)), (C.prelude, C.append), (C.dataSemigroup, C.append)]
296348
297−eqBoolean :: (String, String)
298−eqBoolean = (C.prelude, C.eqNumber)
349+opSub :: [(String, String)]
350+opSub = [(C.prelude, (C.-)), (C.prelude, C.sub), (C.dataRing, C.sub)]
299351
300−ordNumber :: (String, String)
301−ordNumber = (C.prelude, C.ordNumber)
352+opNegate :: [(String, String)]
353+opNegate = [(C.prelude, C.negate), (C.dataRing, C.negate)]
302354
303−ordInt :: (String, String)
304−ordInt = (C.prelude, C.ordInt)
355+opDiv :: [(String, String)]
356+opDiv = [(C.prelude, (C./)), (C.prelude, C.div), (C.dataModuloSemiring, C.div)]
305357
306−semigroupString :: (String, String)
307−semigroupString = (C.prelude, C.semigroupString)
358+opMod :: [(String, String)]
359+opMod = [(C.prelude, C.mod), (C.dataModuloSemiring, C.mod)]
308360
309−boundedBoolean :: (String, String)
310−boundedBoolean = (C.prelude, C.boundedBoolean)
361+opConj :: [(String, String)]
362+opConj = [(C.prelude, (C.&&)), (C.prelude, C.conj), (C.dataBooleanAlgebra, C.conj)]
311363
312−booleanAlgebraBoolean :: (String, String)
313−booleanAlgebraBoolean = (C.prelude, C.booleanAlgebraBoolean)
364+opDisj :: [(String, String)]
365+opDisj = [(C.prelude, (C.||)), (C.prelude, C.disj), (C.dataBooleanAlgebra, C.disj)]
314366
315−semigroupoidFn :: (String, String)
316−semigroupoidFn = (C.prelude, C.semigroupoidFn)
367+opNot :: [(String, String)]
368+opNot = [(C.prelude, C.not), (C.dataBooleanAlgebra, C.not)]