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

* removed the 3-arg dispatch in the generic =, <,, <=, >, >=

This commit is contained in:
Abdulaziz Ghuloum 2007-06-12 17:32:25 +03:00
parent f05f8965d6
commit 5f1b44106a
3 changed files with 51 additions and 156 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.

199
src/ikarus.numerics.ss
View File

@ -1016,162 +1016,49 @@
[(number? x)
(or (null? ls) (loopf (car ls) (cdr ls)))]
[else (err x)])))
(case-lambda
[(x y)
(cond
[(fixnum? x)
(cond
[(fixnum? y) (fxfx< x y)]
[(bignum? y) (fxbn< x y)]
[(flonum? y) (fxfl< x y)]
[(ratnum? y) (fxrt< x y)]
[else (err y)])]
[(bignum? x)
(cond
[(fixnum? y) (bnfx< x y)]
[(bignum? y) (bnbn< x y)]
[(flonum? y) (bnfl< x y)]
[(ratnum? y) (bnrt< x y)]
[else (err y)])]
[(flonum? x)
(cond
[(fixnum? y) (flfx< x y)]
[(bignum? y) (flbn< x y)]
[(flonum? y) (flfl< x y)]
[(ratnum? y) (flrt< x y)]
[else (err y)])]
[(ratnum? x)
(cond
[(fixnum? y) (rtfx< x y)]
[(bignum? y) (rtbn< x y)]
[(flonum? y) (rtfl< x y)]
[(ratnum? y) (rtrt< x y)]
[else (err y)])]
[else (err x)])]
[(x y z)
(cond
[(fixnum? x)
(cond
[(fixnum? y)
(cond
[(fixnum? z) (and (fxfx< x y) (fxfx< y z))]
[(bignum? z)
(and (fxfx< x y) (fxbn< y z))]
[(flonum? z)
(and (fxfx< x y) (fxfl< y z))]
[(ratnum? z)
(and (fxfx< x y) (fxrt< y z))]
[else (err z)])]
[(bignum? y)
(cond
[(fixnum? z) #f]
[(bignum? z)
(and (fxbn< x y) (bnbn< y z))]
[(flonum? z)
(and (fxbn< x y) (bnfl< y z))]
[(ratnum? z)
(and (fxbn< x y) (bnrt< y z))]
[else (err z)])]
[(flonum? y)
(cond
[(fixnum? z)
(and (fxfx< x z)
(fxfl< x y)
(flfx< y z))]
[(bignum? z)
(and (fxbn< x z)
(fxfl< x y)
(flbn< y z))]
[(flonum? z)
(and (flfl< y z) (fxfl< x y))]
[(ratnum? z)
(and (fxfl< x y) (flrt< y z))]
[else (err z)])]
[(ratnum? y)
(and (fxrt< x y) (name y z))]
[else (err y)])]
[(bignum? x)
(cond
[(fixnum? y)
(cond
[(fixnum? z) (and (fxfx< y z) (bnfx< x y))]
[(bignum? z)
(and (bnfx< x y) (bnfx< y z))]
[(flonum? z)
(and (bnfx< x y) (fxfl< y z))]
[(ratnum? z)
(and (bnfx< x y) (fxrt< y z))]
[else (err z)])]
[(bignum? y)
(cond
[(fixnum? z) (and (bnfx< y z) (bnbn< x y))]
[(bignum? z) (and (bnbn< x y) (bnbn< y z))]
[(flonum? z) (and (bnfl< y z) (bnbn< x y))]
[(ratnum? z) (and (bnbn< x y) (bnrt< y z))]
[else (err z)])]
[(flonum? y)
(cond
[(fixnum? z)
(and (flfx< y z) (bnfl< x y))]
[(bignum? z)
(and (bnfl< x y) (flbn< y z))]
[(flonum? z)
(and (flfl< y z) (bnfl< x y))]
[(ratnum? z)
(and (flrt< y z) (bnfl< x y))]
[else (err z)])]
[(ratnum? y)
(and (bnrt< x y) (name y z))]
[else (err y)])]
[(flonum? x)
(cond
[(fixnum? y)
(cond
[(fixnum? z)
(and (fxfx< y z) (flfx< x y))]
[(bignum? z)
(and (flfx< x y) (fxbn< y z))]
[(flonum? z)
(and (flfx< x y) (fxfl< y z))]
[(ratnum? z)
(and (flfx< x y) (fxrt< y z))]
[else (err z)])]
[(bignum? y)
(cond
[(fixnum? z)
(and (bnfx< y z) (flbn< x y))]
[(bignum? z)
(and (bnbn< y z) (flbn< x y))]
[(flonum? z)
(and (flbn< x y) (bnfl< y z))]
[(ratnum? z)
(and (flbn< x y) (bnrt< y z))]
[else (err z)])]
[(flonum? y)
(cond
[(fixnum? z)
(and (flfx< y z) (flfl< x y))]
[(bignum? z)
(and (flfl< x y) (flbn< y z))]
[(flonum? z)
(and (flfl< x y) (flfl< y z))]
[(ratnum? z)
(and (flfl< x y) (flrt< y z))]
[else (err z)])]
[(ratnum? y)
(and (flrt< x y) (name y z))]
[else (err y)])]
[(ratnum? x)
(and (name x y) (name y z))]
[else (err x)])]
[(x) (if (number? x) #t (err x))]
[(x y . ls)
(cond
[(fixnum? x) (fxloopt x y ls)]
[(bignum? x) (bnloopt x y ls)]
[(flonum? x) (flloopt x y ls)]
[(ratnum? x) (rtloopt x y ls)]
[else (err x)])]))]))
(define f
(case-lambda
[(x y)
(cond
[(fixnum? x)
(cond
[(fixnum? y) (fxfx< x y)]
[(bignum? y) (fxbn< x y)]
[(flonum? y) (fxfl< x y)]
[(ratnum? y) (fxrt< x y)]
[else (err y)])]
[(bignum? x)
(cond
[(fixnum? y) (bnfx< x y)]
[(bignum? y) (bnbn< x y)]
[(flonum? y) (bnfl< x y)]
[(ratnum? y) (bnrt< x y)]
[else (err y)])]
[(flonum? x)
(cond
[(fixnum? y) (flfx< x y)]
[(bignum? y) (flbn< x y)]
[(flonum? y) (flfl< x y)]
[(ratnum? y) (flrt< x y)]
[else (err y)])]
[(ratnum? x)
(cond
[(fixnum? y) (rtfx< x y)]
[(bignum? y) (rtbn< x y)]
[(flonum? y) (rtfl< x y)]
[(ratnum? y) (rtrt< x y)]
[else (err y)])]
[else (err x)])]
[(x y z) (and (f x y) (f y z))]
[(x) (if (number? x) #t (err x))]
[(x y . ls)
(cond
[(fixnum? x) (fxloopt x y ls)]
[(bignum? x) (bnloopt x y ls)]
[(flonum? x) (flloopt x y ls)]
[(ratnum? x) (rtloopt x y ls)]
[else (err x)])]))
f)]))
(define-syntax false (syntax-rules () [(_ x y) #f]))
(define-syntax bnbncmp

8
src/ikarus.reader.ss
View File

@ -251,9 +251,17 @@
(module (tok-exact tok-radix tok-real tok-real-sign tok-real-digit tok-real-decpt)
(define (eof-error)
(error 'tokenize "eof encountered while reading a number"))
;(define-syntax digit? syntax-error)
(define (digit? c)
(memq c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
#\a #\b #\c #\d #\e #\f #\A #\B #\C #\D #\E #\F)))
(define (digit/radix? c radix)
(case radix
[(10) (char<=? #\0 c #\9)]
[(16) (or (char<=? #\0 c #\9) (char<=? #\a c #\f) (char<=? #\A c #\F))]
[(8) (char<=? #\0 c #\7)]
[(2) (memv c '(#\0 #\1))]
[else #f]))
(define (exponent-marker? c)
(memq c '(#\e #\E #\s #\S #\f #\F #\d #\D #\l #\L)))
(define (tok-complex-sign p)