lisp/emacs-lisp/let-alist.el

   1 ;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
   6 ;; Package-Requires: ((emacs "24.1"))
   7 ;; Version: 1.0.4
   8 ;; Keywords: extensions lisp
   9 ;; Prefix: let-alist
  10 ;; Separator: -
  11
  12 ;; This is an Elpa :core package. Don't use functionality that is not
  13 ;; compatible with Emacs 24.1.
  14
  15 ;; This file is part of GNU Emacs.
  16
  17 ;; GNU Emacs is free software: you can redistribute it and/or modify
  18 ;; it under the terms of the GNU General Public License as published by
  19 ;; the Free Software Foundation, either version 3 of the License, or
  20 ;; (at your option) any later version.
  21
  22 ;; GNU Emacs is distributed in the hope that it will be useful,
  23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25 ;; GNU General Public License for more details.
  26
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  29
  30 ;;; Commentary:
  31
  32 ;; This package offers a single macro, `let-alist'.  This macro takes a
  33 ;; first argument (whose value must be an alist) and a body.
  34 ;;
  35 ;; The macro expands to a let form containing body, where each dotted
  36 ;; symbol inside body is let-bound to their cdrs in the alist.  Dotted
  37 ;; symbol is any symbol starting with a `.'.  Only those present in
  38 ;; the body are let-bound and this search is done at compile time.
  39 ;;
  40 ;; For instance, the following code
  41 ;;
  42 ;;   (let-alist alist
  43 ;;     (if (and .title .body)
  44 ;;         .body
  45 ;;       .site
  46 ;;       .site.contents))
  47 ;;
  48 ;; essentially expands to
  49 ;;
  50 ;;   (let ((.title (cdr (assq 'title alist)))
  51 ;;         (.body  (cdr (assq 'body alist)))
  52 ;;         (.site  (cdr (assq 'site alist)))
  53 ;;         (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
  54 ;;     (if (and .title .body)
  55 ;;         .body
  56 ;;       .site
  57 ;;       .site.contents))
  58 ;;
  59 ;; If you nest `let-alist' invocations, the inner one can't access
  60 ;; the variables of the outer one. You can, however, access alists
  61 ;; inside the original alist by using dots inside the symbol, as
  62 ;; displayed in the example above by the `.site.contents'.
  63 ;;
  64 ;;; Code:
  65 \f
  66
  67 (defun let-alist--deep-dot-search (data)
  68   "Return alist of symbols inside DATA that start with a `.'.
  69 Perform a deep search and return an alist where each car is the
  70 symbol, and each cdr is the same symbol without the `.'."
  71   (cond
  72    ((symbolp data)
  73     (let ((name (symbol-name data)))
  74       (when (string-match "\\`\\." name)
  75         ;; Return the cons cell inside a list, so it can be appended
  76         ;; with other results in the clause below.
  77         (list (cons data (intern (replace-match "" nil nil name)))))))
  78    ((not (consp data)) nil)
  79    ((eq (car data) 'let-alist)
  80     ;; For nested ‘let-alist’ forms, ignore symbols appearing in the
  81     ;; inner body because they don’t refer to the alist currently
  82     ;; being processed.  See Bug#24641.
  83     (let-alist--deep-dot-search (cadr data)))
  84    (t (append (let-alist--deep-dot-search (car data))
  85               (let-alist--deep-dot-search (cdr data))))))
  86
  87 (defun let-alist--access-sexp (symbol variable)
  88   "Return a sexp used to access SYMBOL inside VARIABLE."
  89   (let* ((clean (let-alist--remove-dot symbol))
  90          (name (symbol-name clean)))
  91     (if (string-match "\\`\\." name)
  92         clean
  93       (let-alist--list-to-sexp
  94        (mapcar #'intern (nreverse (split-string name "\\.")))
  95        variable))))
  96
  97 (defun let-alist--list-to-sexp (list var)
  98   "Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
  99   `(cdr (assq ',(car list)
 100               ,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
 101                  var))))
 102
 103 (defun let-alist--remove-dot (symbol)
 104   "Return SYMBOL, sans an initial dot."
 105   (let ((name (symbol-name symbol)))
 106     (if (string-match "\\`\\." name)
 107         (intern (replace-match "" nil nil name))
 108       symbol)))
 109
 110 \f
 111 ;;; The actual macro.
 112 ;;;###autoload
 113 (defmacro let-alist (alist &rest body)
 114   "Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
 115 Dotted symbol is any symbol starting with a `.'.  Only those present
 116 in BODY are let-bound and this search is done at compile time.
 117
 118 For instance, the following code
 119
 120   (let-alist alist
 121     (if (and .title .body)
 122         .body
 123       .site
 124       .site.contents))
 125
 126 essentially expands to
 127
 128   (let ((.title (cdr (assq \\='title alist)))
 129         (.body  (cdr (assq \\='body alist)))
 130         (.site  (cdr (assq \\='site alist)))
 131         (.site.contents (cdr (assq \\='contents (cdr (assq \\='site alist))))))
 132     (if (and .title .body)
 133         .body
 134       .site
 135       .site.contents))
 136
 137 If you nest `let-alist' invocations, the inner one can't access
 138 the variables of the outer one. You can, however, access alists
 139 inside the original alist by using dots inside the symbol, as
 140 displayed in the example above."
 141   (declare (indent 1) (debug t))
 142   (let ((var (make-symbol "alist")))
 143     `(let ((,var ,alist))
 144        (let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
 145                      (delete-dups (let-alist--deep-dot-search body)))
 146          ,@body))))
 147
 148 (provide 'let-alist)
 149
 150 ;;; let-alist.el ends here