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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
;; Author: Artur Malabarba <emacs@endlessparentheses.com>
;; Package-Requires: ((emacs "24.1"))
;; Version: 1.0.5
;; Keywords: extensions lisp
;; Prefix: let-alist
;; Separator: -
;; This is an Elpa :core package. Don't use functionality that is not
;; compatible with Emacs 24.1.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package offers a single macro, `let-alist'. This macro takes a
;; first argument (whose value must be an alist) and a body.
;;
;; The macro expands to a let form containing body, where each dotted
;; symbol inside body is let-bound to their cdrs in the alist. Dotted
;; symbol is any symbol starting with a `.'. Only those present in
;; the body are let-bound and this search is done at compile time.
;;
;; For instance, the following code
;;
;; (let-alist alist
;; (if (and .title .body)
;; .body
;; .site
;; .site.contents))
;;
;; essentially expands to
;;
;; (let ((.title (cdr (assq 'title alist)))
;; (.body (cdr (assq 'body alist)))
;; (.site (cdr (assq 'site alist)))
;; (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
;; (if (and .title .body)
;; .body
;; .site
;; .site.contents))
;;
;; If you nest `let-alist' invocations, the inner one can't access
;; the variables of the outer one. You can, however, access alists
;; inside the original alist by using dots inside the symbol, as
;; displayed in the example above by the `.site.contents'.
;;
;;; Code:
(defun let-alist--deep-dot-search (data)
"Return alist of symbols inside DATA that start with a `.'.
Perform a deep search and return an alist where each car is the
symbol, and each cdr is the same symbol without the `.'."
(cond
((symbolp data)
(let ((name (symbol-name data)))
(when (string-match "\\`\\." name)
;; Return the cons cell inside a list, so it can be appended
;; with other results in the clause below.
(list (cons data (intern (replace-match "" nil nil name)))))))
((not (consp data)) nil)
((eq (car data) 'let-alist)
;; For nested ‘let-alist’ forms, ignore symbols appearing in the
;; inner body because they don’t refer to the alist currently
;; being processed. See Bug#24641.
(let-alist--deep-dot-search (cadr data)))
(t (append (let-alist--deep-dot-search (car data))
(let-alist--deep-dot-search (cdr data))))))
(defun let-alist--access-sexp (symbol variable)
"Return a sexp used to access SYMBOL inside VARIABLE."
(let* ((clean (let-alist--remove-dot symbol))
(name (symbol-name clean)))
(if (string-match "\\`\\." name)
clean
(let-alist--list-to-sexp
(mapcar #'intern (nreverse (split-string name "\\.")))
variable))))
(defun let-alist--list-to-sexp (list var)
"Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
`(cdr (assq ',(car list)
,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
var))))
(defun let-alist--remove-dot (symbol)
"Return SYMBOL, sans an initial dot."
(let ((name (symbol-name symbol)))
(if (string-match "\\`\\." name)
(intern (replace-match "" nil nil name))
symbol)))
;;; The actual macro.
;;;###autoload
(defmacro let-alist (alist &rest body)
"Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
Dotted symbol is any symbol starting with a `.'. Only those present
in BODY are let-bound and this search is done at compile time.
For instance, the following code
(let-alist alist
(if (and .title .body)
.body
.site
.site.contents))
essentially expands to
(let ((.title (cdr (assq \\='title alist)))
(.body (cdr (assq \\='body alist)))
(.site (cdr (assq \\='site alist)))
(.site.contents (cdr (assq \\='contents (cdr (assq \\='site alist))))))
(if (and .title .body)
.body
.site
.site.contents))
If you nest `let-alist' invocations, the inner one can't access
the variables of the outer one. You can, however, access alists
inside the original alist by using dots inside the symbol, as
displayed in the example above."
(declare (indent 1) (debug t))
(let ((var (make-symbol "alist")))
`(let ((,var ,alist))
(let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
(delete-dups (let-alist--deep-dot-search body)))
,@body))))
;;;; ChangeLog:
;; 2015-12-01 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; packages/let-alist: Define it as a :core package
;;
;; 2015-06-11 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; * let-alist (let-alist--deep-dot-search): Fix cons
;;
;; 2015-03-07 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; let-alist: Update copyright
;;
;; 2014-12-22 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; packages/let-alist: Use `make-symbol' instead of `gensym'.
;;
;; 2014-12-20 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; packages/let-alist: Enable access to deeper alists
;;
;; 2014-12-14 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; let-alist.el: Add lexical binding. Version bump.
;;
;; 2014-12-11 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; let-alist: New package
;;
(provide 'let-alist)
;;; let-alist.el ends here
|
