f9fec2ff0ff5

Add assocar/assocdr/rassocar/rassocdr accessors
[view raw] [browse files]
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))