Skip to content

Commit 14df551

Browse files
garybgaryb
committed
Merge pull request purescript#1025 from purescript/integers
Inline native int and bitwise operators
2 parents ff577ab + 2d2ccc7 commit 14df551

File tree

2 files changed

+182
-51
lines changed

2 files changed

+182
-51
lines changed

‎src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs‎

Lines changed: 133 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -84,12 +84,19 @@ inlineValues :: JS -> JS
8484
inlineValues = everywhereOnJS convert
8585
where
8686
convert :: JS -> JS
87-
convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.zero fn = JSNumericLiteral (Left 0)
88-
convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.one fn = JSNumericLiteral (Left 1)
89-
convert (JSApp fn [dict]) | isPreludeDict C.boundedBoolean dict && isPreludeFn C.bottom fn = JSBooleanLiteral False
90-
convert (JSApp fn [dict]) | isPreludeDict C.boundedBoolean dict && isPreludeFn C.top fn = JSBooleanLiteral True
91-
convert (JSApp (JSApp fn [x]) [y]) | isPreludeFn (C.%) fn = JSBinary Modulus x y
87+
convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
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)
91+
| isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
92+
| isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
93+
convert (JSApp fn [value]) | isFn fromNumber fn = JSBinary BitwiseOr value (JSNumericLiteral (Left 0))
9294
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)
93100

94101
inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
95102
inlineOperator (m, op) f = everywhereOnJS convert
@@ -103,52 +110,84 @@ inlineOperator (m, op) f = everywhereOnJS convert
103110

104111
inlineCommonOperators :: JS -> JS
105112
inlineCommonOperators = applyAll $
106-
[ binary C.semiringNumber (C.+) Add
107-
, binary C.semiringNumber (C.*) Multiply
108-
, binary C.ringNumber (C.-) Subtract
109-
, unary C.ringNumber C.negate Negate
110-
, binary C.moduloSemiringNumber (C./) Divide
111-
112-
, binary C.ordNumber (C.<) LessThan
113-
, binary C.ordNumber (C.>) GreaterThan
114-
, binary C.ordNumber (C.<=) LessThanOrEqualTo
115-
, binary C.ordNumber (C.>=) GreaterThanOrEqualTo
116-
117-
, binary C.eqNumber (C.==) EqualTo
118-
, binary C.eqNumber (C./=) NotEqualTo
119-
, binary C.eqString (C.==) EqualTo
120-
, binary C.eqString (C./=) NotEqualTo
121-
, binary C.eqBoolean (C.==) EqualTo
122-
, binary C.eqBoolean (C./=) NotEqualTo
123-
124-
, binary C.semigroupString (C.<>) Add
125-
, binary C.semigroupString (C.++) Add
126-
127-
, binary C.latticeBoolean (C.&&) And
128-
, binary C.latticeBoolean (C.||) Or
129-
, binaryFunction C.latticeBoolean C.inf And
130-
, binaryFunction C.latticeBoolean C.sup Or
131-
, unary C.complementedLatticeBoolean C.not Not
113+
[ binary semiringNumber (C.+) Add
114+
, binary semiringNumber (C.*) Multiply
115+
, binary semiringInt (C.+) Add
116+
, binary semiringInt (C.*) Multiply
117+
118+
, binary ringNumber (C.-) Subtract
119+
, unary ringNumber C.negate Negate
120+
, binary ringInt (C.-) Subtract
121+
, unary ringInt C.negate Negate
122+
123+
, binary moduloSemiringNumber (C./) Divide
124+
125+
, binary eqNumber (C.==) EqualTo
126+
, binary eqNumber (C./=) NotEqualTo
127+
, binary eqInt (C.==) EqualTo
128+
, binary eqInt (C./=) NotEqualTo
129+
, binary eqString (C.==) EqualTo
130+
, binary eqString (C./=) NotEqualTo
131+
, binary eqBoolean (C.==) EqualTo
132+
, binary eqBoolean (C./=) NotEqualTo
133+
134+
, binary ordNumber (C.<) LessThan
135+
, binary ordNumber (C.>) GreaterThan
136+
, binary ordNumber (C.<=) LessThanOrEqualTo
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+
143+
, binary semigroupString (C.<>) Add
144+
, binary semigroupString (C.++) Add
145+
146+
, binary latticeBoolean (C.&&) And
147+
, binary latticeBoolean (C.||) Or
148+
, binaryFunction latticeBoolean C.inf And
149+
, binaryFunction latticeBoolean C.sup Or
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
132159
] ++
133160
[ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
134161
where
135-
binary :: String -> String -> BinaryOperator -> JS -> JS
136-
binary dictName opString op = everywhereOnJS convert
162+
binary :: (String, String) -> String -> BinaryOperator -> JS -> JS
163+
binary dict opString op = everywhereOnJS convert
137164
where
138165
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
140167
convert other = other
141-
binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
142-
binaryFunction dictName fnName op = everywhereOnJS convert
168+
binary' :: String -> String -> BinaryOperator -> JS -> JS
169+
binary' moduleName opString op = everywhereOnJS convert
143170
where
144171
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
146173
convert other = other
147-
unary :: String -> String -> UnaryOperator -> JS -> JS
148-
unary dictName fnName op = everywhereOnJS convert
174+
binaryFunction :: (String, String) -> String -> BinaryOperator -> JS -> JS
175+
binaryFunction dict fnName op = everywhereOnJS convert
149176
where
150177
convert :: JS -> JS
151-
convert (JSApp (JSApp fn [dict]) [x]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSUnary op x
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
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
152191
convert other = other
153192
mkFn :: Int -> JS -> JS
154193
mkFn 0 = everywhereOnJS convert
@@ -186,12 +225,59 @@ inlineCommonOperators = applyAll $
186225
go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
187226
go _ _ _ = Nothing
188227

189-
isPreludeDict :: String -> JS -> Bool
190-
isPreludeDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName
191-
isPreludeDict _ _ = False
228+
isDict :: (String, String) -> JS -> Bool
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
235+
isFn _ _ = False
192236

193237
isPreludeFn :: String -> JS -> Bool
194-
isPreludeFn fnName (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
195-
isPreludeFn fnName (JSIndexer (JSStringLiteral fnName') (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
196-
isPreludeFn fnName (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op fnName)
197-
isPreludeFn _ _ = False
238+
isPreludeFn fnName = isFn (C.prelude, fnName)
239+
240+
semiringNumber :: (String, String)
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‎

Lines changed: 49 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515

1616
module Language.PureScript.Constants where
1717

18-
-- Prelude Operators
18+
-- Operators
1919

2020
($) :: String
2121
($) = "$"
@@ -74,7 +74,16 @@ module Language.PureScript.Constants where
7474
unsafeIndex :: String
7575
unsafeIndex = "unsafeIndex"
7676

77-
-- Prelude Operator Functions
77+
(.|.) :: String
78+
(.|.) = ".|."
79+
80+
(.&.) :: String
81+
(.&.) = ".&."
82+
83+
(.^.) :: String
84+
(.^.) = ".^."
85+
86+
-- Functions
7887

7988
negate :: String
8089
negate = "negate"
@@ -88,6 +97,24 @@ sup = "sup"
8897
inf :: String
8998
inf = "inf"
9099

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+
91118
-- Prelude Values
92119

93120
zero :: String
@@ -163,21 +190,33 @@ bindEffDictionary = "bindEff"
163190
semiringNumber :: String
164191
semiringNumber = "semiringNumber"
165192

193+
semiringInt :: String
194+
semiringInt = "semiringInt"
195+
166196
ringNumber :: String
167197
ringNumber = "ringNumber"
168198

199+
ringInt :: String
200+
ringInt = "ringInt"
201+
169202
moduloSemiringNumber :: String
170203
moduloSemiringNumber = "moduloSemiringNumber"
171204

172-
numNumber :: String
173-
numNumber = "numNumber"
205+
moduloSemiringInt :: String
206+
moduloSemiringInt = "moduloSemiringInt"
174207

175208
ordNumber :: String
176209
ordNumber = "ordNumber"
177210

211+
ordInt :: String
212+
ordInt = "ordInt"
213+
178214
eqNumber :: String
179215
eqNumber = "eqNumber"
180216

217+
eqInt :: String
218+
eqInt = "eqInt"
219+
181220
eqString :: String
182221
eqString = "eqString"
183222

@@ -231,3 +270,9 @@ st = "Control_Monad_ST"
231270

232271
dataFunction :: String
233272
dataFunction = "Data_Function"
273+
274+
dataInt :: String
275+
dataInt = "Data_Int"
276+
277+
dataIntBits :: String
278+
dataIntBits = "Data_Int_Bits"

0 commit comments

Comments
 (0)