# HG changeset patch # User Steve Losh # Date 1617928163 14400 # Node ID f9fec2ff0ff5e91811372d62e0722c8c62c1c6d2 # Parent f56991dfcaea6d33e4c2d22347d502927a1cc590 Add assocar/assocdr/rassocar/rassocdr accessors diff -r f56991dfcaea -r f9fec2ff0ff5 package.lisp --- 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) diff -r f56991dfcaea -r f9fec2ff0ff5 src/lists.lisp --- 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))