elisp/sch-prog.el

   1 (defun node-fun (node get-code get-links)
   2   (let ((code  (funcall get-code node))
   3         (links (funcall get-links node)))
   4     (list
   5      'lambda
   6      (car code)
   7      (cons
   8       'prog1
   9       (cons
  10        (append
  11         '(progn)
  12         ; Produce a list of commands to produce temporary bindings.
  13         (mapcar '#(lambda (x)
  14                     `(fset ',(car x)
  15                            (node-fun ,(cdr x)
  16                                      ',get-code
  17                                      ',get-links)))
  18                 links)
  19         (cdr code))
  20        ;Produce a list of commands to reset function values.
  21        (mapcar '#(lambda (x)
  22                    (if (fboundp (car x))
  23                        `(fset ',(car x)
  24                               ',(symbol-function (car x)))
  25                      `(fmakunbound ',(car x))))
  26                links))))))
  27
  28 ;; Recursively replace the chunks to recover executable code.
  29
  30 (defun tangle-module (node get-cont ins-links)
  31   (insert-chunk
  32    (funcall get-cont node)
  33    (mapcar '#(lambda (x)
  34                (cons (car x)
  35                      (tangle-module (cdr x)
  36                                     get-cont
  37                                     ins-links)))
  38            (funcall ins-links node))))
  39
  40 ;; Given a node and an association list of replacement texts, insert
  41 ;; the chunks at the appropriate places.
  42
  43 (defun insert-chunk (body chunks)
  44   (cond ((null body) nil)
  45         ((null chunks) body)
  46         ((equal (car body) '*insert*)
  47          (cdr (assoc (cadr body) chunks)))
  48         (t (cons (insert-chunk (car body) chunks)
  49                  (insert-chunk (cdr body) chunks)))))