mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-19 10:10:23 +02:00
* common-list.scm: Added documentation; largely cut and pasted
from slib docs.
This commit is contained in:
parent
3f557de68c
commit
1669305496
1 changed files with 68 additions and 18 deletions
|
@ -39,35 +39,54 @@
|
||||||
;promotional, or sales literature without prior written consent in
|
;promotional, or sales literature without prior written consent in
|
||||||
;each case.
|
;each case.
|
||||||
|
|
||||||
(define-public (adjoin e l) (if (memq e l) l (cons e l)))
|
(define-public (adjoin e l)
|
||||||
|
"Returns list L, possibly with element E added if it is not already in L."
|
||||||
|
(if (memq e l) l (cons e l)))
|
||||||
|
|
||||||
(define-public (union l1 l2)
|
(define-public (union l1 l2)
|
||||||
|
"Returns a new list that is the union of L1 and L2.
|
||||||
|
Elements that occur in both lists will occur only once
|
||||||
|
in the result list."
|
||||||
(cond ((null? l1) l2)
|
(cond ((null? l1) l2)
|
||||||
((null? l2) l1)
|
((null? l2) l1)
|
||||||
(else (union (cdr l1) (adjoin (car l1) l2)))))
|
(else (union (cdr l1) (adjoin (car l1) l2)))))
|
||||||
|
|
||||||
(define-public (intersection l1 l2)
|
(define-public (intersection l1 l2)
|
||||||
|
"Returns a new list that is the intersection of L1 and L2.
|
||||||
|
Only elements that occur in both lists will occur in the result list."
|
||||||
(cond ((null? l1) l1)
|
(cond ((null? l1) l1)
|
||||||
((null? l2) l2)
|
((null? l2) l2)
|
||||||
((memv (car l1) l2) (cons (car l1) (intersection (cdr l1) l2)))
|
((memv (car l1) l2) (cons (car l1) (intersection (cdr l1) l2)))
|
||||||
(else (intersection (cdr l1) l2))))
|
(else (intersection (cdr l1) l2))))
|
||||||
|
|
||||||
(define-public (set-difference l1 l2)
|
(define-public (set-difference l1 l2)
|
||||||
|
"Return elements from list L1 that are not in list L2."
|
||||||
(cond ((null? l1) l1)
|
(cond ((null? l1) l1)
|
||||||
((memv (car l1) l2) (set-difference (cdr l1) l2))
|
((memv (car l1) l2) (set-difference (cdr l1) l2))
|
||||||
(else (cons (car l1) (set-difference (cdr l1) l2)))))
|
(else (cons (car l1) (set-difference (cdr l1) l2)))))
|
||||||
|
|
||||||
(define-public (reduce-init p init l)
|
(define-public (reduce-init p init l)
|
||||||
|
"Same as `reduce' except it implicitly inserts INIT at the start of L."
|
||||||
(if (null? l)
|
(if (null? l)
|
||||||
init
|
init
|
||||||
(reduce-init p (p init (car l)) (cdr l))))
|
(reduce-init p (p init (car l)) (cdr l))))
|
||||||
|
|
||||||
(define-public (reduce p l)
|
(define-public (reduce p l)
|
||||||
|
"Combines all the elements of sequence L using a binary operation P.
|
||||||
|
The combination is left-associative. For example, using +, one can
|
||||||
|
add up all the elements. `reduce' allows you to apply a function which
|
||||||
|
accepts only two arguments to more than 2 objects. Functional
|
||||||
|
programmers usually refer to this as foldl."
|
||||||
(cond ((null? l) l)
|
(cond ((null? l) l)
|
||||||
((null? (cdr l)) (car l))
|
((null? (cdr l)) (car l))
|
||||||
(else (reduce-init p (car l) (cdr l)))))
|
(else (reduce-init p (car l) (cdr l)))))
|
||||||
|
|
||||||
(define-public (some pred l . rest)
|
(define-public (some pred l . rest)
|
||||||
|
"PRED is a boolean function of as many arguments as there are list
|
||||||
|
arguments to `some'. I.e., L plus any optional arguments. PRED is
|
||||||
|
applied to successive elements of the list arguments in order. `some'
|
||||||
|
returns #t as soon as one of these applications returns #t, and is #f
|
||||||
|
if none returns #t. All the lists should have the same length."
|
||||||
(cond ((null? rest)
|
(cond ((null? rest)
|
||||||
(let mapf ((l l))
|
(let mapf ((l l))
|
||||||
(and (not (null? l))
|
(and (not (null? l))
|
||||||
|
@ -78,6 +97,9 @@
|
||||||
(mapf (cdr l) (map cdr rest))))))))
|
(mapf (cdr l) (map cdr rest))))))))
|
||||||
|
|
||||||
(define-public (every pred l . rest)
|
(define-public (every pred l . rest)
|
||||||
|
"Return #t iff every application of PRED to L, etc., returns #t.
|
||||||
|
Analogous to `some' except it returns #t if every application of
|
||||||
|
PRED is #t and #f otherwise."
|
||||||
(cond ((null? rest)
|
(cond ((null? rest)
|
||||||
(let mapf ((l l))
|
(let mapf ((l l))
|
||||||
(or (null? l)
|
(or (null? l)
|
||||||
|
@ -87,26 +109,49 @@
|
||||||
(and (apply pred (car l) (map car rest))
|
(and (apply pred (car l) (map car rest))
|
||||||
(mapf (cdr l) (map cdr rest))))))))
|
(mapf (cdr l) (map cdr rest))))))))
|
||||||
|
|
||||||
(define-public (notany pred . ls) (not (apply some pred ls)))
|
(define-public (notany pred . ls)
|
||||||
|
"Return #t iff every application of PRED to L, etc., returns #f.
|
||||||
|
Analogous to some but returns #t if no application of PRED returns #t
|
||||||
|
or #f as soon as any one does."
|
||||||
|
(not (apply some pred ls)))
|
||||||
|
|
||||||
(define-public (notevery pred . ls) (not (apply every pred ls)))
|
(define-public (notevery pred . ls)
|
||||||
|
"Return #t iff there is an application of PRED to L, etc., that returns #f.
|
||||||
|
Analogous to some but returns #t as soon as an application of PRED returns #f,
|
||||||
|
or #f otherwise."
|
||||||
|
(not (apply every pred ls)))
|
||||||
|
|
||||||
(define-public (find-if t l)
|
(define-public (find-if pred l)
|
||||||
|
"Searches for the first element in L such that (PRED element)
|
||||||
|
returns #t. If it finds any such element in L, element is
|
||||||
|
returned. Otherwise, #f is returned."
|
||||||
(cond ((null? l) #f)
|
(cond ((null? l) #f)
|
||||||
((t (car l)) (car l))
|
((pred (car l)) (car l))
|
||||||
(else (find-if t (cdr l)))))
|
(else (find-if pred (cdr l)))))
|
||||||
|
|
||||||
(define-public (member-if t l)
|
(define-public (member-if pred l)
|
||||||
|
"Returns L if (T element) is #t for any element in L.
|
||||||
|
Returns #f if PRED does not apply to any element in L."
|
||||||
(cond ((null? l) #f)
|
(cond ((null? l) #f)
|
||||||
((t (car l)) l)
|
((pred (car l)) l)
|
||||||
(else (member-if t (cdr l)))))
|
(else (member-if pred (cdr l)))))
|
||||||
|
|
||||||
(define-public (remove-if p l)
|
(define-public (remove-if p l)
|
||||||
|
"Removes all elements from L where (P element) is #t.
|
||||||
|
Returns everything that's left."
|
||||||
(cond ((null? l) '())
|
(cond ((null? l) '())
|
||||||
((p (car l)) (remove-if p (cdr l)))
|
((p (car l)) (remove-if p (cdr l)))
|
||||||
(else (cons (car l) (remove-if p (cdr l))))))
|
(else (cons (car l) (remove-if p (cdr l))))))
|
||||||
|
|
||||||
|
(define-public (remove-if-not p l)
|
||||||
|
"Removes all elements from L where (P element) is #f.
|
||||||
|
Returns everything that's left."
|
||||||
|
(cond ((null? l) '())
|
||||||
|
((not (p (car l))) (remove-if p (cdr l)))
|
||||||
|
(else (cons (car l) (remove-if p (cdr l))))))
|
||||||
|
|
||||||
(define-public (delete-if! pred list)
|
(define-public (delete-if! pred list)
|
||||||
|
"Destructive version of `remove-if'."
|
||||||
(let delete-if ((list list))
|
(let delete-if ((list list))
|
||||||
(cond ((null? list) '())
|
(cond ((null? list) '())
|
||||||
((pred (car list)) (delete-if (cdr list)))
|
((pred (car list)) (delete-if (cdr list)))
|
||||||
|
@ -115,6 +160,7 @@
|
||||||
list))))
|
list))))
|
||||||
|
|
||||||
(define-public (delete-if-not! pred list)
|
(define-public (delete-if-not! pred list)
|
||||||
|
"Destructive version of `remove-if-not'."
|
||||||
(let delete-if ((list list))
|
(let delete-if ((list list))
|
||||||
(cond ((null? list) '())
|
(cond ((null? list) '())
|
||||||
((not (pred (car list))) (delete-if (cdr list)))
|
((not (pred (car list))) (delete-if (cdr list)))
|
||||||
|
@ -123,6 +169,7 @@
|
||||||
list))))
|
list))))
|
||||||
|
|
||||||
(define-public (butlast lst n)
|
(define-public (butlast lst n)
|
||||||
|
"Return all but the last N elements of LST."
|
||||||
(letrec ((l (- (length lst) n))
|
(letrec ((l (- (length lst) n))
|
||||||
(bl (lambda (lst n)
|
(bl (lambda (lst n)
|
||||||
(cond ((null? lst) lst)
|
(cond ((null? lst) lst)
|
||||||
|
@ -134,21 +181,27 @@
|
||||||
l))))
|
l))))
|
||||||
|
|
||||||
(define-public (and? . args)
|
(define-public (and? . args)
|
||||||
|
"Return #t iff all of ARGS are #t."
|
||||||
(cond ((null? args) #t)
|
(cond ((null? args) #t)
|
||||||
((car args) (apply and? (cdr args)))
|
((car args) (apply and? (cdr args)))
|
||||||
(else #f)))
|
(else #f)))
|
||||||
|
|
||||||
(define-public (or? . args)
|
(define-public (or? . args)
|
||||||
|
"Return #t iff any of ARGS is #t."
|
||||||
(cond ((null? args) #f)
|
(cond ((null? args) #f)
|
||||||
((car args) #t)
|
((car args) #t)
|
||||||
(else (apply or? (cdr args)))))
|
(else (apply or? (cdr args)))))
|
||||||
|
|
||||||
(define-public (has-duplicates? lst)
|
(define-public (has-duplicates? lst)
|
||||||
|
"Return #t iff 2 members of LST are equal?, else #f."
|
||||||
(cond ((null? lst) #f)
|
(cond ((null? lst) #f)
|
||||||
((member (car lst) (cdr lst)) #t)
|
((member (car lst) (cdr lst)) #t)
|
||||||
(else (has-duplicates? (cdr lst)))))
|
(else (has-duplicates? (cdr lst)))))
|
||||||
|
|
||||||
(define-public (list* x . y)
|
(define-public (list* x . y)
|
||||||
|
"Works like `list' except that the cdr of the last pair is
|
||||||
|
the last argument unless there is only one argument, when
|
||||||
|
th result is just that argument. Sometiems called cons*."
|
||||||
(define (list*1 x)
|
(define (list*1 x)
|
||||||
(if (null? (cdr x))
|
(if (null? (cdr x))
|
||||||
(car x)
|
(car x)
|
||||||
|
@ -157,11 +210,9 @@
|
||||||
x
|
x
|
||||||
(cons x (list*1 y))))
|
(cons x (list*1 y))))
|
||||||
|
|
||||||
;; pick p l
|
|
||||||
;; Apply P to each element of L, returning a list of elts
|
|
||||||
;; for which P returns a non-#f value.
|
|
||||||
;;
|
|
||||||
(define-public (pick p l)
|
(define-public (pick p l)
|
||||||
|
"Apply P to each element of L, returning a list of elts
|
||||||
|
for which P returns a non-#f value."
|
||||||
(let loop ((s '())
|
(let loop ((s '())
|
||||||
(l l))
|
(l l))
|
||||||
(cond
|
(cond
|
||||||
|
@ -169,11 +220,9 @@
|
||||||
((p (car l)) (loop (cons (car l) s) (cdr l)))
|
((p (car l)) (loop (cons (car l) s) (cdr l)))
|
||||||
(else (loop s (cdr l))))))
|
(else (loop s (cdr l))))))
|
||||||
|
|
||||||
;; pick p l
|
|
||||||
;; Apply P to each element of L, returning a list of the
|
|
||||||
;; non-#f return values of P.
|
|
||||||
;;
|
|
||||||
(define-public (pick-mappings p l)
|
(define-public (pick-mappings p l)
|
||||||
|
"Apply P to each element of L, returning a list of the
|
||||||
|
non-#f return values of P."
|
||||||
(let loop ((s '())
|
(let loop ((s '())
|
||||||
(l l))
|
(l l))
|
||||||
(cond
|
(cond
|
||||||
|
@ -182,6 +231,7 @@
|
||||||
(else (loop s (cdr l))))))
|
(else (loop s (cdr l))))))
|
||||||
|
|
||||||
(define-public (uniq l)
|
(define-public (uniq l)
|
||||||
|
"Return a list containing elements of L, with duplicates removed."
|
||||||
(if (null? l)
|
(if (null? l)
|
||||||
'()
|
'()
|
||||||
(let ((u (uniq (cdr l))))
|
(let ((u (uniq (cdr l))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue