From 3e5dcc09de91b9fafda22e274e83acd83aaa1311 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Wed, 26 Oct 2022 06:55:50 -0500 Subject: Add: with-alist --- derrida.lisp | 43 +++++++++++++++++++++++++++++++++++++++++++ package.lisp | 3 ++- 2 files changed, 45 insertions(+), 1 deletion(-) diff --git a/derrida.lisp b/derrida.lisp index ce1abeb..f8fe8bd 100644 --- a/derrida.lisp +++ b/derrida.lisp @@ -2,6 +2,49 @@ (in-package #:derrida) + + +(defmacro with-alist ((&optional (accessor 'cdr)) (&rest bindings) alist &body body) + "Bind variables to accessors into ALISTS. Each member of BINDINGS is + either a symbol variable or a list that looks like (var key-term . kwargs). + + The kwargs are passed as keyword argments to (ASSOC KEY-TERM ALIST ...). + +EXAMPLE: + + (let ((al + (list (cons 'name \"colin\") + (list :hobbies \"fiddling\" \"diddling\") + (list \"job\" :executive \"crum bum\")))) + (with-alist () + (name (hobbies :hobbies) (job \"job\" :test 'equalp)) + al + (setf job (format nil \"~{~a~^ ~}\" job)) + (format t \"---------------------------~%\") + (format t \"name: ~a~%hobbies: ~{~a~^,~}~%job: ~a~%\" + name hobbies job) + (format t \"---------------------------~%\") + al)) +--------------------------- +name: colin +hobbies: fiddling,diddling +job: EXECUTIVE crum bum +--------------------------- + +((NAME . \"colin\") (:HOBBIES \"fiddling\" \"diddling\") + (\"job\" . \"EXECUTIVE crum bum\")) +" + (let* ((alist-var + (gensym)) + (macrolet-bindings + (loop for term in bindings + when (symbolp term ) + collect `(,term (,accessor (assoc ',term ,alist-var))) + when (consp term) + collect `(,(first term) + (,accessor (assoc ',(second term) ,alist-var ,@(nthcdr 2 term))))))) + `(let ((,alist-var ,alist)) (symbol-macrolet ,macrolet-bindings ,@body)))) + (defmacro with-plist (keys plist &body body) "KEYS is a list, each member of which is either a symbol or a pair of symbols. diff --git a/package.lisp b/package.lisp index 33d3860..62377cb 100644 --- a/package.lisp +++ b/package.lisp @@ -2,4 +2,5 @@ (defpackage #:derrida (:use #:cl) - (:export #:with-plist)) + (:export #:with-plist + #:with-alist)) -- cgit v1.2.3