From: Mattias Engdegård Date: Wed, 13 Jul 2022 11:46:52 +0000 (+0200) Subject: Add `take` and `ntake` (bug#56521) X-Git-Tag: emacs-29.0.90~1447^2~879 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d62766305ad8fe6ca1695341c34b9836d051e3cb;p=emacs.git Add `take` and `ntake` (bug#56521) These are useful list primitives, complementary to `nthcdr`. * src/fns.c (Ftake, Fntake): New. (syms_of_fns): Defsubr them. * doc/lispref/lists.texi (List Elements): * lisp/emacs-lisp/shortdoc.el (list): Document. * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns, pure-fns): Declare `take` pure and side-effect-free. * test/src/fns-tests.el (fns-tests--take-ref, fns--take-ntake): New test. * etc/NEWS: Announce. --- diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index a4f0ba815b1..2a9ad1d5e00 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -340,6 +340,35 @@ If @var{n} is zero, @code{nthcdr} returns all of @end example @end defun +@defun take n list +This function returns the @var{n} first elements of @var{list}. Essentially, +it returns the part of @var{list} that @code{nthcdr} skips. + +@code{take} returns @var{list} if it is shorter than @var{n} elements; +it returns @code{nil} if @var{n} is zero or negative. + +@example +@group +(take 3 '(a b c d)) + @result{} (a b c) +@end group +@group +(take 10 '(a b c d)) + @result{} (a b c d) +@end group +@group +(take 0 '(a b c d)) + @result{} nil +@end group +@end example +@end defun + +@defun ntake n list +This is a version of @code{take} that works by destructively modifying +the list structure of the argument. That makes it faster, but the +original value of @var{list} is lost. +@end defun + @defun last list &optional n This function returns the last link of @var{list}. The @code{car} of this link is the list's last element. If @var{list} is null, diff --git a/etc/NEWS b/etc/NEWS index 604e30ce251..11189020f18 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3197,6 +3197,11 @@ to preserve the old behavior, apply (let ((default-directory temporary-file-directory)) (process-attributes pid)) ++++ +** New functions 'take' and 'ntake'. +'(take N LIST)' returns the first N elements of LIST; 'ntake' does +the same but works by modifying LIST destructively. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ce73a5e91f4..a457e2044d8 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1459,7 +1459,7 @@ See Info node `(elisp) Integer Basics'." symbol-function symbol-name symbol-plist symbol-value string-make-unibyte string-make-multibyte string-as-multibyte string-as-unibyte string-to-multibyte - tan time-convert truncate + take tan time-convert truncate unibyte-char-to-multibyte upcase user-full-name user-login-name user-original-login-name custom-variable-p vconcat @@ -1560,7 +1560,7 @@ See Info node `(elisp) Integer Basics'." ;; arguments. This is pure enough for the purposes of ;; constant folding, but not necessarily for all kinds of ;; code motion. - car cdr car-safe cdr-safe nth nthcdr last + car cdr car-safe cdr-safe nth nthcdr last take equal length safe-length memq memql member diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index a2d954cadbb..1514ece6d1f 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -595,6 +595,10 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), :eval (nth 1 '(one two three))) (nthcdr :eval (nthcdr 1 '(one two three))) + (take + :eval (take 3 '(one two three four))) + (ntake + :eval (ntake 3 (list 'one 'two 'three 'four))) (elt :eval (elt '(one two three) 1)) (car-safe diff --git a/src/fns.c b/src/fns.c index 1f57e675b12..84cfec6c3f0 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1557,6 +1557,61 @@ substring_both (Lisp_Object string, ptrdiff_t from, ptrdiff_t from_byte, return res; } +DEFUN ("take", Ftake, Stake, 2, 2, 0, + doc: /* Return the first N elements of LIST. +If N is zero or negative, return nil. +If LIST is no more than N elements long, return it (or a copy). */) + (Lisp_Object n, Lisp_Object list) +{ + CHECK_FIXNUM (n); + EMACS_INT m = XFIXNUM (n); + if (m <= 0) + return Qnil; + CHECK_LIST (list); + if (NILP (list)) + return Qnil; + Lisp_Object ret = Fcons (XCAR (list), Qnil); + Lisp_Object prev = ret; + m--; + list = XCDR (list); + while (m > 0 && CONSP (list)) + { + Lisp_Object p = Fcons (XCAR (list), Qnil); + XSETCDR (prev, p); + prev = p; + m--; + list = XCDR (list); + } + if (m > 0 && !NILP (list)) + wrong_type_argument (Qlistp, list); + return ret; +} + +DEFUN ("ntake", Fntake, Sntake, 2, 2, 0, + doc: /* Modify LIST to keep only the first N elements. +If N is zero or negative, return nil. +If LIST is no more than N elements long, return it. */) + (Lisp_Object n, Lisp_Object list) +{ + CHECK_FIXNUM (n); + EMACS_INT m = XFIXNUM (n); + if (m <= 0) + return Qnil; + CHECK_LIST (list); + Lisp_Object tail = list; + --m; + while (m > 0 && CONSP (tail)) + { + tail = XCDR (tail); + m--; + } + if (CONSP (tail)) + XSETCDR (tail, Qnil); + else if (!NILP (tail)) + wrong_type_argument (Qlistp, list); + return list; +} + DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, doc: /* Take cdr N times on LIST, return the result. */) (Lisp_Object n, Lisp_Object list) @@ -6082,6 +6137,8 @@ The same variable also affects the function `read-answer'. */); defsubr (&Scopy_alist); defsubr (&Ssubstring); defsubr (&Ssubstring_no_properties); + defsubr (&Stake); + defsubr (&Sntake); defsubr (&Snthcdr); defsubr (&Snth); defsubr (&Selt); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 20074ca0d21..a84cce3ad4e 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1365,4 +1365,53 @@ (should-error (string-to-unibyte "Ã¥")) (should-error (string-to-unibyte "ABC∀BC"))) +(defun fns-tests--take-ref (n list) + "Reference implementation of `take'." + (named-let loop ((m n) (tail list) (ac nil)) + (if (and (> m 0) tail) + (loop (1- m) (cdr tail) (cons (car tail) ac)) + (nreverse ac)))) + +(ert-deftest fns--take-ntake () + "Test `take' and `ntake'." + ;; Check errors and edge cases. + (should-error (take 'x '(a))) + (should-error (ntake 'x '(a))) + (should-error (take 1 'a)) + (should-error (ntake 1 'a)) + (should-error (take 2 '(a . b))) + (should-error (ntake 2 '(a . b))) + ;; Tolerate non-lists for a count of zero. + (should (equal (take 0 'a) nil)) + (should (equal (ntake 0 'a) nil)) + ;; But not non-numbers for empty lists. + (should-error (take 'x nil)) + (should-error (ntake 'x nil)) + + (dolist (list '(nil (a) (a b) (a b c) (a b c d) (a . b) (a b . c))) + (ert-info ((prin1-to-string list) :prefix "list: ") + (let ((max (if (proper-list-p list) + (+ 2 (length list)) + (safe-length list)))) + (dolist (n (number-sequence -1 max)) + (ert-info ((prin1-to-string n) :prefix "n: ") + (let* ((l (copy-tree list)) + (ref (fns-tests--take-ref n l))) + (should (equal (take n l) ref)) + (should (equal l list)) + (should (equal (ntake n l) ref)))))))) + + ;; Circular list. + (let ((list (list 'a 'b 'c))) + (setcdr (nthcdr 2 list) (cdr list)) ; list now (a b c b c b c ...) + (should (equal (take 0 list) nil)) + (should (equal (take 1 list) '(a))) + (should (equal (take 2 list) '(a b))) + (should (equal (take 3 list) '(a b c))) + (should (equal (take 4 list) '(a b c b))) + (should (equal (take 5 list) '(a b c b c))) + (should (equal (take 10 list) '(a b c b c b c b c b))) + + (should (equal (ntake 10 list) '(a b))))) + ;;; fns-tests.el ends here