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 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
   6 ;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com>
   7 ;; Version: 1.0.1
   8 ;; Keywords: extensions lisp
   9 ;; Prefix: let-alist
  10 ;; Separator: -
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; This package offers a single macro, `let-alist'.  This macro takes a
  30 ;; first argument (whose value must be an alist) and a body.
  31 ;;
  32 ;; The macro expands to a let form containing body, where each dotted
  33 ;; symbol inside body is let-bound to their cdrs in the alist.  Dotted
  34 ;; symbol is any symbol starting with a `.'.  Only those present in
  35 ;; the body are let-bound and this search is done at compile time.
  36 ;;
  37 ;; For instance, the following code
  38 ;;
  39 ;;   (let-alist alist
  40 ;;     (if (and .title .body)
  41 ;;         .body
  42 ;;       .site))
  43 ;;
  44 ;; expands to
  45 ;;
  46 ;;   (let ((.title (cdr (assq 'title alist)))
  47 ;;         (.body (cdr (assq 'body alist)))
  48 ;;         (.site (cdr (assq 'site alist))))
  49 ;;     (if (and .title .body)
  50 ;;         .body
  51 ;;       .site))
  52 ;;
  53 ;; Note that only one level is supported.  If you nest `let-alist'
  54 ;; invocations, the inner one can't access the variables of the outer
  55 ;; one.
  56
  57 ;;; Code:
  58 \f
  59
  60 (defun let-alist--deep-dot-search (data)
  61   "Return alist of symbols inside DATA that start with a `.'.
  62 Perform a deep search and return an alist where each car is the
  63 symbol, and each cdr is the same symbol without the `.'."
  64   (cond
  65    ((symbolp data)
  66     (let ((name (symbol-name data)))
  67       (when (string-match "\\`\\." name)
  68         ;; Return the cons cell inside a list, so it can be appended
  69         ;; with other results in the clause below.
  70         (list (cons data (intern (replace-match "" nil nil name)))))))
  71    ((not (listp data)) nil)
  72    (t (apply #'append
  73         (mapcar #'let-alist--deep-dot-search data)))))
  74
  75 ;;;###autoload
  76 (defmacro let-alist (alist &rest body)
  77   "Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
  78 Dotted symbol is any symbol starting with a `.'.  Only those present
  79 in BODY are let-bound and this search is done at compile time.
  80
  81 For instance, the following code
  82
  83   (let-alist alist
  84     (if (and .title .body)
  85         .body
  86       .site))
  87
  88 expands to
  89
  90   (let ((.title (cdr (assq 'title alist)))
  91         (.body (cdr (assq 'body alist)))
  92         (.site (cdr (assq 'site alist))))
  93     (if (and .title .body)
  94         .body
  95       .site))"
  96   (declare (indent 1) (debug t))
  97   (let ((var (gensym "let-alist")))
  98     `(let ((,var ,alist))
  99        (let ,(mapcar (lambda (x) `(,(car x) (cdr (assq ',(cdr x) ,var))))
 100                (delete-dups (let-alist--deep-dot-search body)))
 101          ,@body))))
 102
 103 (provide 'let-alist)
 104
 105 ;;; let-alist.el ends here