From df99edbcbe832030d46fc49c8d321cf5fa42cd64 Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Fri, 1 Apr 2005 23:48:42 +0000 Subject: [PATCH] (lset-union): Rewrite to accumulate result by consing in the order specified by the SRFI. --- srfi/srfi-1.scm | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/srfi/srfi-1.scm b/srfi/srfi-1.scm index 9ee1083be..7e763c994 100644 --- a/srfi/srfi-1.scm +++ b/srfi/srfi-1.scm @@ -988,15 +988,17 @@ (lp (cdr l) (cons (car l) acc)))))) (define (lset-union = . rest) - (let lp0 ((l rest) (acc '())) - (if (null? l) - (reverse! acc) - (let lp1 ((ll (car l)) (acc acc)) - (if (null? ll) - (lp0 (cdr l) acc) - (if (member (car ll) acc =) - (lp1 (cdr ll) acc) - (lp1 (cdr ll) (cons (car ll) acc)))))))) + (let ((acc '())) + (for-each (lambda (lst) + (if (null? acc) + (set! acc lst) + (for-each (lambda (elem) + (if (not (member elem acc + (lambda (x y) (= y x)))) + (set! acc (cons elem acc)))) + lst))) + rest) + acc)) (define (lset-intersection = list1 . rest) (let lp ((l list1) (acc '()))