1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
;;;; derrida.lisp
(in-package #:derrida)
(defmacro with-alist ((&optional (accessor 'cdr)) (&rest bindings) alist &body body)
"Bind variables to accessors into ALISTS. ACCESSOR, which should be
an accessor function, is called like (ACCESSOR (ASSOC ..)).
Each member of BINDINGS is either a symbol VAR or a list that
looks like (VAR KEY-TERM . KWARGS).
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.
If a member is just a symbol, say KEY, then it is treated as the name
of a symbol-macro (defined using symbol-macrolet) that expands to the
expression (getf PLIST KEY). In this case, KEY is not allowed to be a
keyword symbol.
If a member is a pair of symbols, it is of the form (VAR KEY). Here,
key is a valid key into the PLIST and VAR is the name of the symbol
macrolet that will be bound to (getf PLIST KEY).
EXAMPLE:
(let ((pl
(list 'name \"colin\" :age 40 :|currentJob| :crumb-bum)))
(hq:with-plist (name (age :age) (job :|currentJob|)) pl
(setf age (1+ age))
(format t \"~a the ~a had a birthday, and is now ~a years old~%\"
name job age)
pl))
The above would print out:
colin the CRUMB-BUM had a birthday, and is now 41 years old
And would return
(NAME \"colin\" :AGE 41 :|currentJob| :CRUMB-BUM)"
(let* ((plist-var
(gensym))
(macrolet-bindings
(loop for term in keys
when (consp term )
collect (destructuring-bind (var key) term
`(,var (getf ,plist-var ',key)))
else
collect `(,term (getf ,plist-var ',term)))))
`(let ((,plist-var ,plist)) (symbol-macrolet ,macrolet-bindings ,@body))))
(defun get-nested (plist-tree &rest indicators)
"PLIST-TREE is plist some of whose values are also
PLISTS. INDICATORS are keyes to the plists."
(if (or (null plist-tree) (null indicators))
plist-tree
(apply #'get-nested (getf plist-tree (car indicators)) (cdr indicators))))
(defmacro pluck-nested (keypaths plist &body body)
"Pluck nested binds variables to paths into a plist tree."
(let ((tmp-plist (gensym "plist")))
`(let ((,tmp-plist ,plist))
(let ,(loop for (var . path) in keypaths
collect `(,var (get-nested ,tmp-plist ,@path)))
,@body))))
|
