src/lists.lisp @ f9fec2ff0ff5

Add assocar/assocdr/rassocar/rassocdr accessors
author Steve Losh <steve@stevelosh.com>
date Thu, 08 Apr 2021 20:29:23 -0400
parents ea581753e904
children e9553a14c887
(in-package :losh.lists)

(defun somelist (predicate list &rest more-lists)
  "Call `predicate` on successive sublists of `list`, returning the first true result.

  `somelist` is to `some` as `maplist` is to `mapcar`.

  "
  (if more-lists
    (iterate
      (for lists :first (cons list more-lists) :then (mapcar #'cdr lists))
      (until (some #'null lists))
      (thereis (apply predicate lists)))
    (iterate (for l :on list)
             (thereis (funcall predicate l)))))


(defun 0.. (below)
  "Return a fresh list of the range `[0, below)`."
  (loop :for i :from 0 :below below :collect i))

(defun 1.. (below)
  "Return a fresh list of the range `[1, below)`."
  (loop :for i :from 1 :below below :collect i))

(defun n.. (from below)
  "Return a fresh list of the range `[from, below)`."
  (loop :for i :from from :below below :collect i))

(defun 0... (to)
  "Return a fresh list of the range `[0, to]`."
  (loop :for i :from 0 :to to :collect i))

(defun 1... (to)
  "Return a fresh list of the range `[1, to]`."
  (loop :for i :from 1 :to to :collect i))

(defun n... (from to)
  "Return a fresh list of the range `[from, to]`."
  (loop :for i :from from :to to :collect i))


(declaim (inline assocar assocdr rassocar rassocdr
                 (setf assocar) (setf assocdr) (setf rassocar) (setf rassocdr)))


(defun assocar (item alist &rest args)
  "Return the `car` of `(apply #'assoc item alist args)`."
  (car (apply #'assoc item alist args)))

(defun assocdr (item alist &rest args)
  "Return the `cdr` of `(apply #'assoc item alist args)`."
  (cdr (apply #'assoc item alist args)))

(defun rassocar (item alist &rest args)
  "Return the `car` of `(apply #'rassoc item alist args)`."
  (car (apply #'rassoc item alist args)))

(defun rassocdr (item alist &rest args)
  "Return the `cdr` of `(apply #'rassoc item alist args)`."
  (cdr (apply #'rassoc item alist args)))


(defun (setf assocar) (new-value item alist &rest args)
  "Set the `car` of `(apply #'assoc item alist args)` to `new-value`."
  (setf (car (apply #'assoc item alist args)) new-value))

(defun (setf assocdr) (new-value item alist &rest args)
  "Set the `cdr` of `(apply #'assoc item alist args)` to `new-value`."
  (setf (cdr (apply #'assoc item alist args)) new-value))

(defun (setf rassocar) (new-value item alist &rest args)
  "Set the `car` of `(apply #'rassoc item alist args)` to `new-value`."
  (setf (car (apply #'rassoc item alist args)) new-value))

(defun (setf rassocdr) (new-value item alist &rest args)
  "Set the `cdr` of `(apply #'rassoc item alist args)` to `new-value`."
  (setf (cdr (apply #'rassoc item alist args)) new-value))