Nice idea!
What about also adding an equality-hashing algorithm for cyclical structures this way also, so hashtables could work also?
2017-09-14 16:15 GMT+08:00 Dimitris Vyzovitis vyzo@hackzen.org:
Marc,
Can we get an implementation of equal? that works for recursive structures per r7rs? It doesn't need to be called equal?, it can be called equal-shared? for instance.
I have an initial implementation that works with shared structures, but there is an edge case: If there is a shared object in the structure (without recursion) it needs to be eq? to its counterpart.
(def (r7rs-equal? obj1 obj2) (def ht (make-hash-table-eq))
(def (equal obj1 obj2) (cond ((##eq? obj1 obj2)) ((immediate? obj1) #f) ; should be eq? ((number? obj1) (##eqv? obj1 obj2)) ((##table-ref ht obj1 #f) => (cut ##eq? <> obj2)) ; edge case mentioned above ((##pair? obj1) (and (##pair? obj2) (begin (##table-set! ht obj1 obj2) (and (equal (##car obj1) (##car obj2)) (equal (##cdr obj1) (##cdr obj2)))))) ((##vector? obj1) (and (##vector? obj2) (let (len (##vector-length obj1)) (and (##fx= len (##vector-length obj2)) (begin (##table-set! ht obj1 obj2) (vector-equal obj1 obj2 0 len)))))) ((##string? obj2) (and (##string? obj2) (##string-equal? obj1 obj2))) ((##u8vector? obj1) (and (##u8vector? obj2) (##u8vector-equal? obj1 obj2))) ((##s8vector? obj1) (and (##s8vector? obj2) (##s8vector-equal? obj1 obj2))) ((##u16vector? obj1) (and (##u16vector? obj2) (##u16vector-equal? obj1 obj2))) ((##s16vector? obj1) (and (##s16vector? obj2) (##s16vector-equal? obj1 obj2))) ((##u32vector? obj1) (and (##u32vector? obj2) (##u32vector-equal? obj1 obj2))) ((##s32vector? obj1) (and (##s32vector? obj2) (##s32vector-equal? obj1 obj2))) ((##u64vector? obj1) (and (##u64vector? obj2) (##u64vector-equal? obj1 obj2))) ((##s64vector? obj1) (and (##s64vector? obj2) (##s64vector-equal? obj1 obj2))) ((##f32vector? obj1) (and (##f32vector? obj2) (##f32vector-equal? obj1 obj2))) ((##f64vector? obj1) (and (##f64vector? obj2) (##f64vector-equal? obj1 obj2))) ((table? obj1) (and (table? obj2) (begin (##table-set! ht obj1 obj2) (table-equal obj1 obj2)))) ((##structure? obj1) (and (##structure? obj2) (let* ((t1 (##structure-type obj1)) (t2 (##structure-type obj2)) (tid1 (##type-id t1)) (tid2 (##type-id t2))) (and (##eq? tid1 tid2) (let (len (##vector-length obj1)) (and (##fx= len (##vector-length obj2)) (##fx= (##fxand (##type-flags t1) 1) 0) ; not opaque (begin (##table-set! ht obj1 obj2) (vector-equal obj1 obj2 1 len)))))))) ((##box? obj1) (and (##box? obj2) (begin (##table-set! ht obj1 obj2) (equal (##unbox obj1) (##unbox obj2))))) (else #f)))
(def (vector-equal obj1 obj2 i len) (let lp ((i i)) (if (##fx< i len) (and (equal (##vector-ref obj1 i) (##vector-ref obj2 i)) (lp (##fx+ i 1))) #t)))
(def (table-equal obj1 obj2) (and (##fx= (##vector-ref obj1 1) ; flags (##vector-ref obj2 1)) (##eq? (##vector-ref obj1 2) ; test (##vector-ref obj2 2)) (##eq? (##vector-ref obj1 3) ; hash (##vector-ref obj2 3)) (##fx= (##table-length obj1) (##table-length obj2)) (not (##table-search (lambda (k1 v1) (let (v2 (##table-ref obj2 k1 nil)) (not (equal v1 v2)))) obj1))))
(equal obj1 obj2))
-- vyzo
Gambit-list mailing list Gambit-list@iro.umontreal.ca https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list