Added astruct.el
[com-informatimago:emacs.git] / astruct.el
1 ;; Implements structure as alists prefixed by the structure type name.
2 ;; json uses this kind of alist.
3
4 (defun alistp% (slow fast)
5   (or (null slow)
6       (and (not (eq slow fast))
7            (consp slow)
8            (consp (car slow))
9            (listp fast)
10            (listp (cdr fast))
11            (alistp% (cdr slow) (cddr fast)))))
12
13 (defun alistp (object)
14   (or (null object)
15       (and (consp object)
16            (alistp% object (cdr object)))))
17
18 (assert (not (alistp '#1=((1 . 2) . #1#))))
19 (assert (not (alistp '((1 . 2) (3 . 4) . x))))
20 (assert (not (alistp '((1 . 2) (3 . 4)  x (5 . 6)))))
21 (assert (alistp '((1 . 2) (3 . 4) (5 . 6))))
22 (assert (alistp '((1 . 2) (3 . 4))))
23 (assert (alistp '((1 . 2))))
24 (assert (alistp '()))
25
26
27 (defmacro define-structure (name fields)
28   `(progn
29      (defun* ,(intern (format "make-%s" name)) (&rest fields &key ,@fields)
30        (cons ',name (mapcar* (function cons) ',fields fields)))
31      ,@(mapcan (lambda (field)
32                  (list
33                   `(defun ,(intern (format "%s-%s" name field)) (structure)
34                     (cdr (assoc ',field (cdr structure))))
35                   `(defun ,(intern (format "set-%s-%s" name field)) (structure value)
36                     (let ((entry (assoc ',field (cdr structure))))
37                       (if (null entry)
38                           (push (cons ',field value) (cdr structure))
39                           (setf (cdr entry) value))
40                       value))
41                   `(defun ,(intern (format "%s-p" name)) (object)
42                      (and (consp object)
43                           (eq ',name (car object))
44                           (alistp (cdr object))))))
45                fields)
46      ',name))