elisp/sch-prog-etalk.el

   1 ;; Demonstration of scholiumific programming
   2
   3 ;; Define the utility for running code.
   4
   5 (defun node-fun (node retrieve-code
   6                       retrieve-vars
   7                       retrieve-link)
   8   (list (quote lambda)
   9         (funcall retrieve-vars node)
  10         (cons (quote flet)
  11               (cons
  12                (mapcar
  13                 (lambda (item)
  14                   (let ((var-list
  15                          (funcall retrieve-vars (cadr item))))
  16                     (\` ((\, (car item))
  17                          (\, var-list)
  18                          (apply (node-fun (\, (cadr item))
  19                                           (quote (\, retrieve-code))
  20                                           (quote (\, retrieve-vars))
  21                                           (quote (\, retrieve-link)))
  22                                 (\, (cons (quote list) var-list)))))))
  23                 (funcall retrieve-link node))
  24                (funcall retrieve-code node)))))
  25
  26 ;; Make a new scholium-based document.
  27
  28 (set-current-plexus (add-plexus))
  29
  30 ;; Place the program in the document.
  31
  32 (upload-en-masse
  33  '((0 "ground" 0 0)
  34    (1 "type" 0 0)
  35    (2 "main-prog" 0 0 (list (foo 5) (goo 6)))
  36    (3 "sub-foo" 0 0 (* x x))
  37    (4 "sub-goo" 0 0 (+ x 3))
  38    (5 "link-foo" 2 3 sub foo)
  39    (6 "link-goo" 2 4 sub goo)
  40    (7 "main-vars" 0 0)
  41    (8 "main-args" 7 2 . var)
  42    (9 "sub-vars" 0 0 x)
  43    (10 "foo-args" 9 3 . var)
  44    (11 "goo-args" 9 4 . var)))
  45
  46 ; We provide functions to identify scholia of type
  47 ;; var and sub and retrieve the appropriate data.
  48
  49 (defun get-dependencies (art)
  50   (mapcar '(lambda (x)
  51              (list (cadr (get-content x))
  52                    (get-sink x)))
  53           (filter
  54            '(lambda (y)
  55               (equal 'sub
  56                      (car (get-content y))))
  57            (get-forward-links art))))
  58
  59 (defun get-vars (art)
  60   (delete-dups
  61    (apply 'append
  62           (mapcar
  63            '(lambda (x)
  64               (get-content (get-source x)))
  65            (filter
  66             '(lambda (y)
  67                (equal 'var (get-content y)))
  68             (get-backward-links art))))))
  69
  70 ;; Here is the output they produce:
  71
  72 (get-dependencies (label2uid "main-prog"))
  73 ;;   =>
  74 ;; ((goo 4) (foo 3))
  75
  76 (get-vars  (label2uid "sub-foo"))
  77 ;;   =>
  78 ;; (x)
  79
  80 ;; Using these functions, we evaluate our node.  Remember that the code
  81 ;; at "main-prog" is supposed to invoke foo and goo, which are found as
  82 ;; scholia attached to that node.  As we see, it does this correctly.
  83
  84 (funcall (node-fun
  85           (label2uid "main-prog")
  86           'get-content
  87           'get-vars
  88           'get-dependencies))
  89 ;; => (25 9)
  90
  91 ;; In case you're interested, here are the gory details of how
  92 ;; node-fun wrapped up the code inside the node.
  93
  94 (node-fun (label2uid "main-prog")
  95           'get-content
  96           'get-vars
  97           'get-dependencies)
  98
  99 ;;   =>
 100
 101 ;; (lambda nil (flet ((goo (x) (apply (node-fun 4
 102 ;;                                           (quote get-content)
 103 ;;                                           (quote get-vars)
 104 ;;                                           (quote get-dependencies))
 105 ;;                                 (list x)))
 106 ;;                 (foo (x) (apply (node-fun 3
 107 ;;                                           (quote get-content)
 108 ;;                                           (quote get-vars)
 109 ;;                                           (quote get-dependencies))
 110 ;;                                 (list x))))
 111 ;;            (list (foo 5) (goo 6))))
 112
 113 (node-fun (label2uid "sub-goo")
 114           'get-content
 115           'get-vars
 116           'get-dependencies)
 117 ;; =>
 118 ;; (lambda (x) (flet nil (+ x 3)))
 119
 120 (get-content (label2uid "sub-goo")) ; => ((+ x 3))
 121 (get-vars (label2uid "sub-goo")) ; => (x)
 122 (get-dependencies (label2uid "sub-goo")) ; => nil