@@ -200,57 +200,31 @@ codegenPrimOp codegenEnv = case _ of
200200 x' = codegenExpr codegenEnv x
201201 y' = codegenExpr codegenEnv y
202202
203− opBooleanOrd = case _ of
204− OpEq -> S.Identifier "scm:boolean=?"
205− OpNotEq -> S.Identifier "scm:boolean=?"
206− OpGt -> S.Identifier "rt:boolean<?"
207− OpGte -> S.Identifier "rt:boolean>=?"
208− OpLt -> S.Identifier "rt:boolean<?"
209− OpLte -> S.Identifier "rt:boolean<=?"
210−
211203 opFixNum = case _ of
212204 OpAdd -> S.Identifier "scm:fx+"
213205 OpSubtract -> S.Identifier "scm:fx-"
214206 OpMultiply -> S.Identifier "scm:fx*"
215207 OpDivide -> S.Identifier "scm:fx/"
216208
217− opFixOrd = case _ of
218− OpEq -> S.Identifier "scm:fx="
219− OpNotEq -> S.Identifier "scm:fx="
220− OpGt -> S.Identifier "scm:fx>"
221− OpGte -> S.Identifier "scm:fx>="
222− OpLt -> S.Identifier "scm:fx<"
223− OpLte -> S.Identifier "scm:fx<="
224−
225209 opFloNum = case _ of
226210 OpAdd -> S.Identifier "scm:fl+"
227211 OpSubtract -> S.Identifier "scm:fl-"
228212 OpMultiply -> S.Identifier "scm:fl*"
229213 OpDivide -> S.Identifier "scm:fl/"
230214
231− opFloOrd = case _ of
232− OpEq -> S.Identifier "scm:fl="
233− OpNotEq -> S.Identifier "scm:fl="
234− OpGt -> S.Identifier "scm:fl>"
235− OpGte -> S.Identifier "scm:fl>="
236− OpLt -> S.Identifier "scm:fl<"
237− OpLte -> S.Identifier "scm:fl<="
238−
239− opCharOrd = case _ of
240− OpEq -> S.Identifier "scm:char=?"
241− OpNotEq -> S.Identifier "scm:char=?"
242− OpGt -> S.Identifier "scm:char>?"
243− OpGte -> S.Identifier "scm:char>=?"
244− OpLt -> S.Identifier "scm:char<?"
245− OpLte -> S.Identifier "scm:char<=?"
246−
247− opStringOrd = case _ of
248− OpEq -> S.Identifier "scm:string=?"
249− OpNotEq -> S.Identifier "scm:string=?"
250− OpGt -> S.Identifier "scm:string>?"
251− OpGte -> S.Identifier "scm:string>=?"
252− OpLt -> S.Identifier "scm:string<?"
253− OpLte -> S.Identifier "scm:string<=?"
215+ makeComparison :: String -> BackendOperatorOrd -> ChezExpr
216+ makeComparison tyName =
217+ let
218+ comparisonExpression opName =
219+ S.List [ S.Identifier $ Array.fold [ "scm:", tyName, opName ], x', y' ]
220+ in
221+ case _ of
222+ OpEq -> comparisonExpression "=?"
223+ OpNotEq -> S.List [ S.Identifier "scm:not", comparisonExpression "=?" ]
224+ OpGt -> comparisonExpression ">?"
225+ OpGte -> comparisonExpression ">=?"
226+ OpLt -> comparisonExpression "<?"
227+ OpLte -> comparisonExpression "<=?"
254228 in
255229 case o of
256230 OpArrayIndex ->
@@ -260,17 +234,21 @@ codegenPrimOp codegenEnv = case _ of
260234 OpBooleanOr ->
261235 S.List [ S.Identifier "scm:or", x', y' ]
262236 OpBooleanOrd o' ->
263− case o' of
264− OpNotEq ->
265− S.List [ S.Identifier "scm:not", S.List [ opBooleanOrd o', x', y' ] ]
266− _ ->
267− S.List [ opBooleanOrd o', x', y' ]
237+ -- Gt, Gte, Lt, Lte are defined under rt:
238+ let
239+ comparisonExpression :: String -> String -> ChezExpr
240+ comparisonExpression prefix opName =
241+ S.List [ S.Identifier $ Array.fold [ prefix, "boolean", opName ], x', y' ]
242+ in
243+ case o' of
244+ OpEq -> comparisonExpression "scm:" "=?"
245+ OpNotEq -> S.List [ S.Identifier "scm:not", comparisonExpression "scm:" "=?" ]
246+ OpGt -> comparisonExpression "rt:" ">?"
247+ OpGte -> comparisonExpression "rt:" ">=?"
248+ OpLt -> comparisonExpression "rt:" "<?"
249+ OpLte -> comparisonExpression "rt:" "<=?"
268250 OpCharOrd o' ->
269− case o' of
270− OpNotEq ->
271− S.List [ S.Identifier "scm:not", S.List [ opCharOrd o', x', y' ] ]
272− _ ->
273− S.List [ opCharOrd o', x', y' ]
251+ makeComparison "char" o'
274252 OpIntBitAnd ->
275253 S.List [ S.Identifier "scm:fxlogand", x', y' ]
276254 OpIntBitOr ->
@@ -295,26 +273,12 @@ codegenPrimOp codegenEnv = case _ of
295273 OpIntNum o' ->
296274 S.List [ opFixNum o', x', y' ]
297275 OpIntOrd o' ->
298− case o' of
299− OpNotEq ->
300− S.List [ S.Identifier "scm:not", S.List [ opFixOrd o', x', y' ] ]
301− _ ->
302− S.List [ opFixOrd o', x', y' ]
276+ makeComparison "fx" o'
303277 OpNumberNum o' ->
304278 S.List [ opFloNum o', x', y' ]
305279 OpNumberOrd o' ->
306− case o' of
307− OpNotEq ->
308− S.List [ S.Identifier "scm:not", S.List [ opFloOrd o', x', y' ] ]
309− _ ->
310− S.List [ opFloOrd o', x', y' ]
280+ makeComparison "fl" o'
311281 OpStringAppend ->
312282 S.List [ S.Identifier "scm:string-append", x', y' ]
313283 OpStringOrd o' ->
314− -- We've done this pattern-matching four times. Should this
315− -- be refactored to have the pretty-printer deal with it?
316− case o' of
317− OpNotEq ->
318− S.List [ S.Identifier "scm:not", S.List [ opStringOrd o', x', y' ] ]
319− _ ->
320− S.List [ opStringOrd o', x', y' ]
284+ makeComparison "string" o'