elisp/sch-prog-demo.el

   1 ;; sch-prog-demo.el - Minimal example of scholiumific programming
   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 ;; See http://arxana.net/foo-goo.jpg for a vital map.
  21
  22 ;;; CODE:
  23
  24 (load-file "bootstart.el")
  25
  26 (defun filter (pred stuff)
  27   (let ((ans nil))
  28     (dolist (item stuff (reverse ans))
  29       (if (funcall pred item)
  30           (setq ans (cons item ans))
  31         nil))))
  32
  33 ;; Make a new scholium-based document.
  34
  35 (defun gen-gnd ()
  36  '(1 (0 (0) () (0))))
  37
  38 (setq article-list (gen-gnd))
  39
  40 ;; Put the main program in a node.
  41
  42 (ins-nod (get-gnd)
  43          '((list (foo 5)
  44                  (goo 6)))
  45          (get-gnd))
  46
  47 => 1
  48
  49 ;; Put two subroutines in their own nodes.
  50
  51 (ins-nod (get-gnd)
  52          '((* x x))
  53          (get-gnd))
  54
  55 => 2
  56
  57 (ins-nod (get-gnd)
  58          '((+ x 3))
  59          (get-gnd))
  60 => 3
  61
  62 ;; Make links from the main program to its subroutines.  The text of
  63 ;; the link states the name of the subroutine.
  64
  65 (ins-nod 1 '(sub foo) 2)
  66 => 4
  67
  68 (ins-nod 1 '(sub goo) 3)
  69 => 5
  70
  71 ;; Add nodes and links for the variables.
  72
  73 (ins-nod (get-gnd)
  74          nil
  75          (get-gnd))
  76 => 6
  77
  78 ;; Argument list of node 1 (points to node 6, which contains nil)
  79 ;; In order words, List 1 doesn't have any unbound variables.
  80 (ins-nod 6 'var 1)
  81 => 7
  82
  83 (ins-nod (get-gnd)
  84          '(x)
  85          (get-gnd))
  86 => 8
  87
  88 ;; Argument listS of node 2 and node 3
  89 (ins-nod 8 'var 2)
  90 => 9
  91
  92 (ins-nod 8 'var 3)
  93 => 10
  94
  95 ; We provide functions to identify scholia of type
  96 ;; var and sub and retrieve the appropriate data.
  97
  98 (defun get-dependencies (art)
  99   (mapcar '(lambda (x)
 100              (list (cadr (get-txt x))
 101                    (get-snk x)))
 102           (filter
 103            '(lambda (y)
 104               (equal 'sub
 105                      (car (get-txt y))))
 106            (get-flk art))))
 107
 108 (defun get-vars (art)
 109   (delete-dups
 110    (apply 'append
 111           (mapcar
 112            '(lambda (x)
 113               (get-txt (get-src x)))
 114            (filter
 115             '(lambda (y)
 116                (equal 'var (get-txt y)))
 117             (get-blk art))))))
 118
 119 ;; Here is the output they produce:
 120
 121 (get-dependencies 1)
 122   =>
 123 ((goo 3) (foo 2))
 124
 125 (get-vars 2)
 126   =>
 127 (x)
 128
 129 ;; Using these functions, we evaluate our node.  Remember that the code
 130 ;; at node 1 is supposed to invoke foo and goo, which are found as
 131 ;; scholia attached to node 2.  As we see, it does this correctly.
 132
 133 (funcall (node-fun 1
 134           'get-txt
 135           'get-vars
 136           'get-dependencies))
 137 => (25 9)
 138
 139 ;; In case you're interested, here are the gory details of how
 140 ;; node-fun wrapped up the code inside the node.
 141
 142 (node-fun 1
 143           'get-txt
 144           'get-vars
 145           'get-dependencies)
 146   =>
 147 (lambda nil (flet ((goo (x) (apply (node-fun 3
 148                                              (quote get-txt)
 149                                              (quote get-vars)
 150                                              (quote get-dependencies))
 151                                    (list x)))
 152                    (foo (x) (apply (node-fun 2
 153                                              (quote get-txt)
 154                                              (quote get-vars)
 155                                              (quote get-dependencies))
 156                                    (list x))))
 157               (list (foo 5) (goo 6))))
 158
 159
 160 (node-fun 3
 161           'get-txt
 162           'get-vars
 163           'get-dependencies)
 164 =>
 165 (lambda (x) (flet nil (+ x 3)))
 166
 167 (get-txt 3) => ((+ x 3))
 168 (get-vars 3) => (x)
 169 (get-dependencies 3) => nil
 170
 171
 172 (get-txt 6) => nil
 173 (set-txt 6 '(y)) => (y)
 174
 175 (node-fun 1
 176           'get-txt
 177           'get-vars
 178           'get-dependencies)
 179 => (lambda (y) (flet ((goo (x) (apply (node-fun 3 (quote get-txt) (quote get-vars) (quote get-dependencies)) (list x)))
 180                       (foo (x) (apply (node-fun 2 (quote get-txt) (quote get-vars) (quote get-dependencies)) (list x))))
 181                  (list (foo 5) (goo 6))))
 182
 183 (get-txt 1) => ((list (foo 5) (goo 6)))
 184 (set-txt 1 '((list (foo 5) (goo  y))))((list (foo 5) (goo y)))
 185
 186 (node-fun 1
 187           'get-txt
 188           'get-vars
 189           'get-dependencies)
 190 (defun joe-function (y)
 191   (flet ((goo (x) (apply (node-fun 3 (quote get-txt) (quote get-vars) (quote get-dependencies)) (list x)))
 192          (foo (x) (apply (node-fun 2 (quote get-txt) (quote get-vars) (quote get-dependencies)) (list x))))
 193     (list (foo 5) (goo y))))
 194
 195 (joe-function 16)(25 19)
 196
 197 (funcall (node-fun 1
 198                    'get-txt
 199                    'get-vars
 200                    'get-dependencies)
 201          16)(25 19)