bug-mit-scheme
[Top][All Lists]

## [Bug-mit-scheme] lset-xor definition is wrong.

 From: Gerald Jay Sussman Subject: [Bug-mit-scheme] lset-xor definition is wrong. Date: Tue, 19 Jan 2010 21:03:19 -0500

```;;; In the src/runtime file srfi-1.scm the code is

(define (lset-xor = . lists)
(reduce (lambda (b a)                 ; Compute A xor B:
;; Note that this code relies on the constant-time
;; short-cuts provided by LSET-DIFF+INTERSECTION,
;; LSET-DIFFERENCE & APPEND to provide constant-time short
;; cuts for the cases A = (), B = (), and A eq? B. It takes
;; a careful case analysis to see it, but it's carefully
;; built in.

;; Compute a-b and a^b, then compute b-(a^b) and
;; cons it onto the front of a-b.
(receive (a-b a-int-b)   (lset-diff+intersection = a b)
(cond ((null? a-b)     (lset-difference b a =))
((null? a-int-b) (append b a))
(else (fold (lambda (xb ans)
(if (member xb a-int-b =) ans (cons xb ans)))
a-b
b)))))
'() lists))

;;; It should be

(define (lset-xor = . lists)
(reduce (lambda (b a)                 ; Compute A xor B:
;; Note that this code relies on the constant-time
;; short-cuts provided by LSET-DIFF+INTERSECTION,
;; LSET-DIFFERENCE & APPEND to provide constant-time short
;; cuts for the cases A = (), B = (), and A eq? B. It takes
;; a careful case analysis to see it, but it's carefully
;; built in.

;; Compute a-b and a^b, then compute b-(a^b) and
;; cons it onto the front of a-b.
(receive (a-b a-int-b)   (lset-diff+intersection = a b)
(cond ((null? a-b)     (lset-difference = b a))
((null? a-int-b) (append b a))
(else (fold (lambda (xb ans)
(if (member xb a-int-b =) ans (cons xb ans)))
a-b
b)))))
'() lists))

;;; the difference is (lset-difference = b a) --- the predicate is in the wrong
position.

;;; An example the old thing gets wrong is (lset-xor eq? '(foo bar) '(foo bar))

```