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.
@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,
(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.
+
\f
* Changes in Emacs 29.1 on Non-Free Operating Systems
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
;; 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
: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
return res;
}
\f
+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)
defsubr (&Scopy_alist);
defsubr (&Ssubstring);
defsubr (&Ssubstring_no_properties);
+ defsubr (&Stake);
+ defsubr (&Sntake);
defsubr (&Snthcdr);
defsubr (&Snth);
defsubr (&Selt);
(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
projects / emacs.git / commitdiff