git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1025 from purescript/integers
14df551Gary Burgess
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+133−47
@@ -84,12 +84,19 @@ inlineValues :: JS -> JS
84inlineValues = everywhereOnJS convert
84inlineValues = everywhereOnJS convert
85 where
85 where
86 convert :: JS -> JS
86 convert :: JS -> JS
87− convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.zero fn = JSNumericLiteral (Left 0)
87+ convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
88− convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.one fn = JSNumericLiteral (Left 1)
88+ | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)
89+ | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)
90+ | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)
89− convert (JSApp fn [dict]) | isPreludeDict C.boundedBoolean dict && isPreludeFn C.bottom fn = JSBooleanLiteral False
91+ | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
90− convert (JSApp fn [dict]) | isPreludeDict C.boundedBoolean dict && isPreludeFn C.top fn = JSBooleanLiteral True
92+ | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
91− convert (JSApp (JSApp fn [x]) [y]) | isPreludeFn (C.%) fn = JSBinary Modulus x y
93+ convert (JSApp fn [value]) | isFn fromNumber fn = JSBinary BitwiseOr value (JSNumericLiteral (Left 0))
92 convert other = other
94 convert other = other
95+ fnZero = (C.prelude, C.zero)
96+ fnOne = (C.prelude, C.one)
97+ fnBottom = (C.prelude, C.bottom)
98+ fnTop = (C.prelude, C.top)
99+ fromNumber = (C.dataInt, C.fromNumber)
93
100
94inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
101inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
95inlineOperator (m, op) f = everywhereOnJS convert
102inlineOperator (m, op) f = everywhereOnJS convert
@@ -103,52 +110,84 @@ inlineOperator (m, op) f = everywhereOnJS convert
103
110
104inlineCommonOperators :: JS -> JS
111inlineCommonOperators :: JS -> JS
105inlineCommonOperators = applyAll $
112inlineCommonOperators = applyAll $
106− [ binary C.semiringNumber (C.+) Add
113+ [ binary semiringNumber (C.+) Add
107− , binary C.semiringNumber (C.*) Multiply
114+ , binary semiringNumber (C.*) Multiply
115+ , binary semiringInt (C.+) Add
116+ , binary semiringInt (C.*) Multiply
117+
108− , binary C.ringNumber (C.-) Subtract
118+ , binary ringNumber (C.-) Subtract
109− , unary C.ringNumber C.negate Negate
119+ , unary ringNumber C.negate Negate
120+ , binary ringInt (C.-) Subtract
121+ , unary ringInt C.negate Negate
122+
110− , binary C.moduloSemiringNumber (C./) Divide
123+ , binary moduloSemiringNumber (C./) Divide
111−
124+
112− , binary C.ordNumber (C.<) LessThan
125+ , binary eqNumber (C.==) EqualTo
113− , binary C.ordNumber (C.>) GreaterThan
126+ , binary eqNumber (C./=) NotEqualTo
114− , binary C.ordNumber (C.<=) LessThanOrEqualTo
127+ , binary eqInt (C.==) EqualTo
115− , binary C.ordNumber (C.>=) GreaterThanOrEqualTo
128+ , binary eqInt (C./=) NotEqualTo
116−
129+ , binary eqString (C.==) EqualTo
117− , binary C.eqNumber (C.==) EqualTo
130+ , binary eqString (C./=) NotEqualTo
131+ , binary eqBoolean (C.==) EqualTo
118− , binary C.eqNumber (C./=) NotEqualTo
132+ , binary eqBoolean (C./=) NotEqualTo
119− , binary C.eqString (C.==) EqualTo
133+
120− , binary C.eqString (C./=) NotEqualTo
134+ , binary ordNumber (C.<) LessThan
121− , binary C.eqBoolean (C.==) EqualTo
135+ , binary ordNumber (C.>) GreaterThan
122− , binary C.eqBoolean (C./=) NotEqualTo
136+ , binary ordNumber (C.<=) LessThanOrEqualTo
123−
137+ , binary ordNumber (C.>=) GreaterThanOrEqualTo
138+ , binary ordInt (C.<) LessThan
139+ , binary ordInt (C.>) GreaterThan
140+ , binary ordInt (C.<=) LessThanOrEqualTo
141+ , binary ordInt (C.>=) GreaterThanOrEqualTo
142+
124− , binary C.semigroupString (C.<>) Add
143+ , binary semigroupString (C.<>) Add
125− , binary C.semigroupString (C.++) Add
144+ , binary semigroupString (C.++) Add
126−
145+
127− , binary C.latticeBoolean (C.&&) And
146+ , binary latticeBoolean (C.&&) And
128− , binary C.latticeBoolean (C.||) Or
147+ , binary latticeBoolean (C.||) Or
129− , binaryFunction C.latticeBoolean C.inf And
148+ , binaryFunction latticeBoolean C.inf And
130− , binaryFunction C.latticeBoolean C.sup Or
149+ , binaryFunction latticeBoolean C.sup Or
131− , unary C.complementedLatticeBoolean C.not Not
150+ , unary complementedLatticeBoolean C.not Not
151+
152+ , binary' C.dataIntBits (C..|.) BitwiseOr
153+ , binary' C.dataIntBits (C..&.) BitwiseAnd
154+ , binary' C.dataIntBits (C..^.) BitwiseXor
155+ , binary' C.dataIntBits C.shl ShiftLeft
156+ , binary' C.dataIntBits C.shr ShiftRight
157+ , binary' C.dataIntBits C.zshr ZeroFillShiftRight
158+ , unary' C.dataIntBits C.complement BitwiseNot
132 ] ++
159 ] ++
133 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
160 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
134 where
161 where
135− binary :: String -> String -> BinaryOperator -> JS -> JS
162+ binary :: (String, String) -> String -> BinaryOperator -> JS -> JS
136− binary dictName opString op = everywhereOnJS convert
163+ binary dict opString op = everywhereOnJS convert
137 where
164 where
138 convert :: JS -> JS
165 convert :: JS -> JS
139− convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeDict dictName dict && isPreludeFn opString fn = JSBinary op x y
166+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = JSBinary op x y
140 convert other = other
167 convert other = other
141− binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
168+ binary' :: String -> String -> BinaryOperator -> JS -> JS
142− binaryFunction dictName fnName op = everywhereOnJS convert
169+ binary' moduleName opString op = everywhereOnJS convert
143 where
170 where
144 convert :: JS -> JS
171 convert :: JS -> JS
145− convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSBinary op x y
172+ convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y
146 convert other = other
173 convert other = other
147− unary :: String -> String -> UnaryOperator -> JS -> JS
174+ binaryFunction :: (String, String) -> String -> BinaryOperator -> JS -> JS
148− unary dictName fnName op = everywhereOnJS convert
175+ binaryFunction dict fnName op = everywhereOnJS convert
149 where
176 where
150 convert :: JS -> JS
177 convert :: JS -> JS
178+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = JSBinary op x y
179+ convert other = other
180+ unary :: (String, String) -> String -> UnaryOperator -> JS -> JS
181+ unary dict fnName op = everywhereOnJS convert
182+ where
183+ convert :: JS -> JS
151− convert (JSApp (JSApp fn [dict]) [x]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSUnary op x
184+ convert (JSApp (JSApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = JSUnary op x
185+ convert other = other
186+ unary' :: String -> String -> UnaryOperator -> JS -> JS
187+ unary' moduleName fnName op = everywhereOnJS convert
188+ where
189+ convert :: JS -> JS
190+ convert (JSApp fn [x]) | isFn (moduleName, fnName) fn = JSUnary op x
152 convert other = other
191 convert other = other
153 mkFn :: Int -> JS -> JS
192 mkFn :: Int -> JS -> JS
154 mkFn 0 = everywhereOnJS convert
193 mkFn 0 = everywhereOnJS convert
@@ -186,12 +225,59 @@ inlineCommonOperators = applyAll $
186 go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
225 go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
187 go _ _ _ = Nothing
226 go _ _ _ = Nothing
188
227
189−isPreludeDict :: String -> JS -> Bool
228+isDict :: (String, String) -> JS -> Bool
190−isPreludeDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName
229+isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
230+isDict _ _ = False
231+
232+isFn :: (String, String) -> JS -> Bool
233+isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName
234+isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName
191−isPreludeDict _ _ = False
235+isFn _ _ = False
192
236
193isPreludeFn :: String -> JS -> Bool
237isPreludeFn :: String -> JS -> Bool
194−isPreludeFn fnName (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
238+isPreludeFn fnName = isFn (C.prelude, fnName)
195−isPreludeFn fnName (JSIndexer (JSStringLiteral fnName') (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
239+
196−isPreludeFn fnName (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op fnName)
240+semiringNumber :: (String, String)
197−isPreludeFn _ _ = False
241+semiringNumber = (C.prelude, C.semiringNumber)
242+
243+semiringInt :: (String, String)
244+semiringInt = (C.dataInt, C.semiringInt)
245+
246+ringNumber :: (String, String)
247+ringNumber = (C.prelude, C.ringNumber)
248+
249+ringInt :: (String, String)
250+ringInt = (C.dataInt, C.ringInt)
251+
252+moduloSemiringNumber :: (String, String)
253+moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
254+
255+eqNumber :: (String, String)
256+eqNumber = (C.prelude, C.eqNumber)
257+
258+eqInt :: (String, String)
259+eqInt = (C.dataInt, C.eqInt)
260+
261+eqString :: (String, String)
262+eqString = (C.prelude, C.eqNumber)
263+
264+eqBoolean :: (String, String)
265+eqBoolean = (C.prelude, C.eqNumber)
266+
267+ordNumber :: (String, String)
268+ordNumber = (C.prelude, C.ordNumber)
269+
270+ordInt :: (String, String)
271+ordInt = (C.dataInt, C.ordInt)
272+
273+semigroupString :: (String, String)
274+semigroupString = (C.prelude, C.semigroupString)
275+
276+boundedBoolean :: (String, String)
277+boundedBoolean = (C.prelude, C.boundedBoolean)
278+
279+latticeBoolean :: (String, String)
280+latticeBoolean = (C.prelude, C.latticeBoolean)
281+
282+complementedLatticeBoolean :: (String, String)
283+complementedLatticeBoolean = (C.prelude, C.complementedLatticeBoolean)
src/Language/PureScript/Constants.hs+49−4
@@ -15,7 +15,7 @@
15
15
16module Language.PureScript.Constants where
16module Language.PureScript.Constants where
17
17
18−-- Prelude Operators
18+-- Operators
19
19
20($) :: String
20($) :: String
21($) = "$"
21($) = "$"
@@ -74,7 +74,16 @@ module Language.PureScript.Constants where
74unsafeIndex :: String
74unsafeIndex :: String
75unsafeIndex = "unsafeIndex"
75unsafeIndex = "unsafeIndex"
76
76
77+(.|.) :: String
78+(.|.) = ".|."
79+
80+(.&.) :: String
81+(.&.) = ".&."
82+
83+(.^.) :: String
84+(.^.) = ".^."
85+
77−-- Prelude Operator Functions
86+-- Functions
78
87
79negate :: String
88negate :: String
80negate = "negate"
89negate = "negate"
@@ -88,6 +97,24 @@ sup = "sup"
88inf :: String
97inf :: String
89inf = "inf"
98inf = "inf"
90
99
100+mod :: String
101+mod = "mod"
102+
103+shl :: String
104+shl = "shl"
105+
106+shr :: String
107+shr = "shr"
108+
109+zshr :: String
110+zshr = "zshr"
111+
112+complement :: String
113+complement = "complement"
114+
115+fromNumber :: String
116+fromNumber = "fromNumber"
117+
91-- Prelude Values
118-- Prelude Values
92
119
93zero :: String
120zero :: String
@@ -163,21 +190,33 @@ bindEffDictionary = "bindEff"
163semiringNumber :: String
190semiringNumber :: String
164semiringNumber = "semiringNumber"
191semiringNumber = "semiringNumber"
165
192
193+semiringInt :: String
194+semiringInt = "semiringInt"
195+
166ringNumber :: String
196ringNumber :: String
167ringNumber = "ringNumber"
197ringNumber = "ringNumber"
168
198
199+ringInt :: String
200+ringInt = "ringInt"
201+
169moduloSemiringNumber :: String
202moduloSemiringNumber :: String
170moduloSemiringNumber = "moduloSemiringNumber"
203moduloSemiringNumber = "moduloSemiringNumber"
171
204
172−numNumber :: String
205+moduloSemiringInt :: String
173−numNumber = "numNumber"
206+moduloSemiringInt = "moduloSemiringInt"
174
207
175ordNumber :: String
208ordNumber :: String
176ordNumber = "ordNumber"
209ordNumber = "ordNumber"
177
210
211+ordInt :: String
212+ordInt = "ordInt"
213+
178eqNumber :: String
214eqNumber :: String
179eqNumber = "eqNumber"
215eqNumber = "eqNumber"
180
216
217+eqInt :: String
218+eqInt = "eqInt"
219+
181eqString :: String
220eqString :: String
182eqString = "eqString"
221eqString = "eqString"
183
222
@@ -231,3 +270,9 @@ st = "Control_Monad_ST"
231
270
232dataFunction :: String
271dataFunction :: String
233dataFunction = "Data_Function"
272dataFunction = "Data_Function"
273+
274+dataInt :: String
275+dataInt = "Data_Int"
276+
277+dataIntBits :: String
278+dataIntBits = "Data_Int_Bits"