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

* moved equal? to ikarus.predicates

This commit is contained in:
Abdulaziz Ghuloum 2007-05-05 05:35:09 -04:00
parent f49897fadf
commit 0f567805fc
3 changed files with 39 additions and 52 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.

49
src/ikarus.core.ss
View File

@ -61,23 +61,6 @@
(primitive-set! x v)
(set-top-level-value! x v)))
(primitive-set! 'string->symbol
(lambda (x)
(unless (string? x)
@ -147,38 +130,6 @@
(f ($symbol-plist x) '()))))
(let ()
(define vector-loop
(lambda (x y i n)
(or ($fx= i n)
(and (equal? ($vector-ref x i) ($vector-ref y i))
(vector-loop x y ($fxadd1 i) n)))))
(define string-loop
(lambda (x y i n)
(or ($fx= i n)
(and ($char= ($string-ref x i) ($string-ref y i))
(string-loop x y ($fxadd1 i) n)))))
(define equal?
(lambda (x y)
(cond
[(eq? x y) #t]
[(pair? x)
(and (pair? y)
(equal? ($car x) ($car y))
(equal? ($cdr x) ($cdr y)))]
[(vector? x)
(and (vector? y)
(let ([n ($vector-length x)])
(and ($fx= n ($vector-length y))
(vector-loop x y 0 n))))]
[(string? x)
(and (string? y)
(let ([n ($string-length x)])
(and ($fx= n ($string-length y))
(string-loop x y 0 n))))]
[(number? x) (and (number? y) (= x y))]
[else #f])))
(primitive-set! 'equal? equal?))

42
src/ikarus.predicates.ss
View File

@ -4,15 +4,16 @@
(export fixnum? flonum? bignum? number? complex? real? rational?
integer? exact? eof-object? immediate? boolean? char?
vector? string? procedure? null? pair? symbol? not
eq? eqv?)
eq? eqv? equal?)
(import
(except (ikarus) fixnum? flonum? bignum? number? complex? real?
rational? integer? exact? eof-object? immediate?
boolean? char? vector? string? procedure? null?
pair? symbol? not eq? eqv?)
pair? symbol? not eq? eqv? equal?)
(only (scheme) $fxadd1 $vector-ref $fx= $char= $string-ref
$string-length $vector-length $car $cdr)
(rename (only (ikarus) fixnum? flonum? bignum? eof-object?
immediate? boolean? char? vector? string? procedure?
null? pair? symbol? eq?)
@ -96,4 +97,39 @@
(lambda (x y)
(or (sys:eq? x y)
(and (number? x) (number? y) (= x y)))))
(module (equal?)
(define vector-loop
(lambda (x y i n)
(or ($fx= i n)
(and (equal? ($vector-ref x i) ($vector-ref y i))
(vector-loop x y ($fxadd1 i) n)))))
(define string-loop
(lambda (x y i n)
(or ($fx= i n)
(and ($char= ($string-ref x i) ($string-ref y i))
(string-loop x y ($fxadd1 i) n)))))
(define equal?
(lambda (x y)
(cond
[(sys:eq? x y) #t]
[(pair? x)
(and (pair? y)
(equal? ($car x) ($car y))
(equal? ($cdr x) ($cdr y)))]
[(vector? x)
(and (vector? y)
(let ([n ($vector-length x)])
(and ($fx= n ($vector-length y))
(vector-loop x y 0 n))))]
[(string? x)
(and (string? y)
(let ([n ($string-length x)])
(and ($fx= n ($string-length y))
(string-loop x y 0 n))))]
[(number? x) (and (number? y) (= x y))]
[else #f]))))
)