+; Unary ops
+
+(define (flo:1+ x) (flo:+ x 1.0))
+(define (flo:1- x) (flo:- x 1.0))
+
+(define (1+ n)
+ (type-dispatch (cons fix:1+ flo:1+) n))
+
+(define (1- n)
+ (type-dispatch (cons fix:1- flo:1-) n))
+
+(define (apply-to-flonum op x)
+ (if (flonum? x) (op x) x))
+
+(define (round x)
+ (apply-to-flonum flo:round x))
+(define (floor x)
+ (apply-to-flonum flo:floor x))
+(define (ceiling x)
+ (apply-to-flonum flo:ceiling x))
+(define (truncate x)
+ (apply-to-flonum flo:truncate x))
+
+; Type dispatch and promotion
+
+(define (type-dispatch ops x)
+ (if (flonum? x)
+ ((cdr ops) x)
+ ((car ops) x)))
+
+(define (promote-dispatch ops x y)
+ (if (flonum? x)
+ (if (flonum? y)
+ ((cdr ops) x y)
+ ((cdr ops) x (fixnum->flonum y)))
+ (if (flonum? y)
+ ((cdr ops) (fixnum->flonum x) y)
+ ((car ops) x y))))
+
+; Binary operations
+
+(define (pair+ x y) (promote-dispatch (cons fix:+ flo:+) x y))
+(define (pair- x y) (promote-dispatch (cons fix:- flo:-) x y))
+(define (pair* x y) (promote-dispatch (cons fix:* flo:*) x y))
+(define (pair/ x y) (promote-dispatch
+ (cons (lambda 'args
+ (error "Division unsupported for integers."))
+ flo:/) x y))
+
+(define (pair> x y) (promote-dispatch (cons fix:> flo:>) x y))
+(define (pair< x y) (promote-dispatch (cons fix:< flo:<) x y))
+(define (pair>= x y) (promote-dispatch (cons fix:>= flo:>=) x y))
+(define (pair<= x y) (promote-dispatch (cons fix:<= flo:<=) x y))
+(define (pair= x y) (promote-dispatch (cons fix:= flo:=) x y))
+
+(define (neg x)
+ (type-dispatch (cons fix:neg flo:neg) x))