elisp/prelim.el

   1 ;; prelim.el - Handy definitions, macros, and functions for hacking arxana or other projects.
   2
   3 ;; Copyright (C) 2013 Raymond S. Puzio
   4
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU Affero General Public License as published by
   7 ;; the Free Software Foundation, either version 3 of the License, or
   8 ;; (at your option) any later version.
   9
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU Affero General Public License for more details.
  14
  15 ;; You should have received a copy of the GNU Affero General Public License
  16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;;; COMMENTARY:
  19
  20 ;;; CODE:
  21
  22 ;; Useful utility to filter elements of a list satisfying a condition.
  23
  24 (defun filter (pred stuff)
  25   (let ((ans nil))
  26     (dolist (item stuff (reverse ans))
  27       (if (funcall pred item)
  28           (setq ans (cons item ans))
  29         nil))))
  30
  31 ;; (filter '(lambda (x) (= (% x 2) 1)) '(1 2 3 4 5 6 7))
  32 ;; => (1 3 5 7)
  33
  34 ;; Map and apply rolled into one.
  35
  36 (defun mapply (f l)
  37   (if (member nil l) nil
  38     (cons (apply f (mapcar 'car l))
  39           (mapply f (mapcar 'cdr l)))))
  40
  41 ;;(mapply '+ '((1 2) (3 4)))
  42 ;; => (4 6)
  43
  44 ;; This is more general than the `intersection' packaged with common lisp
  45
  46 (defun intersection (&rest arg)
  47   (cond ((null arg) nil)
  48         ((null (cdr arg)) (car arg))
  49         (t (let ((ans nil))
  50              (dolist (elmt (car arg) ans)
  51                (let ((remainder (cdr arg)))
  52                      (while (and remainder
  53                                  (member elmt (car remainder)))
  54                        (setq remainder (cdr remainder))
  55                        (when (null remainder)
  56                          (setq ans (cons elmt ans))))))))))
  57
  58 ;; (intersection '(a b c d e f g h j)
  59 ;;               '(a b h j k)
  60 ;;               '(b d g h j k))
  61 ;;   =>
  62 ;; (j h b)
  63
  64 ;; Substitute for objects in a list.
  65
  66 (defun sublis (sub lis)
  67   (cond
  68    ((null lis) nil)
  69    ((assoc lis sub) (cadr (assoc lis sub)))
  70    ((atom lis) lis)
  71    (t (cons (sublis sub (car lis))
  72             (sublis sub (cdr lis))))))
  73
  74 ;; (sublis '((a 1) (b 2) ((1 2 3) c))
  75 ;;      '((a b c) (1 2 3)))
  76 ;;   =>
  77 ;; ((1 2 c) c)
  78
  79
  80
  81
  82