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