wilderjds
/
dash.el
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix clients of -compare-fn

Browse Source 
* NEWS.md (2.19.2): Rename...
(2.20.0): ...to this.  Announce changes.
* README.md:
* dash.texi: Regenerate docs.

* dash.el (-compare-fn): Clarify docstring.
(dash--member-fn, dash--hash-test-fn, dash--size+): New convenience
functions.
(dash--short-list-length): New variable.
(-distinct, -union, -intersection, -difference): Check for empty
list early.  Prefer dash--member-fn over -contains? for speed.
Exclude duplicates from return value.  Use a hash table for long
lists, but avoid its overhead for short lists.
(-contains?): Delegate to member if -compare-fn is either equal or
nil, not just nil.  Reimplement in terms of dash--member-fn.
(-same-items?): Support multisets of different length.  Use hash
tables for long lists.

* dev/examples.el (-same-items?): Move from "Predicates" to "Set
operations".  Extend tests.
(-contains?, -union, -difference, -intersection, -distinct): Extend
tests.
(dash--member-fn, dash--hash-test-fn, dash--size+): New tests.
master
Basil L. Contovounesios 4 years ago
parent ae0ce7959e
commit 112aa7c251
No known key found for this signature in database
GPG Key ID: 205AB54A5D5D8CFF
5 changed files with 492 additions and 210 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 17
      NEWS.md
  2. 94
      README.md
  3. 265
      dash.el
  4. 114
      dash.texi
  5. 212
      dev/examples.el

17
NEWS.md
Unescape View File

@ -6,12 +6,27 @@ See the end of the file for license conditions.
## Change log
### From 2.19.1 to 2.19.2
### From 2.19.1 to 2.20.0
#### Fixes
- Fixed a regression from `2.18` in `-take` that caused it to
prematurely signal an error on improper lists (#393).
- The functions `-union`, `-intersection`, and `-difference` now
return proper sets, without duplicate elements (#397).
- The function `-same-items?` now works on multisets (lists with
duplicate elements and/or different lengths) (#397).
For example, the following now returns non-`nil`:
```el
(-same-items? '(1 1 2 3) '(1 2 3))
```
#### New features
- The function `-contains?` now returns the matching tail of the list
instead of just `t`, similarly to `member` (#397).
### From 2.19.0 to 2.19.1

94
README.md
Unescape View File

@ -222,7 +222,6 @@ Reductions of one or more lists to a boolean value.
* [`-none?`](#-none-pred-list) `(pred list)`
* [`-only-some?`](#-only-some-pred-list) `(pred list)`
* [`-contains?`](#-contains-list-element) `(list element)`
* [`-same-items?`](#-same-items-list-list2) `(list list2)`
* [`-is-prefix?`](#-is-prefix-prefix-list) `(prefix list)`
* [`-is-suffix?`](#-is-suffix-suffix-list) `(suffix list)`
* [`-is-infix?`](#-is-infix-infix-list) `(infix list)`
@ -266,12 +265,13 @@ related predicates.
Operations pretending lists are sets.
* [`-union`](#-union-list-list2) `(list list2)`
* [`-difference`](#-difference-list-list2) `(list list2)`
* [`-intersection`](#-intersection-list-list2) `(list list2)`
* [`-union`](#-union-list1-list2) `(list1 list2)`
* [`-difference`](#-difference-list1-list2) `(list1 list2)`
* [`-intersection`](#-intersection-list1-list2) `(list1 list2)`
* [`-powerset`](#-powerset-list) `(list)`
* [`-permutations`](#-permutations-list) `(list)`
* [`-distinct`](#-distinct-list) `(list)`
* [`-same-items?`](#-same-items-list1-list2) `(list1 list2)`
### Other list operations
@ -1380,28 +1380,15 @@ Alias: `-only-some-p`
Return non-`nil` if `list` contains `element`.
The test for equality is done with `equal`, or with `-compare-fn`
if that's non-`nil`.
if that is non-`nil`. As with `member`, the return value is
actually the tail of `list` whose car is `element`.
Alias: `-contains-p`
Alias: `-contains-p`.
```el
(-contains? '(1 2 3) 1) ;; => t
(-contains? '(1 2 3) 2) ;; => t
(-contains? '(1 2 3) 4) ;; => nil
```
#### -same-items? `(list list2)`
Return true if `list` and `list2` has the same items.
The order of the elements in the lists does not matter.
Alias: `-same-items-p`
```el
(-same-items? '(1 2 3) '(1 2 3)) ;; => t
(-same-items? '(1 2 3) '(3 2 1)) ;; => t
(-same-items? '(1 2 3) '(1 2 3 4)) ;; => nil
(-contains? '(1 2 3) 1) ;; => (1 2 3)
(-contains? '(1 2 3) 2) ;; => (2 3)
(-contains? '(1 2 3) 4) ;; => ()
```
#### -is-prefix? `(prefix list)`
@ -1774,23 +1761,25 @@ permutation to `list` sorts it in descending order.
Operations pretending lists are sets.
#### -union `(list list2)`
#### -union `(list1 list2)`
Return a new list of distinct elements appearing in either `list1` or `list2`.
Return a new list of all elements appearing in either `list1` or `list2`.
Equality is defined by the value of `-compare-fn` if non-`nil`;
otherwise `equal`.
The test for equality is done with `equal`, or with `-compare-fn`
if that is non-`nil`.
```el
(-union '(1 2 3) '(3 4 5)) ;; => (1 2 3 4 5)
(-union '(1 2 3 4) ()) ;; => (1 2 3 4)
(-union '(1 1 2 2) '(3 2 1)) ;; => (1 1 2 2 3)
(-union '(1 2 2 4) ()) ;; => (1 2 4)
(-union '(1 1 2 2) '(4 4 3 2 1)) ;; => (1 2 4 3)
```
#### -difference `(list list2)`
#### -difference `(list1 list2)`
Return a new list with the distinct members of `list1` that are not in `list2`.
Return a new list with only the members of `list` that are not in `list2`.
The test for equality is done with `equal`,
or with `-compare-fn` if that's non-`nil`.
The test for equality is done with `equal`, or with `-compare-fn`
if that is non-`nil`.
```el
(-difference () ()) ;; => ()
@ -1798,16 +1787,17 @@ or with `-compare-fn` if that's non-`nil`.
(-difference '(1 2 3 4) '(3 4 5 6)) ;; => (1 2)
```
#### -intersection `(list list2)`
#### -intersection `(list1 list2)`
Return a new list of the elements appearing in both `list1` and `list2`.
Equality is defined by the value of `-compare-fn` if non-`nil`;
otherwise `equal`.
Return a new list of distinct elements appearing in both `list1` and `list2`.
The test for equality is done with `equal`, or with `-compare-fn`
if that is non-`nil`.
```el
(-intersection () ()) ;; => ()
(-intersection '(1 2 3) '(4 5 6)) ;; => ()
(-intersection '(1 2 3 4) '(3 4 5 6)) ;; => (3 4)
(-intersection '(1 2 2 3) '(4 3 3 2)) ;; => (2 3)
```
#### -powerset `(list)`
@ -1831,18 +1821,36 @@ Return the permutations of `list`.
#### -distinct `(list)`
Return a new list with all duplicates removed.
The test for equality is done with `equal`,
or with `-compare-fn` if that's non-`nil`.
Return a copy of `list` with all duplicate elements removed.
The test for equality is done with `equal`, or with `-compare-fn`
if that is non-`nil`.
Alias: `-uniq`
Alias: `-uniq`.
```el
(-distinct ()) ;; => ()
(-distinct '(1 2 2 4)) ;; => (1 2 4)
(-distinct '(1 1 2 3 3)) ;; => (1 2 3)
(-distinct '(t t t)) ;; => (t)
```
#### -same-items? `(list1 list2)`
Return non-`nil` if `list1` and `list2` have the same distinct elements.
The order of the elements in the lists does not matter. The
lists may be of different lengths, i.e., contain duplicate
elements. The test for equality is done with `equal`, or with
`-compare-fn` if that is non-`nil`.
Alias: `-same-items-p`.
```el
(-same-items? '(1 2 3) '(1 2 3)) ;; => t
(-same-items? '(1 1 2 3) '(3 3 2 1)) ;; => t
(-same-items? '(1 2 3) '(1 2 3 4)) ;; => nil
```
## Other list operations
Other list functions not fit to be classified elsewhere.

265
dash.el
Unescape View File

@ -2690,67 +2690,146 @@ execute body."
(indent 1))
`(--if-let ,val (progn ,@body)))
;; TODO: Get rid of this dynamic variable, passing it as an argument
;; instead?
(defvar -compare-fn nil
"Tests for equality use this function or `equal' if this is nil.
It should only be set using dynamic scope with a let, like:
(let ((-compare-fn #\\='=)) (-union numbers1 numbers2 numbers3)")
"Tests for equality use this function, or `equal' if this is nil.
As a dynamic variable, this should be temporarily bound around
the relevant operation, rather than permanently modified. For
example:
(let ((-compare-fn #\\='=))
(-union \\='(1 2 3) \\='(2 3 4)))")
(defun dash--member-fn ()
"Return the flavor of `member' that goes best with `-compare-fn'."
(declare (side-effect-free error-free))
(let ((cmp -compare-fn))
(cond ((memq cmp '(nil equal)) #'member)
((eq cmp #'eq) #'memq)
((eq cmp #'eql) #'memql)
((lambda (elt list)
(while (and list (not (funcall cmp elt (car list))))
(pop list))
list)))))
(defun dash--hash-test-fn ()
"Return the hash table test function corresponding to `-compare-fn'.
Return nil if `-compare-fn' is not a known test function."
(declare (side-effect-free error-free))
;; In theory this could also recognize values that are custom
;; `hash-table-test's, but too often the :test name is different
;; from the equality function, so it doesn't seem worthwile.
(car (memq (or -compare-fn #'equal) '(equal eq eql))))
(defvar dash--short-list-length 32
"Maximum list length considered short, for optimizations.
For example, the speedup afforded by hash table lookup may start
to outweigh its runtime and memory overhead for problem sizes
greater than this value. See also the discussion in PR #305.")
(defun -distinct (list)
"Return a new list with all duplicates removed.
The test for equality is done with `equal',
or with `-compare-fn' if that's non-nil.
Alias: `-uniq'"
;; Implementation note: The speedup gained from hash table lookup
;; starts to outweigh its overhead for lists of length greater than
;; 32. See discussion in PR #305.
(let* ((len (length list))
(lut (and (> len 32)
;; Check that `-compare-fn' is a valid hash-table
;; lookup function or nil.
(memq -compare-fn '(nil equal eq eql))
(make-hash-table :test (or -compare-fn #'equal)
:size len))))
(if lut
(--filter (unless (gethash it lut)
(puthash it t lut))
list)
(--each list (unless (-contains? lut it) (!cons it lut)))
(nreverse lut))))
(defalias '-uniq '-distinct)
(defun -union (list list2)
"Return a new list of all elements appearing in either LIST1 or LIST2.
Equality is defined by the value of `-compare-fn' if non-nil;
otherwise `equal'."
;; We fall back to iteration implementation if the comparison
;; function isn't one of `eq', `eql' or `equal'.
(let* ((result (reverse list))
;; TODO: get rid of this dynamic variable, pass it as an
;; argument instead.
(-compare-fn (if (bound-and-true-p -compare-fn)
-compare-fn
'equal)))
(if (memq -compare-fn '(eq eql equal))
(let ((ht (make-hash-table :test -compare-fn)))
(--each list (puthash it t ht))
(--each list2 (unless (gethash it ht) (!cons it result))))
(--each list2 (unless (-contains? result it) (!cons it result))))
(nreverse result)))
"Return a copy of LIST with all duplicate elements removed.
The test for equality is done with `equal', or with `-compare-fn'
if that is non-nil.
Alias: `-uniq'."
(let (test len)
(cond ((null list) ())
;; Use a hash table if `-compare-fn' is a known hash table
;; test function and the list is long enough.
((and (setq test (dash--hash-test-fn))
(> (setq len (length list)) dash--short-list-length))
(let ((ht (make-hash-table :test test :size len)))
(--filter (unless (gethash it ht) (puthash it t ht)) list)))
((let ((member (dash--member-fn)) uniq)
(--each list (unless (funcall member it uniq) (push it uniq)))
(nreverse uniq))))))
(defalias '-uniq #'-distinct)
(defun dash--size+ (size1 size2)
"Return the sum of nonnegative fixnums SIZE1 and SIZE2.
Return `most-positive-fixnum' on overflow. This ensures the
result is a valid size, particularly for allocating hash tables,
even in the presence of bignum support."
(declare (side-effect-free t))
(if (< size1 (- most-positive-fixnum size2))
(+ size1 size2)
most-positive-fixnum))
(defun -union (list1 list2)
"Return a new list of distinct elements appearing in either LIST1 or LIST2.
(defun -intersection (list list2)
"Return a new list of the elements appearing in both LIST1 and LIST2.
Equality is defined by the value of `-compare-fn' if non-nil;
otherwise `equal'."
(--filter (-contains? list2 it) list))
The test for equality is done with `equal', or with `-compare-fn'
if that is non-nil."
(let ((lists (list list1 list2)) test len union)
(cond ((null (or list1 list2)))
;; Use a hash table if `-compare-fn' is a known hash table
;; test function and the lists are long enough.
((and (setq test (dash--hash-test-fn))
(> (setq len (dash--size+ (length list1) (length list2)))
dash--short-list-length))
(let ((ht (make-hash-table :test test :size len)))
(dolist (l lists)
(--each l (unless (gethash it ht)
(puthash it t ht)
(push it union))))))
((let ((member (dash--member-fn)))
(dolist (l lists)
(--each l (unless (funcall member it union) (push it union)))))))
(nreverse union)))
(defun -intersection (list1 list2)
"Return a new list of distinct elements appearing in both LIST1 and LIST2.
The test for equality is done with `equal', or with `-compare-fn'
if that is non-nil."
(let (test len)
(cond ((null (and list1 list2)) ())
;; Use a hash table if `-compare-fn' is a known hash table
;; test function and either list is long enough.
((and (setq test (dash--hash-test-fn))
(> (setq len (length list2)) dash--short-list-length))
(let ((ht (make-hash-table :test test :size len)))
(--each list2 (puthash it t ht))
;; Remove visited elements to avoid duplicates.
(--filter (when (gethash it ht) (remhash it ht) t) list1)))
((let ((member (dash--member-fn)) intersection)
(--each list1 (and (funcall member it list2)
(not (funcall member it intersection))
(push it intersection)))
(nreverse intersection))))))
(defun -difference (list1 list2)
"Return a new list with the distinct members of LIST1 that are not in LIST2.
(defun -difference (list list2)
"Return a new list with only the members of LIST that are not in LIST2.
The test for equality is done with `equal',
or with `-compare-fn' if that's non-nil."
(--filter (not (-contains? list2 it)) list))
The test for equality is done with `equal', or with `-compare-fn'
if that is non-nil."
(let (test len1 len2)
(cond ((null list1) ())
((null list2) (-distinct list1))
;; Use a hash table if `-compare-fn' is a known hash table
;; test function and the subtrahend is long enough.
((and (setq test (dash--hash-test-fn))
(setq len1 (length list1))
(setq len2 (length list2))
(> (max len1 len2) dash--short-list-length))
(let ((ht1 (make-hash-table :test test :size len1))
(ht2 (make-hash-table :test test :size len2)))
(--each list2 (puthash it t ht2))
;; Avoid duplicates by tracking visited items in `ht1'.
(--filter (unless (or (gethash it ht2) (gethash it ht1))
(puthash it t ht1))
list1)))
((let ((member (dash--member-fn)) difference)
(--each list1
(unless (or (funcall member it list2)
(funcall member it difference))
(push it difference)))
(nreverse difference))))))
(defun -powerset (list)
"Return the power set of LIST."
@ -2794,37 +2873,49 @@ or with `-compare-fn' if that's non-nil."
"Return non-nil if LIST contains ELEMENT.
The test for equality is done with `equal', or with `-compare-fn'
if that's non-nil.
Alias: `-contains-p'"
(not
(null
(cond
((null -compare-fn) (member element list))
((eq -compare-fn 'eq) (memq element list))
((eq -compare-fn 'eql) (memql element list))
(t
(let ((lst list))
(while (and lst
(not (funcall -compare-fn element (car lst))))
(setq lst (cdr lst)))
lst))))))
(defalias '-contains-p '-contains?)
(defun -same-items? (list list2)
"Return true if LIST and LIST2 has the same items.
The order of the elements in the lists does not matter.
Alias: `-same-items-p'"
(let ((length-a (length list))
(length-b (length list2)))
(and
(= length-a length-b)
(= length-a (length (-intersection list list2))))))
(defalias '-same-items-p '-same-items?)
if that is non-nil. As with `member', the return value is
actually the tail of LIST whose car is ELEMENT.
Alias: `-contains-p'."
(funcall (dash--member-fn) element list))
(defalias '-contains-p #'-contains?)
(defun -same-items? (list1 list2)
"Return non-nil if LIST1 and LIST2 have the same distinct elements.
The order of the elements in the lists does not matter. The
lists may be of different lengths, i.e., contain duplicate
elements. The test for equality is done with `equal', or with
`-compare-fn' if that is non-nil.
Alias: `-same-items-p'."
(let (test len1 len2)
(cond ((null (or list1 list2)))
((null (and list1 list2)) nil)
;; Use a hash table if `-compare-fn' is a known hash table
;; test function and either list is long enough.
((and (setq test (dash--hash-test-fn))
(setq len1 (length list1))
(setq len2 (length list2))
(> (max len1 len2) dash--short-list-length))
(let ((ht1 (make-hash-table :test test :size len1))
(ht2 (make-hash-table :test test :size len2)))
(--each list1 (puthash it t ht1))
;; Move visited elements from `ht1' to `ht2'. This way,
;; if visiting all of `list2' leaves `ht1' empty, then
;; all elements from both lists have been accounted for.
(and (--every (cond ((gethash it ht1)
(remhash it ht1)
(puthash it t ht2))
((gethash it ht2)))
list2)
(zerop (hash-table-count ht1)))))
((let ((member (dash--member-fn)))
(and (--all? (funcall member it list2) list1)
(--all? (funcall member it list1) list2)))))))
(defalias '-same-items-p #'-same-items?)
(defun -is-prefix? (prefix list)
"Return non-nil if PREFIX is a prefix of LIST.

114
dash.texi
Unescape View File

@ -1884,46 +1884,23 @@ Alias: @code{-only-some-p}
Return non-@code{nil} if @var{list} contains @var{element}.
The test for equality is done with @code{equal}, or with @code{-compare-fn}
if that's non-@code{nil}.
if that is non-@code{nil}. As with @code{member}, the return value is
actually the tail of @var{list} whose car is @var{element}.
Alias: @code{-contains-p}
Alias: @code{-contains-p}.
@example
@group
(-contains? '(1 2 3) 1)
@result{} t
@result{} (1 2 3)
@end group
@group
(-contains? '(1 2 3) 2)
@result{} t
@result{} (2 3)
@end group
@group
(-contains? '(1 2 3) 4)
@result{} nil
@end group
@end example
@end defun
@anchor{-same-items?}
@defun -same-items? (list list2)
Return true if @var{list} and @var{list2} has the same items.
The order of the elements in the lists does not matter.
Alias: @code{-same-items-p}
@example
@group
(-same-items? '(1 2 3) '(1 2 3))
@result{} t
@end group
@group
(-same-items? '(1 2 3) '(3 2 1))
@result{} t
@end group
@group
(-same-items? '(1 2 3) '(1 2 3 4))
@result{} nil
@result{} ()
@end group
@end example
@end defun
@ -2566,10 +2543,11 @@ permutation to @var{list} sorts it in descending order.
Operations pretending lists are sets.
@anchor{-union}
@defun -union (list list2)
Return a new list of all elements appearing in either @var{list1} or @var{list2}.
Equality is defined by the value of @code{-compare-fn} if non-@code{nil};
otherwise @code{equal}.
@defun -union (list1 list2)
Return a new list of distinct elements appearing in either @var{list1} or @var{list2}.
The test for equality is done with @code{equal}, or with @code{-compare-fn}
if that is non-@code{nil}.
@example
@group
@ -2577,21 +2555,22 @@ otherwise @code{equal}.
@result{} (1 2 3 4 5)
@end group
@group
(-union '(1 2 3 4) ())
@result{} (1 2 3 4)
(-union '(1 2 2 4) ())
@result{} (1 2 4)
@end group
@group
(-union '(1 1 2 2) '(3 2 1))
@result{} (1 1 2 2 3)
(-union '(1 1 2 2) '(4 4 3 2 1))
@result{} (1 2 4 3)
@end group
@end example
@end defun
@anchor{-difference}
@defun -difference (list list2)
Return a new list with only the members of @var{list} that are not in @var{list2}.
The test for equality is done with @code{equal},
or with @code{-compare-fn} if that's non-@code{nil}.
@defun -difference (list1 list2)
Return a new list with the distinct members of @var{list1} that are not in @var{list2}.
The test for equality is done with @code{equal}, or with @code{-compare-fn}
if that is non-@code{nil}.
@example
@group
@ -2610,10 +2589,11 @@ or with @code{-compare-fn} if that's non-@code{nil}.
@end defun
@anchor{-intersection}
@defun -intersection (list list2)
Return a new list of the elements appearing in both @var{list1} and @var{list2}.
Equality is defined by the value of @code{-compare-fn} if non-@code{nil};
otherwise @code{equal}.
@defun -intersection (list1 list2)
Return a new list of distinct elements appearing in both @var{list1} and @var{list2}.
The test for equality is done with @code{equal}, or with @code{-compare-fn}
if that is non-@code{nil}.
@example
@group
@ -2625,8 +2605,8 @@ otherwise @code{equal}.
@result{} ()
@end group
@group
(-intersection '(1 2 3 4) '(3 4 5 6))
@result{} (3 4)
(-intersection '(1 2 2 3) '(4 3 3 2))
@result{} (2 3)
@end group
@end example
@end defun
@ -2669,11 +2649,12 @@ Return the permutations of @var{list}.
@anchor{-distinct}
@defun -distinct (list)
Return a new list with all duplicates removed.
The test for equality is done with @code{equal},
or with @code{-compare-fn} if that's non-@code{nil}.
Return a copy of @var{list} with all duplicate elements removed.
The test for equality is done with @code{equal}, or with @code{-compare-fn}
if that is non-@code{nil}.
Alias: @code{-uniq}
Alias: @code{-uniq}.
@example
@group
@ -2681,8 +2662,8 @@ Alias: @code{-uniq}
@result{} ()
@end group
@group
(-distinct '(1 2 2 4))
@result{} (1 2 4)
(-distinct '(1 1 2 3 3))
@result{} (1 2 3)
@end group
@group
(-distinct '(t t t))
@ -2691,6 +2672,33 @@ Alias: @code{-uniq}
@end example
@end defun
@anchor{-same-items?}
@defun -same-items? (list1 list2)
Return non-@code{nil} if @var{list1} and @var{list2} have the same distinct elements.
The order of the elements in the lists does not matter. The
lists may be of different lengths, i.e., contain duplicate
elements. The test for equality is done with @code{equal}, or with
@code{-compare-fn} if that is non-@code{nil}.
Alias: @code{-same-items-p}.
@example
@group
(-same-items? '(1 2 3) '(1 2 3))
@result{} t
@end group
@group
(-same-items? '(1 1 2 3) '(3 3 2 1))
@result{} t
@end group
@group
(-same-items? '(1 2 3) '(1 2 3 4))
@result{} nil
@end group
@end example
@end defun
@node Other list operations
@section Other list operations

212
dev/examples.el
Unescape View File

@ -27,6 +27,7 @@
(require 'dash)
(require 'dash-defs "dev/dash-defs")
(require 'ert)
(eval-when-compile
;; TODO: Emacs 24.3 first introduced `setf', so remove this when
@ -771,18 +772,21 @@ value rather than consuming a list to produce a single value."
(--only-some? (> it 2) '(1 2 3)) => t)
(defexamples -contains?
(-contains? '(1 2 3) 1) => t
(-contains? '(1 2 3) 2) => t
(-contains? '(1 2 3) 4) => nil
(-contains? '() 1) => nil
(-contains? '() '()) => nil)
(defexamples -same-items?
(-same-items? '(1 2 3) '(1 2 3)) => t
(-same-items? '(1 2 3) '(3 2 1)) => t
(-same-items? '(1 2 3) '(1 2 3 4)) => nil
(-same-items? '((a . 1) (b . 2)) '((a . 1) (b . 2))) => t
(-same-items? '(1 2 3) '(2 3 1)) => t)
(-contains? '(1 2 3) 1) => '(1 2 3)
(-contains? '(1 2 3) 2) => '(2 3)
(-contains? '(1 2 3) 4) => '()
(-contains? '() 1) => '()
(-contains? '() '()) => '()
(-contains? `(,(string ?a)) "a") => '("a")
(-contains? '(a a) 'a) => '(a a)
(-contains? '(b b a a) 'a) => '(a a)
(-contains? '(a a b b) 'a) => '(a a b b)
(let ((-compare-fn #'eq)) (-contains? `(,(string ?a)) "a")) => '()
(let ((-compare-fn #'string=)) (-contains? '(a) 'b)) => '()
(let ((-compare-fn #'string=)) (-contains? '(a) "a")) => '(a)
(let ((-compare-fn #'string=)) (-contains? '("a") 'a)) => '("a")
(let ((-compare-fn #'string=)) (-contains? '(a "a") 'a)) => '(a "a")
(let ((-compare-fn #'string=)) (-contains? '("a" a) 'a)) => '("a" a))
(defexamples -is-prefix?
(-is-prefix? '(1 2 3) '(1 2 3 4 5)) => t
@ -1112,18 +1116,77 @@ related predicates."
(defexamples -union
(-union '(1 2 3) '(3 4 5)) => '(1 2 3 4 5)
(-union '(1 2 3 4) '()) => '(1 2 3 4)
(-union '(1 1 2 2) '(3 2 1)) => '(1 1 2 2 3))
(-union '(1 2 2 4) '()) => '(1 2 4)
(-union '(1 1 2 2) '(4 4 3 2 1)) => '(1 2 4 3)
(-union '() '()) => '()
(-union '() '(a)) => '(a)
(-union '() '(a a)) => '(a)
(-union '() '(a a b)) => '(a b)
(-union '() '(a b a)) => '(a b)
(-union '() '(b a a)) => '(b a)
(-union '(a) '()) => '(a)
(-union '(a a) '()) => '(a)
(-union '(a a b) '()) => '(a b)
(-union '(a b a) '()) => '(a b)
(-union '(b a a) '()) => '(b a)
(let ((dash--short-list-length 0)) (-union '() '(a))) => '(a)
(let ((dash--short-list-length 0)) (-union '() '(a a))) => '(a)
(let ((dash--short-list-length 0)) (-union '() '(a a b))) => '(a b)
(let ((dash--short-list-length 0)) (-union '() '(a b a))) => '(a b)
(let ((dash--short-list-length 0)) (-union '() '(b a a))) => '(b a)
(let ((dash--short-list-length 0)) (-union '(a) '())) => '(a)
(let ((dash--short-list-length 0)) (-union '(a a) '())) => '(a)
(let ((dash--short-list-length 0)) (-union '(a a b) '())) => '(a b)
(let ((dash--short-list-length 0)) (-union '(a b a) '())) => '(a b)
(let ((dash--short-list-length 0)) (-union '(b a a) '())) => '(b a)
(let ((dash--short-list-length 0)) (-union '(a a b c c) '(e e d c b)))
=> '(a b c e d)
(let ((-compare-fn #'string=)) (-union '(a "b") '("a" b))) => '(a "b")
(let ((-compare-fn #'string=)) (-union '("a" b) '(a "b"))) => '("a" b))
(defexamples -difference
(-difference '() '()) => '()
(-difference '(1 2 3) '(4 5 6)) => '(1 2 3)
(-difference '(1 2 3 4) '(3 4 5 6)) => '(1 2))
(-difference '(1 2 3 4) '(3 4 5 6)) => '(1 2)
(-difference '() '(a)) => '()
(-difference '(a) '()) => '(a)
(-difference '(a) '(a)) => '()
(-difference '(a a) '()) => '(a)
(-difference '(a a) '(a)) => '()
(-difference '(a a) '(a a)) => '()
(-difference '(a a) '(b)) => '(a)
(-difference '(a b c c d a) '(c c b)) => '(a d)
(let ((dash--short-list-length 0)) (-difference '(a) '(a))) => '()
(let ((dash--short-list-length 0)) (-difference '(a a) '(a))) => '()
(let ((dash--short-list-length 0)) (-difference '(a a) '(a a))) => '()
(let ((dash--short-list-length 0)) (-difference '(a a) '(b))) => '(a)
(let ((dash--short-list-length 0)) (-difference '(a b c c d a) '(c c b)))
=> '(a d)
(let ((-compare-fn #'string=)) (-difference '(a) '("a"))) => '()
(let ((-compare-fn #'string=)) (-difference '("a") '(a))) => '()
(let ((-compare-fn #'string=)) (-difference '(a "a") '(a))) => '()
(let ((-compare-fn #'string=)) (-difference '(a "a") '(b))) => '(a)
(let ((-compare-fn #'string=)) (-difference '("a") '(a a))) => '())
(defexamples -intersection
(-intersection '() '()) => '()
(-intersection '(1 2 3) '(4 5 6)) => '()
(-intersection '(1 2 3 4) '(3 4 5 6)) => '(3 4))
(-intersection '(1 2 2 3) '(4 3 3 2)) => '(2 3)
(-intersection '() '(a)) => '()
(-intersection '(a) '()) => '()
(-intersection '(a) '(a)) => '(a)
(-intersection '(a a b) '(b a)) => '(a b)
(-intersection '(a b) '(b a a)) => '(a b)
(let ((dash--short-list-length 0)) (-intersection '(a) '(b))) => '()
(let ((dash--short-list-length 0)) (-intersection '(a) '(a))) => '(a)
(let ((dash--short-list-length 0)) (-intersection '(a a b) '(b b a)))
=> '(a b)
(let ((dash--short-list-length 0)) (-intersection '(a a b) '(b a)))
=> '(a b)
(let ((dash--short-list-length 0)) (-intersection '(a b) '(b a a)))
=> '(a b)
(let ((-compare-fn #'string=)) (-intersection '(a) '("a")) => '(a))
(let ((-compare-fn #'string=)) (-intersection '("a") '(a)) => '("a")))
(defexamples -powerset
(-powerset '()) => '(nil)
@ -1136,19 +1199,73 @@ related predicates."
(defexamples -distinct
(-distinct '()) => '()
(-distinct '(1 2 2 4)) => '(1 2 4)
(-distinct '(1 1 2 3 3)) => '(1 2 3)
(-distinct '(t t t)) => '(t)
(-distinct '(nil nil nil)) => '(nil)
(let ((-compare-fn nil))
(-distinct '((1) (2) (1) (1)))) => '((1) (2))
(let ((-compare-fn #'eq))
(-distinct '((1) (2) (1) (1)))) => '((1) (2) (1) (1))
(let ((-compare-fn #'eq))
(-distinct '(:a :b :a :a))) => '(:a :b)
(let ((-compare-fn #'eql))
(-distinct '(2.1 3.1 2.1 2.1))) => '(2.1 3.1)
(-uniq '((1) (2) (1) (1))) => '((1) (2))
(let ((-compare-fn #'eq)) (-uniq '((1) (2) (1) (1)))) => '((1) (2) (1) (1))
(let ((-compare-fn #'eq)) (-uniq '(:a :b :a :a))) => '(:a :b)
(let ((-compare-fn #'eql)) (-uniq '(2.1 3.1 2.1 2.1))) => '(2.1 3.1)
(let ((-compare-fn #'string=))
(-distinct '(dash "dash" "ash" "cash" "bash"))) => '(dash "ash" "cash" "bash")))
(-uniq '(dash "dash" "ash" "cash" "bash")))
=> '(dash "ash" "cash" "bash")
(let ((-compare-fn #'string=)) (-uniq '(a))) => '(a)
(let ((-compare-fn #'string=)) (-uniq '(a a))) => '(a)
(let ((-compare-fn #'string=)) (-uniq '(a b))) => '(a b)
(let ((-compare-fn #'string=)) (-uniq '(b a))) => '(b a)
(let ((-compare-fn #'string=)) (-uniq '(a "a"))) => '(a)
(let ((-compare-fn #'string=)) (-uniq '("a" a))) => '("a")
(let ((dash--short-list-length 0)) (-uniq '(a))) => '(a)
(let ((dash--short-list-length 0)) (-uniq '(a b))) => '(a b)
(let ((dash--short-list-length 0)) (-uniq '(b a))) => '(b a)
(let ((dash--short-list-length 0)) (-uniq '(a a))) => '(a)
(let ((dash--short-list-length 0)) (-uniq '(a a b))) => '(a b)
(let ((dash--short-list-length 0)) (-uniq '(a b a))) => '(a b)
(let ((dash--short-list-length 0)) (-uniq '(b a a))) => '(b a)
(let ((dash--short-list-length 0)
(-compare-fn #'eq))
(-uniq (list (string ?a) (string ?a))))
=> '("a" "a")
(let ((dash--short-list-length 0)
(-compare-fn #'eq)
(a (string ?a)))
(-uniq (list a a)))
=> '("a"))
(defexamples -same-items?
(-same-items? '(1 2 3) '(1 2 3)) => t
(-same-items? '(1 1 2 3) '(3 3 2 1)) => t
(-same-items? '(1 2 3) '(1 2 3 4)) => nil
(-same-items? '((a . 1) (b . 2)) '((a . 1) (b . 2))) => t
(-same-items? '() '()) => t
(-same-items? '() '(a)) => nil
(-same-items? '(a) '()) => nil
(-same-items? '(a) '(a)) => t
(-same-items? '(a) '(b)) => nil
(-same-items? '(a) '(a a)) => t
(-same-items? '(b) '(a a)) => nil
(-same-items? '(a) '(a b)) => nil
(-same-items? '(a a) '(a)) => t
(-same-items? '(a a) '(b)) => nil
(-same-items? '(a a) '(a b)) => nil
(-same-items? '(a b) '(a)) => nil
(-same-items? '(a b) '(a a)) => nil
(-same-items? '(a a) '(a a)) => t
(-same-items? '(a a b) '(b b a a)) => t
(-same-items? '(b b a a) '(a a b)) => t
(let ((dash--short-list-length 0)) (-same-items? '(a) '(a))) => t
(let ((dash--short-list-length 0)) (-same-items? '(a) '(b))) => nil
(let ((dash--short-list-length 0)) (-same-items? '(a) '(a a))) => t
(let ((dash--short-list-length 0)) (-same-items? '(b) '(a a))) => nil
(let ((dash--short-list-length 0)) (-same-items? '(a) '(a b))) => nil
(let ((dash--short-list-length 0)) (-same-items? '(a a) '(a))) => t
(let ((dash--short-list-length 0)) (-same-items? '(a a) '(b))) => nil
(let ((dash--short-list-length 0)) (-same-items? '(a a) '(a b))) => nil
(let ((dash--short-list-length 0)) (-same-items? '(a b) '(a))) => nil
(let ((dash--short-list-length 0)) (-same-items? '(a b) '(a a))) => nil
(let ((dash--short-list-length 0)) (-same-items? '(a a) '(a a))) => t
(let ((dash--short-list-length 0)) (-same-items? '(a a b) '(b b a a))) => t
(let ((dash--short-list-length 0)) (-same-items? '(b b a a) '(a a b))) => t))
(def-example-group "Other list operations"
"Other list functions not fit to be classified elsewhere."
@ -2137,4 +2254,47 @@ or readability."
(equal (funcall (-compose (-prodfn f g) (-prodfn ff gg)) input3)
(funcall (-prodfn (-compose f ff) (-compose g gg)) input3)))) => t))
(ert-deftest dash--member-fn ()
"Test `dash--member-fn'."
(dolist (cmp '(nil equal))
(let ((-compare-fn cmp))
(should (eq (dash--member-fn) #'member))))
(let ((-compare-fn #'eq))
(should (eq (dash--member-fn) #'memq)))
(let ((-compare-fn #'eql))
(should (eq (dash--member-fn) #'memql)))
(let* ((-compare-fn #'string=)
(member (dash--member-fn)))
(should-not (memq member '(member memq memql)))
(should-not (funcall member "foo" ()))
(should-not (funcall member "foo" '(bar)))
(should (equal (funcall member "foo" '(foo bar)) '(foo bar)))
(should (equal (funcall member "foo" '(bar foo)) '(foo)))))
(ert-deftest dash--hash-test-fn ()
"Test `dash--hash-test-fn'."
(let ((-compare-fn nil))
(should (eq (dash--hash-test-fn) #'equal)))
(dolist (cmp '(equal eq eql))
(let ((-compare-fn cmp))
(should (eq (dash--hash-test-fn) cmp))))
(let ((-compare-fn #'string=))
(should-not (dash--hash-test-fn))))
(ert-deftest dash--size+ ()
"Test `dash--size+'."
(dotimes (a 3)
(dotimes (b 3)
(should (= (dash--size+ a b) (+ a b)))))
(should (= (dash--size+ (- most-positive-fixnum 10) 5)
(- most-positive-fixnum 5)))
(should (= (dash--size+ (1- most-positive-fixnum) 0)
(1- most-positive-fixnum)))
(dotimes (i 2)
(should (= (dash--size+ (1- most-positive-fixnum) (1+ i))
most-positive-fixnum)))
(dotimes (i 3)
(should (= (dash--size+ most-positive-fixnum i)
most-positive-fixnum))))
;;; examples.el ends here

Write Preview
Loading…
Cancel
Save