<div dir="ltr"><div><div><div><div><div>Marc, <br><br></div>Can we get an implementation of equal? that works for recursive structures per r7rs? <br></div><div>It doesn't need to be called equal?, it can be called equal-shared? for instance.<br></div><div><br></div>I have an initial implementation that works with shared structures, but there is an edge case:<br></div>If there is a shared object in the structure (without recursion) it needs to be eq? to its counterpart.<br></div><br>(def (r7rs-equal? obj1 obj2)<br>  (def ht (make-hash-table-eq))<br><br>  (def (equal obj1 obj2)<br>    (cond<br>     ((##eq? obj1 obj2))<br>     ((immediate? obj1) #f)             ; should be eq?<br>     ((number? obj1)<br>      (##eqv? obj1 obj2))<br>     ((##table-ref ht obj1 #f)<br>      => (cut ##eq? <> obj2))         ; edge case mentioned above<br>     ((##pair? obj1)<br>      (and (##pair? obj2)<br>           (begin<br>             (##table-set! ht obj1 obj2)<br>             (and (equal (##car obj1) (##car obj2))<br>                  (equal (##cdr obj1) (##cdr obj2))))))<br>     ((##vector? obj1)<br>      (and (##vector? obj2)<br>           (let (len (##vector-length obj1))<br>             (and (##fx= len (##vector-length obj2))<br>                  (begin (##table-set! ht obj1 obj2)<br>                         (vector-equal obj1 obj2 0 len))))))<br>     ((##string? obj2)<br>      (and (##string? obj2)<br>           (##string-equal? obj1 obj2)))<br>     ((##u8vector? obj1)<br>      (and (##u8vector? obj2)<br>           (##u8vector-equal? obj1 obj2)))<br>     ((##s8vector? obj1)<br>      (and (##s8vector? obj2)<br>           (##s8vector-equal? obj1 obj2)))<br>     ((##u16vector? obj1)<br>      (and (##u16vector? obj2)<br>           (##u16vector-equal? obj1 obj2)))<br>     ((##s16vector? obj1)<br>      (and (##s16vector? obj2)<br>           (##s16vector-equal? obj1 obj2)))<br>     ((##u32vector? obj1)<br>      (and (##u32vector? obj2)<br>           (##u32vector-equal? obj1 obj2)))<br>     ((##s32vector? obj1)<br>      (and (##s32vector? obj2)<br>           (##s32vector-equal? obj1 obj2)))<br>     ((##u64vector? obj1)<br>      (and (##u64vector? obj2)<br>           (##u64vector-equal? obj1 obj2)))<br>     ((##s64vector? obj1)<br>      (and (##s64vector? obj2)<br>           (##s64vector-equal? obj1 obj2)))<br>     ((##f32vector? obj1)<br>      (and (##f32vector? obj2)<br>           (##f32vector-equal? obj1 obj2)))<br>     ((##f64vector? obj1)<br>      (and (##f64vector? obj2)<br>           (##f64vector-equal? obj1 obj2)))<br>     ((table? obj1)<br>      (and (table? obj2)<br>           (begin<br>             (##table-set! ht obj1 obj2)<br>             (table-equal obj1 obj2))))<br>     ((##structure? obj1)<br>      (and (##structure? obj2)<br>           (let* ((t1 (##structure-type obj1))<br>                  (t2 (##structure-type obj2))<br>                  (tid1 (##type-id t1))<br>                  (tid2 (##type-id t2)))<br>             (and (##eq? tid1 tid2)<br>                  (let (len (##vector-length obj1))<br>                    (and (##fx= len (##vector-length obj2))<br>                         (##fx= (##fxand (##type-flags t1) 1) 0) ; not opaque<br>                         (begin<br>                           (##table-set! ht obj1 obj2)<br>                           (vector-equal obj1 obj2 1 len))))))))<br>     ((##box? obj1)<br>      (and (##box? obj2)<br>           (begin<br>             (##table-set! ht obj1 obj2)<br>             (equal (##unbox obj1) (##unbox obj2)))))<br>     (else #f)))<br><br>  (def (vector-equal obj1 obj2 i len)<br>    (let lp ((i i))<br>      (if (##fx< i len)<br>        (and (equal (##vector-ref obj1 i) (##vector-ref obj2 i))<br>             (lp (##fx+ i 1)))<br>        #t)))<br><br>  (def (table-equal obj1 obj2)<br>    (and (##fx= (##vector-ref obj1 1) ; flags<br>                (##vector-ref obj2 1))<br>         (##eq? (##vector-ref obj1 2) ; test<br>                (##vector-ref obj2 2))<br>         (##eq? (##vector-ref obj1 3) ; hash<br>                (##vector-ref obj2 3))<br>         (##fx= (##table-length obj1)<br>                (##table-length obj2))<br>         (not (##table-search<br>               (lambda (k1 v1)<br>                 (let (v2 (##table-ref obj2 k1 nil))<br>                   (not (equal v1 v2))))<br>               obj1))))<br><br>  (equal obj1 obj2))<br><br></div>-- vyzo<br></div>