@@ -84,12 +84,19 @@ inlineValues :: JS -> JS
84inlineValues = everywhereOnJS convert
84inlineValues = everywhereOnJS convert
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)
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
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
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
110− , binary C.moduloSemiringNumber (C./) Divide
123+ , binary moduloSemiringNumber (C./) Divide
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
124− , binary C.semigroupString (C.<>) Add
143+ , binary semigroupString (C.<>) Add
125− , binary C.semigroupString (C.++) Add
144+ , binary semigroupString (C.++) Add
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
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
133 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
160 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
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
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
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
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
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
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
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
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
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)
243+semiringInt :: (String, String)
244+semiringInt = (C.dataInt, C.semiringInt)
246+ringNumber :: (String, String)
247+ringNumber = (C.prelude, C.ringNumber)
249+ringInt :: (String, String)
250+ringInt = (C.dataInt, C.ringInt)
252+moduloSemiringNumber :: (String, String)
253+moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
255+eqNumber :: (String, String)
256+eqNumber = (C.prelude, C.eqNumber)
258+eqInt :: (String, String)
259+eqInt = (C.dataInt, C.eqInt)
261+eqString :: (String, String)
262+eqString = (C.prelude, C.eqNumber)
264+eqBoolean :: (String, String)
265+eqBoolean = (C.prelude, C.eqNumber)
267+ordNumber :: (String, String)
268+ordNumber = (C.prelude, C.ordNumber)
270+ordInt :: (String, String)
271+ordInt = (C.dataInt, C.ordInt)
273+semigroupString :: (String, String)
274+semigroupString = (C.prelude, C.semigroupString)
276+boundedBoolean :: (String, String)
277+boundedBoolean = (C.prelude, C.boundedBoolean)
279+latticeBoolean :: (String, String)
280+latticeBoolean = (C.prelude, C.latticeBoolean)
282+complementedLatticeBoolean :: (String, String)
283+complementedLatticeBoolean = (C.prelude, C.complementedLatticeBoolean)