* Added fx=?, fx<?, fx<=?, fx>?, and fx>=?
This commit is contained in:
Abdulaziz Ghuloum
parent
c552e0b3b1
commit
3facf76eff
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
|
@ -2,14 +2,18 @@
|
|||
(library (ikarus fixnums)
|
||||
(export fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* fxquotient
|
||||
fxremainder fxmodulo fxlogor fxlogand fxlogxor fxsll fxsra
|
||||
fx= fx< fx<= fx> fx>= fixnum->string)
|
||||
fx= fx< fx<= fx> fx>=
|
||||
fx=? fx<? fx<=? fx>? fx>=?
|
||||
fixnum->string)
|
||||
(import
|
||||
(ikarus system $fx)
|
||||
(ikarus system $chars)
|
||||
(ikarus system $pairs)
|
||||
(ikarus system $strings)
|
||||
(except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx*
|
||||
fxquotient fxremainder fxmodulo fxlogor fxlogand
|
||||
fxlogxor fxsll fxsra fx= fx< fx<= fx> fx>=
|
||||
fx=? fx<? fx<=? fx>? fx>=?
|
||||
fixnum->string))
|
||||
|
||||
(define fxzero?
|
||||
|
|
@ -61,45 +65,54 @@
|
|||
(error 'fx* "~s is not a fixnum" y))
|
||||
($fx* x y)))
|
||||
|
||||
(define fx=
|
||||
(lambda (x y)
|
||||
(unless (fixnum? x)
|
||||
(error 'fx= "~s is not a fixnum" x))
|
||||
(unless (fixnum? y)
|
||||
(error 'fx= "~s is not a fixnum" y))
|
||||
($fx= x y)))
|
||||
(define false-loop
|
||||
(lambda (who ls)
|
||||
(if (pair? ls)
|
||||
(if (fixnum? ($car ls))
|
||||
(false-loop who ($cdr ls))
|
||||
(error who "~s is not a fixnum" ($car ls)))
|
||||
#f)))
|
||||
|
||||
(define-syntax fxcmp
|
||||
(syntax-rules ()
|
||||
[(_ who $op)
|
||||
(case-lambda
|
||||
[(x y)
|
||||
(unless (fixnum? x)
|
||||
(error 'who "~s is not a fixnum" x))
|
||||
(unless (fixnum? y)
|
||||
(error 'who "~s is not a fixnum" y))
|
||||
($op x y)]
|
||||
[(x y . ls)
|
||||
(if (fixnum? x)
|
||||
(if (fixnum? y)
|
||||
(if ($op x y)
|
||||
(let f ([x y] [ls ls])
|
||||
(if (pair? ls)
|
||||
(let ([y ($car ls)] [ls ($cdr ls)])
|
||||
(if (fixnum? y)
|
||||
(if ($op x y)
|
||||
(f y ls)
|
||||
(false-loop 'who ls))
|
||||
(error 'who "~s is not a fixnum" y)))
|
||||
#t))
|
||||
(false-loop 'who ls))
|
||||
(error 'who "~s is not a fixnum" y))
|
||||
(error 'who "~s is not a fixnum" x))]
|
||||
[(x)
|
||||
(if (fixnum? x) #t (error 'who "~s is not a fixnum" x))])]))
|
||||
|
||||
(define fx<
|
||||
(lambda (x y)
|
||||
(unless (fixnum? x)
|
||||
(error 'fx< "~s is not a fixnum" x))
|
||||
(unless (fixnum? y)
|
||||
(error 'fx< "~s is not a fixnum" y))
|
||||
($fx< x y)))
|
||||
|
||||
(define fx<=
|
||||
(lambda (x y)
|
||||
(unless (fixnum? x)
|
||||
(error 'fx<= "~s is not a fixnum" x))
|
||||
(unless (fixnum? y)
|
||||
(error 'fx<= "~s is not a fixnum" y))
|
||||
($fx<= x y)))
|
||||
|
||||
(define fx>
|
||||
(lambda (x y)
|
||||
(unless (fixnum? x)
|
||||
(error 'fx> "~s is not a fixnum" x))
|
||||
(unless (fixnum? y)
|
||||
(error 'fx> "~s is not a fixnum" y))
|
||||
($fx> x y)))
|
||||
|
||||
(define fx>=
|
||||
(lambda (x y)
|
||||
(unless (fixnum? x)
|
||||
(error 'fx>= "~s is not a fixnum" x))
|
||||
(unless (fixnum? y)
|
||||
(error 'fx>= "~s is not a fixnum" y))
|
||||
($fx>= x y)))
|
||||
(define fx= (fxcmp fx= $fx=))
|
||||
(define fx< (fxcmp fx< $fx<))
|
||||
(define fx<= (fxcmp fx<= $fx<=))
|
||||
(define fx> (fxcmp fx> $fx>))
|
||||
(define fx>= (fxcmp fx>= $fx>=))
|
||||
(define fx=? (fxcmp fx=? $fx=))
|
||||
(define fx<? (fxcmp fx<? $fx<))
|
||||
(define fx<=? (fxcmp fx<=? $fx<=))
|
||||
(define fx>? (fxcmp fx>? $fx>))
|
||||
(define fx>=? (fxcmp fx>=? $fx>=))
|
||||
|
||||
|
||||
(define fxquotient
|
||||
(lambda (x y)
|
||||
|
|
|
|||
|
|
@ -452,6 +452,11 @@
|
|||
[fx> i]
|
||||
[fx>= i]
|
||||
[fx= i]
|
||||
[fx<? i]
|
||||
[fx<=? i]
|
||||
[fx>? i]
|
||||
[fx>=? i]
|
||||
[fx=? i]
|
||||
[fx- i]
|
||||
[fx+ i]
|
||||
[fx* i]
|
||||
|
|
|
|||
|
|
@ -256,21 +256,21 @@
|
|||
[bitwise-rotate-bit-field D bw]
|
||||
;;;
|
||||
[fixnum? C fx]
|
||||
[fx* D fx]
|
||||
[fx* C fx]
|
||||
[fx*/carry D fx]
|
||||
[fx+ D fx]
|
||||
[fx+ C fx]
|
||||
[fx+/carry D fx]
|
||||
[fx- D fx]
|
||||
[fx- C fx]
|
||||
[fx-/carry D fx]
|
||||
[fx<=? D fx]
|
||||
[fx<? D fx]
|
||||
[fx=? D fx]
|
||||
[fx>=? D fx]
|
||||
[fx>? D fx]
|
||||
[fxand D fx]
|
||||
[fxarithmetic-shift D fx]
|
||||
[fxarithmetic-shift-left D fx]
|
||||
[fxarithmetic-shift-right D fx]
|
||||
[fx<=? C fx]
|
||||
[fx<? C fx]
|
||||
[fx=? C fx]
|
||||
[fx>=? C fx]
|
||||
[fx>? C fx]
|
||||
[fxand S fx]
|
||||
[fxarithmetic-shift S fx]
|
||||
[fxarithmetic-shift-left S fx]
|
||||
[fxarithmetic-shift-right S fx]
|
||||
[fxbit-count D fx]
|
||||
[fxbit-field D fx]
|
||||
[fxbit-set? D fx]
|
||||
|
|
@ -280,23 +280,23 @@
|
|||
[fxdiv-and-mod D fx]
|
||||
[fxdiv0 D fx]
|
||||
[fxdiv0-and-mod0 D fx]
|
||||
[fxeven? D fx]
|
||||
[fxeven? S fx]
|
||||
[fxfirst-bit-set D fx]
|
||||
[fxif D fx]
|
||||
[fxior D fx]
|
||||
[fxior S fx]
|
||||
[fxlength D fx]
|
||||
[fxmax D fx]
|
||||
[fxmin D fx]
|
||||
[fxmax S fx]
|
||||
[fxmin S fx]
|
||||
[fxmod D fx]
|
||||
[fxmod0 D fx]
|
||||
[fxmod0 S fx]
|
||||
[fxnegative? D fx]
|
||||
[fxnot D fx]
|
||||
[fxodd? D fx]
|
||||
[fxpositive? D fx]
|
||||
[fxnot S fx]
|
||||
[fxodd? S fx]
|
||||
[fxpositive? S fx]
|
||||
[fxreverse-bit-field D fx]
|
||||
[fxrotate-bit-field D fx]
|
||||
[fxxor D fx]
|
||||
[fxzero? D fx]
|
||||
[fxxor S fx]
|
||||
[fxzero? C fx]
|
||||
;;;
|
||||
[fixnum->flonum C fl]
|
||||
[fl* C fl]
|
||||
|
|
|
|||
Loading…
Reference in New Issue