@@ -169,19 +169,33 @@ codegenPrimOp codegenEnv = case _ of
169169 x' = codegenExpr codegenEnv x
170170 y' = codegenExpr codegenEnv y
171171
172− opDtNum = case _ of
173− OpAdd -> S.Identifier "scm:+"
174− OpSubtract -> S.Identifier "scm:-"
175− OpMultiply -> S.Identifier "scm:*"
176− OpDivide -> S.Identifier "scm:/"
172+ opFixNum = case _ of
173+ OpAdd -> S.Identifier "scm:fx+"
174+ OpSubtract -> S.Identifier "scm:fx-"
175+ OpMultiply -> S.Identifier "scm:fx*"
176+ OpDivide -> S.Identifier "scm:fx/"
177177
178− opDtOrd = case _ of
179− OpEq -> S.Identifier "scm:="
180− OpNotEq -> S.Identifier "scm:="
181− OpGt -> S.Identifier "scm:>"
182− OpGte -> S.Identifier "scm:>="
183− OpLt -> S.Identifier "scm:<"
184− OpLte -> S.Identifier "scm:<="
178+ opFixOrd = case _ of
179+ OpEq -> S.Identifier "scm:fx="
180+ OpNotEq -> S.Identifier "scm:fx="
181+ OpGt -> S.Identifier "scm:fx>"
182+ OpGte -> S.Identifier "scm:fx>="
183+ OpLt -> S.Identifier "scm:fx<"
184+ OpLte -> S.Identifier "scm:fx<="
185+
186+ opFloNum = case _ of
187+ OpAdd -> S.Identifier "scm:fl+"
188+ OpSubtract -> S.Identifier "scm:fl-"
189+ OpMultiply -> S.Identifier "scm:fl*"
190+ OpDivide -> S.Identifier "scm:fl/"
191+
192+ opFloOrd = case _ of
193+ OpEq -> S.Identifier "scm:fl="
194+ OpNotEq -> S.Identifier "scm:fl="
195+ OpGt -> S.Identifier "scm:fl>"
196+ OpGte -> S.Identifier "scm:fl>="
197+ OpLt -> S.Identifier "scm:fl<"
198+ OpLte -> S.Identifier "scm:fl<="
185199
186200 opCharOrd = case _ of
187201 OpEq -> S.Identifier "scm:char=?"
@@ -219,33 +233,42 @@ codegenPrimOp codegenEnv = case _ of
219233 _ ->
220234 S.List [ opCharOrd o', x', y' ]
221235 OpIntBitAnd ->
222− S.List [ S.Identifier "scm:bitwise-and", x', y' ]
236+ S.List [ S.Identifier "scm:fxlogand", x', y' ]
223237 OpIntBitOr ->
224− S.List [ S.Identifier "scm:bitwise-or", x', y' ]
238+ S.List [ S.Identifier "scm:fxlogor", x', y' ]
225239 OpIntBitShiftLeft ->
226− S.List [ S.Identifier "scm:bitwise-arithmetic-shift-left", x', y' ]
240+ -- shift-left-logical = shift-left-arithmetic
241+ S.List [ S.Identifier "scm:fxsll", x', y' ]
227242 OpIntBitShiftRight ->
228− S.List [ S.Identifier "scm:bitwise-arithmetic-shift-right", x', y' ]
243+ -- shift-right-arithmetic preserves signs
244+ S.List [ S.Identifier "scm:fxsra", x', y' ]
229245 OpIntBitXor ->
230− S.List [ S.Identifier "scm:bitwise-xor", x', y' ]
246+ S.List [ S.Identifier "scm:fxlogxor", x', y' ]
231247 OpIntBitZeroFillShiftRight ->
232− S.Identifier "zero-fill-shift-right"
248+ -- shift-right-logical follows the invariant:
249+ --
250+ -- (= (most-positive-fixnum) (fxsrl -1 1))
251+ --
252+ -- or:
253+ --
254+ -- top == zshr (-1) 1
255+ S.List [ S.Identifier "scm:fxsrl", x', y' ]
233256 OpIntNum o' ->
234− S.List [ opDtNum o', x', y' ]
257+ S.List [ opFixNum o', x', y' ]
235258 OpIntOrd o' ->
236259 case o' of
237260 OpNotEq ->
238− S.List [ S.Identifier "scm:not", S.List [ opDtOrd o', x', y' ] ]
261+ S.List [ S.Identifier "scm:not", S.List [ opFixOrd o', x', y' ] ]
239262 _ ->
240− S.List [ opDtOrd o', x', y' ]
263+ S.List [ opFixOrd o', x', y' ]
241264 OpNumberNum o' ->
242− S.List [ opDtNum o', x', y' ]
265+ S.List [ opFloNum o', x', y' ]
243266 OpNumberOrd o' ->
244267 case o' of
245268 OpNotEq ->
246− S.List [ S.Identifier "scm:not", S.List [ opDtOrd o', x', y' ] ]
269+ S.List [ S.Identifier "scm:not", S.List [ opFloOrd o', x', y' ] ]
247270 _ ->
248− S.List [ opDtOrd o', x', y' ]
271+ S.List [ opFloOrd o', x', y' ]
249272 OpStringAppend ->
250273 S.List [ S.Identifier "scm:string-append", x', y' ]
251274 OpStringOrd o' ->
@@ -254,5 +277,5 @@ codegenPrimOp codegenEnv = case _ of
254277 case o' of
255278 OpNotEq ->
256279 S.List [ S.Identifier "scm:not", S.List [ opStringOrd o', x', y' ] ]
257− _ ->
280+ _ ->
258281 S.List [ opStringOrd o', x', y' ]