@@ -84,12 +84,19 @@ inlineValues :: JS -> JS
8484inlineValues = 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
94101inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
95102inlineOperator (m, op) f = everywhereOnJS convert
@@ -103,52 +110,84 @@ inlineOperator (m, op) f = everywhereOnJS convert
103110
104111inlineCommonOperators :: JS -> JS
105112inlineCommonOperators = 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
193237isPreludeFn :: 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)