conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Added fx=?, fx<?, fx<=?, fx>?, and fx>=?

This commit is contained in:
Abdulaziz Ghuloum 2007-09-13 16:39:13 -04:00
parent c552e0b3b1
commit 3facf76eff
4 changed files with 79 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

91
src/ikarus.fixnums.ss
View File

@ -2,14 +2,18 @@
(library (ikarus fixnums) (library (ikarus fixnums)
(export fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* fxquotient (export fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* fxquotient
fxremainder fxmodulo fxlogor fxlogand fxlogxor fxsll fxsra 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 (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $chars) (ikarus system $chars)
(ikarus system $pairs)
(ikarus system $strings) (ikarus system $strings)
(except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx* (except (ikarus) fxzero? fxadd1 fxsub1 fxlognot fx+ fx- fx*
fxquotient fxremainder fxmodulo fxlogor fxlogand fxquotient fxremainder fxmodulo fxlogor fxlogand
fxlogxor fxsll fxsra fx= fx< fx<= fx> fx>= fxlogxor fxsll fxsra fx= fx< fx<= fx> fx>=
fx=? fx<? fx<=? fx>? fx>=?
fixnum->string)) fixnum->string))
(define fxzero? (define fxzero?
@ -61,45 +65,54 @@
(error 'fx* "~s is not a fixnum" y)) (error 'fx* "~s is not a fixnum" y))
($fx* x y))) ($fx* x y)))
(define fx= (define false-loop
(lambda (x y) (lambda (who ls)
(unless (fixnum? x) (if (pair? ls)
(error 'fx= "~s is not a fixnum" x)) (if (fixnum? ($car ls))
(unless (fixnum? y) (false-loop who ($cdr ls))
(error 'fx= "~s is not a fixnum" y)) (error who "~s is not a fixnum" ($car ls)))
($fx= x y))) #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< (define fx= (fxcmp fx= $fx=))
(lambda (x y) (define fx< (fxcmp fx< $fx<))
(unless (fixnum? x) (define fx<= (fxcmp fx<= $fx<=))
(error 'fx< "~s is not a fixnum" x)) (define fx> (fxcmp fx> $fx>))
(unless (fixnum? y) (define fx>= (fxcmp fx>= $fx>=))
(error 'fx< "~s is not a fixnum" y)) (define fx=? (fxcmp fx=? $fx=))
($fx< x y))) (define fx<? (fxcmp fx<? $fx<))
(define fx<=? (fxcmp fx<=? $fx<=))
(define fx<= (define fx>? (fxcmp fx>? $fx>))
(lambda (x y) (define fx>=? (fxcmp fx>=? $fx>=))
(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 fxquotient (define fxquotient
(lambda (x y) (lambda (x y)

5
src/makefile.ss
View File

@ -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]
[fx- i] [fx- i]
[fx+ i] [fx+ i]
[fx* i] [fx* i]

44
src/todo-r6rs.ss
View File

@ -256,21 +256,21 @@
[bitwise-rotate-bit-field D bw] [bitwise-rotate-bit-field D bw]
;;; ;;;
[fixnum? C fx] [fixnum? C fx]
[fx* D fx] [fx* C fx]
[fx*/carry D fx] [fx*/carry D fx]
[fx+ D fx] [fx+ C fx]
[fx+/carry D fx] [fx+/carry D fx]
[fx- D fx] [fx- C fx]
[fx-/carry D fx] [fx-/carry D fx]
[fx<=? D fx] [fx<=? C fx]
[fx<? D fx] [fx<? C fx]
[fx=? D fx] [fx=? C fx]
[fx>=? D fx] [fx>=? C fx]
[fx>? D fx] [fx>? C fx]
[fxand D fx] [fxand S fx]
[fxarithmetic-shift D fx] [fxarithmetic-shift S fx]
[fxarithmetic-shift-left D fx] [fxarithmetic-shift-left S fx]
[fxarithmetic-shift-right D fx] [fxarithmetic-shift-right S fx]
[fxbit-count D fx] [fxbit-count D fx]
[fxbit-field D fx] [fxbit-field D fx]
[fxbit-set? D fx] [fxbit-set? D fx]
@ -280,23 +280,23 @@
[fxdiv-and-mod D fx] [fxdiv-and-mod D fx]
[fxdiv0 D fx] [fxdiv0 D fx]
[fxdiv0-and-mod0 D fx] [fxdiv0-and-mod0 D fx]
[fxeven? D fx] [fxeven? S fx]
[fxfirst-bit-set D fx] [fxfirst-bit-set D fx]
[fxif D fx] [fxif D fx]
[fxior D fx] [fxior S fx]
[fxlength D fx] [fxlength D fx]
[fxmax D fx] [fxmax S fx]
[fxmin D fx] [fxmin S fx]
[fxmod D fx] [fxmod D fx]
[fxmod0 D fx] [fxmod0 S fx]
[fxnegative? D fx] [fxnegative? D fx]
[fxnot D fx] [fxnot S fx]
[fxodd? D fx] [fxodd? S fx]
[fxpositive? D fx] [fxpositive? S fx]
[fxreverse-bit-field D fx] [fxreverse-bit-field D fx]
[fxrotate-bit-field D fx] [fxrotate-bit-field D fx]
[fxxor D fx] [fxxor S fx]
[fxzero? D fx] [fxzero? C fx]
;;; ;;;
[fixnum->flonum C fl] [fixnum->flonum C fl]
[fl* C fl] [fl* C fl]