Replace list-equal? with a cycle-aware predicate

This is the final part of issue #1

Author: Aethaeryn

scheme-core.lisp

@@ -74,11 +74,36 @@ rules provided in the r7rs-small specification.
     (character (typecase y (character (char= x y))))
     (t (eq x y))))
 
-;;; TODO: Must always terminate even if the list is circular.
-(defun list-equal? (x y)
-  (or (and (null x) (eql x y))
-      (and (equal? (car x) (car y))
-           (list-equal? (cdr x) (cdr y)))))
+;;; TODO: If circular and equal?, then this iterates too much because
+;;; it goes to the first detected part of the cycle rather than to the
+;;; start of it. It can't just stop at the detection of the cycle
+;;; because of e.g. '(-1 0 . #1=(1 2 3 4 5 6 7 8 9 . #1#))
+(define-function list-equal? ((list1 list) (list2 list))
+  ;; Note: Tested in a more verbose way so that the list lengths match
+  ;; in the ALWAYS test and so lists with cycles always terminate.
+  (loop :with end? := nil
+        :with cycle-x := nil
+        :with cycle-y := nil
+        :for x := list1 :then (cdr x)
+        :for y := list2 :then (cdr y)
+        ;; For cycle testing to ensure termination
+        :for x-fast := list1 :then (cddr x-fast)
+        :for y-fast := list2 :then (cddr y-fast)
+        :for i :from 0
+        :until end?
+        ;; Recursive equality test
+        :always (or (and (endp x) (endp y))
+                    (equal? (car x) (car y)))
+        :do
+           ;; End test
+           (when (or (endp x) (endp y) (eq x cycle-x) (eq y cycle-y))
+             (setf end? t))
+           ;; Cycle tests
+           (when (plusp i)
+             (when (and x-fast (not cycle-x) (eq x x-fast))
+               (setf cycle-x x))
+             (when (and y-fast (not cycle-y) (eq y y-fast))
+               (setf cycle-y y)))))
 
 (defun vector-equal? (x y)
   (and (typep y (type-of x))