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) (primitive-set! x v)
(set-top-level-value! x v))) (set-top-level-value! x v)))
(primitive-set! 'string->symbol (primitive-set! 'string->symbol
(lambda (x) (lambda (x)
(unless (string? x) (unless (string? x)
@ -147,38 +130,6 @@
(f ($symbol-plist x) '())))) (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? (export fixnum? flonum? bignum? number? complex? real? rational?
integer? exact? eof-object? immediate? boolean? char? integer? exact? eof-object? immediate? boolean? char?
vector? string? procedure? null? pair? symbol? not vector? string? procedure? null? pair? symbol? not
eq? eqv?) eq? eqv? equal?)
(import (import
(except (ikarus) fixnum? flonum? bignum? number? complex? real? (except (ikarus) fixnum? flonum? bignum? number? complex? real?
rational? integer? exact? eof-object? immediate? rational? integer? exact? eof-object? immediate?
boolean? char? vector? string? procedure? null? 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? (rename (only (ikarus) fixnum? flonum? bignum? eof-object?
immediate? boolean? char? vector? string? procedure? immediate? boolean? char? vector? string? procedure?
null? pair? symbol? eq?) null? pair? symbol? eq?)
@ -96,4 +97,39 @@
(lambda (x y) (lambda (x y)
(or (sys:eq? x y) (or (sys:eq? x y)
(and (number? x) (number? y) (= 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]))))
) )