git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Updates & fixes for JS inliner
d866f68Gary Burgess
src/Language/PureScript/CodeGen/JS/Optimizer.hs+5−17
compare with golang
unifiedsplit
@@ -1,13 +1,5 @@
1−-----------------------------------------------------------------------------
1+{-# LANGUAGE FlexibleContexts #-}
2−--
2+
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11-- |
3-- |
12-- This module optimizes code in the simplified-Javascript intermediate representation.
4-- This module optimizes code in the simplified-Javascript intermediate representation.
13--
5--
@@ -29,13 +21,7 @@
29--
21--
30-- * Inlining primitive Javascript operators
22-- * Inlining primitive Javascript operators
31--
23--
32−-----------------------------------------------------------------------------
33−
34−{-# LANGUAGE FlexibleContexts #-}
35−
36−module Language.PureScript.CodeGen.JS.Optimizer (
24+module Language.PureScript.CodeGen.JS.Optimizer (optimize) where
37− optimize
38−) where
39
25
40import Prelude ()
26import Prelude ()
41import Prelude.Compat
27import Prelude.Compat
@@ -79,7 +65,9 @@ optimize' js = do
79 , inlineVariables
65 , inlineVariables
80 , inlineValues
66 , inlineValues
81 , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
67 , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
68+ , inlineOperator (C.dataFunction, C.apply) $ \f x -> JSApp f [x]
82 , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
69 , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
70+ , inlineOperator (C.dataFunction, C.applyFlipped) $ \x f -> JSApp f [x]
83 , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip JSIndexer
71 , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip JSIndexer
84 , inlineCommonOperators ]) js
72 , inlineCommonOperators ]) js
85
73
src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs+15−12
@@ -1,18 +1,6 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.Common
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11-- |
1-- |
12-- Common functions used by the various optimizer phases
2-- Common functions used by the various optimizer phases
13--
3--
14−-----------------------------------------------------------------------------
15−
16module Language.PureScript.CodeGen.JS.Optimizer.Common where
4module Language.PureScript.CodeGen.JS.Optimizer.Common where
17
5
18import Data.Maybe (fromMaybe)
6import Data.Maybe (fromMaybe)
@@ -76,3 +64,18 @@ isUpdated var1 = everythingOnJS (||) check
76removeFromBlock :: ([JS] -> [JS]) -> JS -> JS
64removeFromBlock :: ([JS] -> [JS]) -> JS -> JS
77removeFromBlock go (JSBlock sts) = JSBlock (go sts)
65removeFromBlock go (JSBlock sts) = JSBlock (go sts)
78removeFromBlock _ js = js
66removeFromBlock _ js = js
67+
68+isFn :: (String, String) -> JS -> Bool
69+isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName
70+isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName
71+isFn _ _ = False
72+
73+isFn' :: [(String, String)] -> JS -> Bool
74+isFn' xs js = any (`isFn` js) xs
75+
76+isDict :: (String, String) -> JS -> Bool
77+isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
78+isDict _ _ = False
79+
80+isDict' :: [(String, String)] -> JS -> Bool
81+isDict' xs js = any (`isDict` js) xs
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+188−136
@@ -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−--
11-- |
1-- |
12-- This module provides basic inlining capabilities
2-- This module provides basic inlining capabilities
13--
3--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
4+module Language.PureScript.CodeGen.JS.Optimizer.Inliner
17− inlineVariables,
5+ ( inlineVariables
18− inlineValues,
6+ , inlineValues
19− inlineOperator,
7+ , inlineOperator
20− inlineCommonOperators,
8+ , inlineCommonOperators
21− inlineFnComposition,
9+ , inlineFnComposition
22− etaConvert,
10+ , etaConvert
23− unThunk,
11+ , unThunk
24− evaluateIifes
12+ , evaluateIifes
25−) where
13+ ) where
26
14
27import Prelude ()
15import Prelude ()
28import Prelude.Compat
16import Prelude.Compat
@@ -93,26 +81,26 @@ inlineValues :: JS -> JS
93inlineValues = everywhereOnJS convert
81inlineValues = everywhereOnJS convert
94 where
82 where
95 convert :: JS -> JS
83 convert :: JS -> JS
96− convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
84+ convert (JSApp fn [dict])
97− | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)
98− | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)
85+ | isDict' (semiringNumber ++ semiringInt) dict && isFn' fnZero fn = JSNumericLiteral (Left 0)
99− | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)
86+ | isDict' (semiringNumber ++ semiringInt) dict && isFn' fnOne fn = JSNumericLiteral (Left 1)
100− | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
87+ | isDict' boundedBoolean dict && isFn' fnBottom fn = JSBooleanLiteral False
101− | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
88+ | isDict' boundedBoolean dict && isFn' fnTop fn = JSBooleanLiteral True
102 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])
89 convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])
103− | isDict semiringInt dict && isFn fnAdd fn = JSBinary BitwiseOr (JSBinary Add x y) (JSNumericLiteral (Left 0))
90+ | isDict' semiringInt dict && isFn' fnAdd fn = intOp Add x y
104− | isDict semiringInt dict && isFn fnMultiply fn = JSBinary BitwiseOr (JSBinary Multiply x y) (JSNumericLiteral (Left 0))
91+ | isDict' semiringInt dict && isFn' fnMultiply fn = intOp Multiply x y
105− | isDict moduloSemiringInt dict && isFn fnDivide fn = JSBinary BitwiseOr (JSBinary Divide x y) (JSNumericLiteral (Left 0))
92+ | isDict' moduloSemiringInt dict && isFn' fnDivide fn = intOp Divide x y
106− | isDict ringInt dict && isFn fnSubtract fn = JSBinary BitwiseOr (JSBinary Subtract x y) (JSNumericLiteral (Left 0))
93+ | isDict' ringInt dict && isFn' fnSubtract fn = intOp Subtract x y
107 convert other = other
94 convert other = other
108− fnZero = (C.prelude, C.zero)
95+ fnZero = [(C.prelude, C.zero), (C.dataSemiring, C.zero)]
109− fnOne = (C.prelude, C.one)
96+ fnOne = [(C.prelude, C.one), (C.dataSemiring, C.one)]
110− fnBottom = (C.prelude, C.bottom)
97+ fnBottom = [(C.prelude, C.bottom), (C.dataBounded, C.bottom)]
111− fnTop = (C.prelude, C.top)
98+ fnTop = [(C.prelude, C.top), (C.dataBounded, C.top)]
112− fnAdd = (C.prelude, (C.+))
99+ fnAdd = [(C.prelude, (C.+)), (C.prelude, (C.add)), (C.dataSemiring, (C.+)), (C.dataSemiring, (C.add))]
113− fnDivide = (C.prelude, (C./))
100+ fnDivide = [(C.prelude, (C./)), (C.prelude, (C.div)), (C.dataModuloSemiring, C.div)]
114− fnMultiply = (C.prelude, (C.*))
101+ fnMultiply = [(C.prelude, (C.*)), (C.prelude, (C.mul)), (C.dataSemiring, (C.*)), (C.dataSemiring, (C.mul))]
115− fnSubtract = (C.prelude, (C.-))
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))
116
104
117inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
105inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
118inlineOperator (m, op) f = everywhereOnJS convert
106inlineOperator (m, op) f = everywhereOnJS convert
@@ -126,43 +114,54 @@ inlineOperator (m, op) f = everywhereOnJS convert
126
114
127inlineCommonOperators :: JS -> JS
115inlineCommonOperators :: JS -> JS
128inlineCommonOperators = applyAll $
116inlineCommonOperators = applyAll $
129− [ binary semiringNumber (C.+) Add
117+ [ binary semiringNumber opAdd Add
130− , binary semiringNumber (C.*) Multiply
118+ , binary semiringNumber opMul Multiply
131−
119+
132− , binary ringNumber (C.-) Subtract
120+ , binary ringNumber opSub Subtract
133− , unary ringNumber C.negate Negate
121+ , unary ringNumber opNegate Negate
134− , binary ringInt (C.-) Subtract
122+ , binary ringInt opSub Subtract
135− , unary ringInt C.negate Negate
123+ , unary ringInt opNegate Negate
136−
124+
137− , binary moduloSemiringNumber (C./) Divide
125+ , binary moduloSemiringNumber opDiv Divide
138− , binary moduloSemiringInt C.mod Modulus
126+ , binary moduloSemiringInt opMod Modulus
139−
127+
140− , binary eqNumber (C.==) EqualTo
128+ , binary eqNumber opEq EqualTo
141− , binary eqNumber (C./=) NotEqualTo
129+ , binary eqNumber opNotEq NotEqualTo
142− , binary eqInt (C.==) EqualTo
130+ , binary eqInt opEq EqualTo
143− , binary eqInt (C./=) NotEqualTo
131+ , binary eqInt opNotEq NotEqualTo
144− , binary eqString (C.==) EqualTo
132+ , binary eqString opEq EqualTo
145− , binary eqString (C./=) NotEqualTo
133+ , binary eqString opNotEq NotEqualTo
134+ , binary eqChar opEq EqualTo
135+ , binary eqChar opNotEq NotEqualTo
146− , binary eqBoolean (C.==) EqualTo
136+ , binary eqBoolean opEq EqualTo
147− , binary eqBoolean (C./=) NotEqualTo
137+ , binary eqBoolean opNotEq NotEqualTo
148−
138+
149− , binary ordNumber (C.<) LessThan
139+ , binary ordBoolean opLessThan LessThan
150− , binary ordNumber (C.>) GreaterThan
140+ , binary ordBoolean opLessThanOrEq LessThanOrEqualTo
141+ , binary ordBoolean opGreaterThan GreaterThan
142+ , binary ordBoolean opGreaterThanOrEq GreaterThanOrEqualTo
143+ , binary ordChar opLessThan LessThan
151− , binary ordNumber (C.<=) LessThanOrEqualTo
144+ , binary ordChar opLessThanOrEq LessThanOrEqualTo
145+ , binary ordChar opGreaterThan GreaterThan
152− , binary ordNumber (C.>=) GreaterThanOrEqualTo
146+ , binary ordChar opGreaterThanOrEq GreaterThanOrEqualTo
153− , binary ordInt (C.<) LessThan
147+ , binary ordInt opLessThan LessThan
154− , binary ordInt (C.>) GreaterThan
148+ , binary ordInt opLessThanOrEq LessThanOrEqualTo
155− , binary ordInt (C.<=) LessThanOrEqualTo
149+ , binary ordInt opGreaterThan GreaterThan
156− , binary ordInt (C.>=) GreaterThanOrEqualTo
150+ , binary ordInt opGreaterThanOrEq GreaterThanOrEqualTo
157−
151+ , binary ordNumber opLessThan LessThan
158− , binary semigroupString (C.<>) Add
152+ , binary ordNumber opLessThanOrEq LessThanOrEqualTo
159− , binary semigroupString (C.++) Add
153+ , binary ordNumber opGreaterThan GreaterThan
160−
154+ , binary ordNumber opGreaterThanOrEq GreaterThanOrEqualTo
161− , binary booleanAlgebraBoolean (C.&&) And
155+ , binary ordString opLessThan LessThan
162− , binary booleanAlgebraBoolean (C.||) Or
156+ , binary ordString opLessThanOrEq LessThanOrEqualTo
157+ , binary ordString opGreaterThan GreaterThan
158+ , binary ordString opGreaterThanOrEq GreaterThanOrEqualTo
159+
160+ , binary semigroupString opAppend Add
161+
163− , binaryFunction booleanAlgebraBoolean C.conj And
162+ , binary booleanAlgebraBoolean opConj And
164− , binaryFunction booleanAlgebraBoolean C.disj Or
163+ , binary booleanAlgebraBoolean opDisj Or
165− , unary booleanAlgebraBoolean C.not Not
164+ , unary booleanAlgebraBoolean opNot Not
166
165
167 , binary' C.dataIntBits (C..|.) BitwiseOr
166 , binary' C.dataIntBits (C..|.) BitwiseOr
168 , binary' C.dataIntBits (C..&.) BitwiseAnd
167 , binary' C.dataIntBits (C..&.) BitwiseAnd
@@ -174,11 +173,11 @@ inlineCommonOperators = applyAll $
174 ] ++
173 ] ++
175 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
174 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
176 where
175 where
177− binary :: (String, String) -> String -> BinaryOperator -> JS -> JS
176+ binary :: [(String, String)] -> [(String, String)] -> BinaryOperator -> JS -> JS
178− binary dict opString op = everywhereOnJS convert
177+ binary dict fns op = everywhereOnJS convert
179 where
178 where
180 convert :: JS -> JS
179 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
182 convert other = other
181 convert other = other
183 binary' :: String -> String -> BinaryOperator -> JS -> JS
182 binary' :: String -> String -> BinaryOperator -> JS -> JS
184 binary' moduleName opString op = everywhereOnJS convert
183 binary' moduleName opString op = everywhereOnJS convert
@@ -186,17 +185,11 @@ inlineCommonOperators = applyAll $
186 convert :: JS -> JS
185 convert :: JS -> JS
187 convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y
186 convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y
188 convert other = other
187 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
188+ unary :: [(String, String)] -> [(String, String)] -> UnaryOperator -> JS -> JS
196− unary dict fnName op = everywhereOnJS convert
189+ unary dicts fns op = everywhereOnJS convert
197 where
190 where
198 convert :: JS -> JS
191 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
200 convert other = other
193 convert other = other
201 unary' :: String -> String -> UnaryOperator -> JS -> JS
194 unary' :: String -> String -> UnaryOperator -> JS -> JS
202 unary' moduleName fnName op = everywhereOnJS convert
195 unary' moduleName fnName op = everywhereOnJS convert
@@ -246,71 +239,130 @@ inlineFnComposition :: (Applicative m, MonadSupply m) => JS -> m JS
246inlineFnComposition = everywhereOnJSTopDownM convert
239inlineFnComposition = everywhereOnJSTopDownM convert
247 where
240 where
248 convert :: (MonadSupply m) => JS -> m JS
241 convert :: (MonadSupply m) => JS -> m JS
249− convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isFnCompose dict' fn =
242+ convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z])
243+ | isFnCompose dict' fn = return $ JSApp x [JSApp y [z]]
250− return $ JSApp x [JSApp y [z]]
244+ | isFnComposeFlipped dict' fn = return $ JSApp y [JSApp x [z]]
251− convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isFnCompose dict' fn = do
245+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y])
246+ | isFnCompose dict' fn = do
252− arg <- freshName
247+ arg <- freshName
253− return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
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]]])
254 convert other = return other
252 convert other = return other
255 isFnCompose :: JS -> JS -> Bool
253 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)]
257
312
258−isDict :: (String, String) -> JS -> Bool
313+boundedBoolean :: [(String, String)]
259−isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
314+boundedBoolean = [(C.prelude, C.boundedBoolean), (C.dataBounded, C.boundedBoolean)]
260−isDict _ _ = False
261
315
262−isFn :: (String, String) -> JS -> Bool
316+booleanAlgebraBoolean :: [(String, String)]
263−isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName
317+booleanAlgebraBoolean = [(C.prelude, C.booleanAlgebraBoolean), (C.dataBooleanAlgebra, C.booleanAlgebraBoolean)]
264−isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName
265−isFn _ _ = False
266
318
267−isPreludeFn :: String -> JS -> Bool
319+semigroupoidFn :: [(String, String)]
268−isPreludeFn fnName = isFn (C.prelude, fnName)
320+semigroupoidFn = [(C.prelude, C.semigroupoidFn), (C.controlSemigroupoid, C.semigroupoidFn)]
269
321
270−semiringNumber :: (String, String)
322+opAdd :: [(String, String)]
271−semiringNumber = (C.prelude, C.semiringNumber)
323+opAdd = [(C.prelude, (C.+)), (C.prelude, C.add), (C.dataSemiring, C.add)]
272
324
273−semiringInt :: (String, String)
325+opMul :: [(String, String)]
274−semiringInt = (C.prelude, C.semiringInt)
326+opMul = [(C.prelude, (C.*)), (C.prelude, C.mul), (C.dataSemiring, C.mul)]
275
327
276−ringNumber :: (String, String)
328+opEq :: [(String, String)]
277−ringNumber = (C.prelude, C.ringNumber)
329+opEq = [(C.prelude, (C.==)), (C.prelude, C.eq), (C.dataEq, C.eq)]
278
330
279−ringInt :: (String, String)
331+opNotEq :: [(String, String)]
280−ringInt = (C.prelude, C.ringInt)
332+opNotEq = [(C.prelude, (C./=)), (C.dataEq, C.notEq)]
281
333
282−moduloSemiringNumber :: (String, String)
334+opLessThan :: [(String, String)]
283−moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
335+opLessThan = [(C.prelude, (C.<)), (C.dataOrd, C.lessThan)]
284
336
285−moduloSemiringInt :: (String, String)
337+opLessThanOrEq :: [(String, String)]
286−moduloSemiringInt = (C.prelude, C.moduloSemiringInt)
338+opLessThanOrEq = [(C.prelude, (C.<=)), (C.dataOrd, C.lessThanOrEq)]
287
339
288−eqNumber :: (String, String)
340+opGreaterThan :: [(String, String)]
289−eqNumber = (C.prelude, C.eqNumber)
341+opGreaterThan = [(C.prelude, (C.>)), (C.dataOrd, C.greaterThan)]
290
342
291−eqInt :: (String, String)
343+opGreaterThanOrEq :: [(String, String)]
292−eqInt = (C.prelude, C.eqInt)
344+opGreaterThanOrEq = [(C.prelude, (C.>=)), (C.dataOrd, C.greaterThanOrEq)]
293
345
294−eqString :: (String, String)
346+opAppend :: [(String, String)]
295−eqString = (C.prelude, C.eqNumber)
347+opAppend = [(C.prelude, (C.<>)), (C.prelude, (C.++)), (C.prelude, C.append), (C.dataSemigroup, C.append)]
296
348
297−eqBoolean :: (String, String)
349+opSub :: [(String, String)]
298−eqBoolean = (C.prelude, C.eqNumber)
350+opSub = [(C.prelude, (C.-)), (C.prelude, C.sub), (C.dataRing, C.sub)]
299
351
300−ordNumber :: (String, String)
352+opNegate :: [(String, String)]
301−ordNumber = (C.prelude, C.ordNumber)
353+opNegate = [(C.prelude, C.negate), (C.dataRing, C.negate)]
302
354
303−ordInt :: (String, String)
355+opDiv :: [(String, String)]
304−ordInt = (C.prelude, C.ordInt)
356+opDiv = [(C.prelude, (C./)), (C.prelude, C.div), (C.dataModuloSemiring, C.div)]
305
357
306−semigroupString :: (String, String)
358+opMod :: [(String, String)]
307−semigroupString = (C.prelude, C.semigroupString)
359+opMod = [(C.prelude, C.mod), (C.dataModuloSemiring, C.mod)]
308
360
309−boundedBoolean :: (String, String)
361+opConj :: [(String, String)]
310−boundedBoolean = (C.prelude, C.boundedBoolean)
362+opConj = [(C.prelude, (C.&&)), (C.prelude, C.conj), (C.dataBooleanAlgebra, C.conj)]
311
363
312−booleanAlgebraBoolean :: (String, String)
364+opDisj :: [(String, String)]
313−booleanAlgebraBoolean = (C.prelude, C.booleanAlgebraBoolean)
365+opDisj = [(C.prelude, (C.||)), (C.prelude, C.disj), (C.dataBooleanAlgebra, C.disj)]
314
366
315−semigroupoidFn :: (String, String)
367+opNot :: [(String, String)]
316−semigroupoidFn = (C.prelude, C.semigroupoidFn)
368+opNot = [(C.prelude, C.not), (C.dataBooleanAlgebra, C.not)]
src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs+11−42
@@ -1,29 +1,14 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.JS.Optimizer.MagicDo
4−-- Copyright : (c) Phil Freeman 2013-14
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11-- |
1-- |
12-- This module implements the "Magic Do" optimization, which inlines calls to return
2-- This module implements the "Magic Do" optimization, which inlines calls to return
13-- and bind for the Eff monad, as well as some of its actions.
3-- and bind for the Eff monad, as well as some of its actions.
14--
4--
15−-----------------------------------------------------------------------------
16−
17−module Language.PureScript.CodeGen.JS.Optimizer.MagicDo (
5+module Language.PureScript.CodeGen.JS.Optimizer.MagicDo (magicDo) where
18− magicDo
19−) where
20
6
21import Data.List (nub)
7import Data.List (nub)
22import Data.Maybe (fromJust, isJust)
8import Data.Maybe (fromJust, isJust)
23
9
24import Language.PureScript.CodeGen.JS.AST
10import Language.PureScript.CodeGen.JS.AST
25−import Language.PureScript.CodeGen.JS.Common
11+import Language.PureScript.CodeGen.JS.Optimizer.Common
26−import Language.PureScript.Names
27import Language.PureScript.Options
12import Language.PureScript.Options
28import qualified Language.PureScript.Constants as C
13import qualified Language.PureScript.Constants as C
29
14
@@ -54,9 +39,7 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
54 fnName = "__do"
39 fnName = "__do"
55 -- Desugar monomorphic calls to >>= and return for the Eff monad
40 -- Desugar monomorphic calls to >>= and return for the Eff monad
56 convert :: JS -> JS
41 convert :: JS -> JS
57− -- Desugar return
42+ -- Desugar pure & return
58− convert (JSApp (JSApp ret [val]) []) | isReturn ret = val
59− -- Desugar pure
60 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
43 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
61 -- Desugar >>
44 -- Desugar >>
62 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind =
45 convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind =
@@ -72,33 +55,19 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
72 JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn $ JSObjectLiteral []])) []
55 JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn $ JSObjectLiteral []])) []
73 convert other = other
56 convert other = other
74 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
57 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
75− isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True
58+ isBind (JSApp fn [dict]) | isDict (C.eff, C.bindEffDictionary) dict && isBindPoly fn = True
76 isBind _ = False
59 isBind _ = False
77− -- Check if an expression represents a monomorphic call to return for the Eff monad
60+ -- Check if an expression represents a monomorphic call to pure or return for the Eff applicative
78− isReturn (JSApp retPoly [effDict]) | isRetPoly retPoly && isEffDict C.monadEffDictionary effDict = True
79− isReturn _ = False
80− -- Check if an expression represents a monomorphic call to pure for the Eff applicative
81− isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
61+ isPure (JSApp fn [dict]) | isDict (C.eff, C.applicativeEffDictionary) dict && isPurePoly fn = True
82 isPure _ = False
62 isPure _ = False
83 -- Check if an expression represents the polymorphic >>= function
63 -- Check if an expression represents the polymorphic >>= function
84− isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && (prop `elem` map identToJs [Ident C.bind, Op (C.>>=)])
64+ isBindPoly = isFn' [(C.prelude, C.bind), (C.prelude, (C.>>=)), (C.controlBind, C.bind)]
85− isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && (bind `elem` [C.bind, (C.>>=)])
86− isBindPoly _ = False
87− -- Check if an expression represents the polymorphic return function
65+ -- Check if an expression represents the polymorphic pure or return function
88− isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
66+ isPurePoly = isFn' [(C.prelude, C.pure'), (C.prelude, C.return), (C.controlApplicative, C.pure')]
89− isRetPoly (JSIndexer (JSStringLiteral return') (JSVar prelude)) = prelude == C.prelude && return' == C.return
90− isRetPoly _ = False
91− -- Check if an expression represents the polymorphic pure function
92− isPurePoly (JSAccessor pure' (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
93− isPurePoly (JSIndexer (JSStringLiteral pure') (JSVar prelude)) = prelude == C.prelude && pure' == C.pure'
94− isPurePoly _ = False
95− -- Check if an expression represents a function in the Ef module
67+ -- Check if an expression represents a function in the Eff module
96 isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
68 isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
97 isEffFunc _ _ = False
69 isEffFunc _ _ = False
98− -- Check if an expression represents the Monad Eff dictionary
70+
99− isEffDict name (JSVar ident) | ident == name = True
100− isEffDict name (JSAccessor prop (JSVar eff)) = eff == C.eff && prop == name
101− isEffDict _ _ = False
102 -- Remove __do function applications which remain after desugaring
71 -- Remove __do function applications which remain after desugaring
103 undo :: JS -> JS
72 undo :: JS -> JS
104 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
73 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
src/Language/PureScript/Constants.hs+101−23
@@ -1,18 +1,6 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Constants
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11-- |
1-- |
12-- Various constants which refer to things in the Prelude
2-- Various constants which refer to things in the Prelude
13--
3--
14−-----------------------------------------------------------------------------
15−
16module Language.PureScript.Constants where
4module Language.PureScript.Constants where
17
5
18-- Operators
6-- Operators
@@ -20,59 +8,107 @@ module Language.PureScript.Constants where
20($) :: String
8($) :: String
21($) = "$"
9($) = "$"
22
10
11+apply :: String
12+apply = "apply"
13+
23(#) :: String
14(#) :: String
24(#) = "#"
15(#) = "#"
25
16
17+applyFlipped :: String
18+applyFlipped = "applyFlipped"
19+
26(<>) :: String
20(<>) :: String
27(<>) = "<>"
21(<>) = "<>"
28
22
29(++) :: String
23(++) :: String
30(++) = "++"
24(++) = "++"
31
25
26+append :: String
27+append = "append"
28+
32(>>=) :: String
29(>>=) :: String
33(>>=) = ">>="
30(>>=) = ">>="
34
31
32+bind :: String
33+bind = "bind"
34+
35(+) :: String
35(+) :: String
36(+) = "+"
36(+) = "+"
37
37
38+add :: String
39+add = "add"
40+
38(-) :: String
41(-) :: String
39(-) = "-"
42(-) = "-"
40
43
44+sub :: String
45+sub = "sub"
46+
41(*) :: String
47(*) :: String
42(*) = "*"
48(*) = "*"
43
49
50+mul :: String
51+mul = "mul"
52+
44(/) :: String
53(/) :: String
45(/) = "/"
54(/) = "/"
46
55
56+div :: String
57+div = "div"
58+
47(%) :: String
59(%) :: String
48(%) = "%"
60(%) = "%"
49
61
62+mod :: String
63+mod = "mod"
64+
50(<) :: String
65(<) :: String
51(<) = "<"
66(<) = "<"
52
67
68+lessThan :: String
69+lessThan = "lessThan"
70+
53(>) :: String
71(>) :: String
54(>) = ">"
72(>) = ">"
55
73
74+greaterThan :: String
75+greaterThan = "greaterThan"
76+
56(<=) :: String
77(<=) :: String
57(<=) = "<="
78(<=) = "<="
58
79
80+lessThanOrEq :: String
81+lessThanOrEq = "lessThanOrEq"
82+
59(>=) :: String
83(>=) :: String
60(>=) = ">="
84(>=) = ">="
61
85
86+greaterThanOrEq :: String
87+greaterThanOrEq = "greaterThanOrEq"
88+
62(==) :: String
89(==) :: String
63(==) = "=="
90(==) = "=="
64
91
92+eq :: String
93+eq = "eq"
94+
65(/=) :: String
95(/=) :: String
66(/=) = "/="
96(/=) = "/="
67
97
98+notEq :: String
99+notEq = "notEq"
100+
68(&&) :: String
101(&&) :: String
69(&&) = "&&"
102(&&) = "&&"
70
103
104+conj :: String
105+conj = "conj"
106+
71(||) :: String
107(||) :: String
72(||) = "||"
108(||) = "||"
73
109
74−bind :: String
110+disj :: String
75−bind = "bind"
111+disj = "disj"
76
112
77unsafeIndex :: String
113unsafeIndex :: String
78unsafeIndex = "unsafeIndex"
114unsafeIndex = "unsafeIndex"
@@ -92,6 +128,12 @@ unsafeIndex = "unsafeIndex"
92compose :: String
128compose :: String
93compose = "compose"
129compose = "compose"
94
130
131+(>>>) :: String
132+(>>>) = ">>>"
133+
134+composeFlipped :: String
135+composeFlipped = "composeFlipped"
136+
95-- Functions
137-- Functions
96
138
97negate :: String
139negate :: String
@@ -100,15 +142,6 @@ negate = "negate"
100not :: String
142not :: String
101not = "not"
143not = "not"
102
144
103−conj :: String
104−conj = "conj"
105−
106−disj :: String
107−disj = "disj"
108−
109−mod :: String
110−mod = "mod"
111−
112shl :: String
145shl :: String
113shl = "shl"
146shl = "shl"
114
147
@@ -211,12 +244,21 @@ moduloSemiringNumber = "moduloSemiringNumber"
211moduloSemiringInt :: String
244moduloSemiringInt :: String
212moduloSemiringInt = "moduloSemiringInt"
245moduloSemiringInt = "moduloSemiringInt"
213
246
247+ordBoolean :: String
248+ordBoolean = "ordBoolean"
249+
214ordNumber :: String
250ordNumber :: String
215ordNumber = "ordNumber"
251ordNumber = "ordNumber"
216
252
217ordInt :: String
253ordInt :: String
218ordInt = "ordInt"
254ordInt = "ordInt"
219
255
256+ordString :: String
257+ordString = "ordString"
258+
259+ordChar :: String
260+ordChar = "ordChar"
261+
220eqNumber :: String
262eqNumber :: String
221eqNumber = "eqNumber"
263eqNumber = "eqNumber"
222
264
@@ -226,6 +268,9 @@ eqInt = "eqInt"
226eqString :: String
268eqString :: String
227eqString = "eqString"
269eqString = "eqString"
228
270
271+eqChar :: String
272+eqChar = "eqChar"
273+
229eqBoolean :: String
274eqBoolean :: String
230eqBoolean = "eqBoolean"
275eqBoolean = "eqBoolean"
231
276
@@ -285,6 +330,39 @@ eff = "Control_Monad_Eff"
285st :: String
330st :: String
286st = "Control_Monad_ST"
331st = "Control_Monad_ST"
287
332
333+controlApplicative :: String
334+controlApplicative = "Control_Applicative"
335+
336+controlSemigroupoid :: String
337+controlSemigroupoid = "Control_Semigroupoid"
338+
339+controlBind :: String
340+controlBind = "Control_Bind"
341+
342+dataBounded :: String
343+dataBounded = "Data_Bounded"
344+
345+dataSemigroup :: String
346+dataSemigroup = "Data_Semigroup"
347+
348+dataModuloSemiring :: String
349+dataModuloSemiring = "Data_ModuloSemiring"
350+
351+dataBooleanAlgebra :: String
352+dataBooleanAlgebra = "Data_BooleanAlgebra"
353+
354+dataEq :: String
355+dataEq = "Data_Eq"
356+
357+dataOrd :: String
358+dataOrd = "Data_Ord"
359+
360+dataSemiring :: String
361+dataSemiring = "Data_Semiring"
362+
363+dataRing :: String
364+dataRing = "Data_Ring"
365+
288dataFunction :: String
366dataFunction :: String
289dataFunction = "Data_Function"
367dataFunction = "Data_Function"
290
368