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

* Added fxmin and fxmax

This commit is contained in:
Abdulaziz Ghuloum 2007-09-15 00:24:38 -04:00
parent 54472a1994
commit a2ed662821
4 changed files with 52 additions and 2 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.

48
src/ikarus.fixnums.ss
View File

@ -9,6 +9,7 @@
fxeven? fxodd?
fixnum->string
fxarithmetic-shift-left fxarithmetic-shift-right fxarithmetic-shift
fxmin fxmax
error@fx+)
(import
(ikarus system $fx)
@ -24,6 +25,7 @@
fxpositive? fxnegative?
fxeven? fxodd?
fxarithmetic-shift-left fxarithmetic-shift-right fxarithmetic-shift
fxmin fxmax
fixnum->string))
(define fxzero?
@ -270,6 +272,52 @@
(not ($fxzero? ($fxlogand x 1)))
(error 'fxodd? "~s is not a fixnum" x)))
(define fxmin
(case-lambda
[(x y)
(if (fixnum? x)
(if (fixnum? y)
(if ($fx< x y) x y)
(error 'fxmin "~s is not a fixnum" y))
(error 'fxmin "~s is not a fixnum" x))]
[(x y z . ls)
(fxmin (fxmin x y)
(if (fixnum? z)
(let f ([z z] [ls ls])
(if (null? ls)
z
(let ([a ($car ls)])
(if (fixnum? a)
(if ($fx< a z)
(f a ($cdr ls))
(f z ($cdr ls)))
(error 'fxmin "~s is not a fixnum" a)))))
(error 'fxmin "~s is not a fixnum" z)))]
[(x) (if (fixnum? x) x (error 'fxmin "~s is not a fixnum" x))]))
(define fxmax
(case-lambda
[(x y)
(if (fixnum? x)
(if (fixnum? y)
(if ($fx> x y) x y)
(error 'fxmax "~s is not a fixnum" y))
(error 'fxmax "~s is not a fixnum" x))]
[(x y z . ls)
(fxmax (fxmax x y)
(if (fixnum? z)
(let f ([z z] [ls ls])
(if (null? ls)
z
(let ([a ($car ls)])
(if (fixnum? a)
(if ($fx> a z)
(f a ($cdr ls))
(f z ($cdr ls)))
(error 'fxmax "~s is not a fixnum" a)))))
(error 'fxmax "~s is not a fixnum" z)))]
[(x) (if (fixnum? x) x (error 'fxmax "~s is not a fixnum" x))]))
(module (fixnum->string)
(define f
(lambda (n i j)

2
src/makefile.ss
View File

@ -457,6 +457,8 @@
[fxarithmetic-shift-left i]
[fxarithmetic-shift-right i]
[fxarithmetic-shift i]
[fxmin i]
[fxmax i]
[for-each i r]
[map i r]

4
src/todo-r6rs.ss
View File

@ -286,8 +286,8 @@
[fxif D fx]
[fxior C fx]
[fxlength D fx]
[fxmax S fx]
[fxmin S fx]
[fxmax C fx]
[fxmin C fx]
[fxmod D fx]
[fxmod0 D fx]
[fxnegative? C fx]