summaryrefslogtreecommitdiff
path: root/module/srfi/srfi-1.scm
diff options
context:
space:
mode:
authorRob Browning <rlb@defaultvalue.org>2024-07-17 23:12:14 -0500
committerRob Browning <rlb@defaultvalue.org>2024-07-30 19:28:37 -0500
commit945c97b14d4f07f3f70b72efff8a18625603035c (patch)
tree09ea3baf8f438b38d02fdc1b8b292e2790c1bbc2 /module/srfi/srfi-1.scm
parent3eb6afe738b313deac6b43cc4c883f70179f48cc (diff)
downloadguile-945c97b14d4f07f3f70b72efff8a18625603035c.tar.gz
srfi-1 lset-difference!: move from C to Scheme
* libguile/srfi-1.c (scm_srfi1_lset-difference_x): delete. * libguile/srfi-1.h (scm_srfi1_lset-difference_x): delete. * module/srfi/srfi-1.scm: add lset-difference!. * test-suite/tests/srfi-1.test: extend lset-difference! tests to cover lset-difference.
Diffstat (limited to 'module/srfi/srfi-1.scm')
-rw-r--r--module/srfi/srfi-1.scm24
1 files changed, 24 insertions, 0 deletions
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 49ee46e40..01413c963 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -1350,6 +1350,30 @@ given REST parameters."
(check-arg procedure? = lset-intersection!)
(apply lset-intersection = list1 rest)) ; XXX:optimize
+(define (lset-difference! = lset . removals)
+ "Return @var{lst} with any elements in the lists in @var{removals}
+removed (ie.@: subtracted). For only one @var{lst} argument, just that
+list is returned.
+
+The given @var{equal} procedure is used for comparing elements, called
+as @code{(@var{equal} elem1 elemN)}. The first argument is from
+@var{lst} and the second from one of the subsequent lists. But exactly
+which calls are made and in what order is unspecified.
+
+@example
+(lset-difference! eqv? (list 'x 'y)) @result{} (x y)
+(lset-difference! eqv? (list 1 2 3) '(3 1)) @result{} (2)
+(lset-difference! eqv? (list 1 2 3) '(3) '(2)) @result{} (1)
+@end example
+
+@code{lset-difference!} may modify @var{lst} to form its result."
+ (check-arg procedure? = lset-intersection!)
+ (cond
+ ((null? lset) lset)
+ ((null? removals) lset)
+ (else (remove! (lambda (x) (any (lambda (s) (member x s =)) removals))
+ lset))))
+
(define (lset-xor! = . rest)
(check-arg procedure? = lset-xor!)
(apply lset-xor = rest)) ; XXX:optimize