Add assocar/assocdr/rassocar/rassocdr accessors
author |
Steve Losh <steve@stevelosh.com> |
date |
Thu, 08 Apr 2021 20:29:23 -0400 |
parents |
f56991dfcaea
|
children |
c5fc3602d000
|
branches/tags |
(none) |
files |
package.lisp src/lists.lisp |
Changes
--- a/package.lisp Thu Apr 08 20:19:53 2021 -0400
+++ b/package.lisp Thu Apr 08 20:29:23 2021 -0400
@@ -93,7 +93,9 @@
(:export
:0.. :1.. :n..
:0... :1... :n...
- :somelist))
+ :somelist
+ :assocar :assocdr
+ :rassocar :rassocdr))
(defpackage :losh.mutation
(:use :cl :iterate :losh.quickutils)
--- a/src/lists.lisp Thu Apr 08 20:19:53 2021 -0400
+++ b/src/lists.lisp Thu Apr 08 20:29:23 2021 -0400
@@ -38,3 +38,41 @@
(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))