;; see On Lisp, section 6.
(require 'stdlib)
(require 'rep.data.tables)

(define (setup-nodes)
  (defnode 'people "Is the person a man?" 'male 'female)
  (defnode 'male "Is he living?" 'liveman 'deadman)
  (defnode 'female 'Babette)
  (defnode 'liveman 'Sjaak)
  (defnode 'deadman 'Lincoln))

;; ----------------------------------------------------------------------
;; representation with data structure and code

(define nodes (make-table symbol-hash #'equal))

(define (defnode name contents #!optional yes no)
  (table-set nodes name (list contents yes no)))

(define (node-contents node) (first node))
(define (node-yes node) (second node))
(define (node-no node) (third node))

(define (run-node name)
  (let ((node (table-ref nodes name)))
    (cond ((node-yes node)
           (printf "%s > " (node-contents node))
           (case (read)
             ((yes) (run-node (node-yes node)))
             (t (run-node (node-no node)))))
          (t (node-contents node)))))

(setup-nodes)
;; (run-node 'people)

;; ----------------------------------------------------------------------
;; representation with closures

(define (defnode name contents #!optional yes no)
  (table-set nodes name
             (if yes
                 (lambda ()
                   (printf "%s > " contents)
                   (case (read)
                     ((yes) (funcall (table-ref nodes yes)))
                     (t (funcall (table-ref nodes no)))))
               (lambda () contents))))

(setup-nodes)
;; (funcall (table-ref nodes 'people))

;; ----------------------------------------------------------------------
;; compiled network

(define nodes nil)

(define (defnode #!rest args)
  (setq nodes (nconc nodes (list args))))

(define (compile-net root)
  (let ((node (assoc root nodes)))
    (if (null node)
        nil
      (let ((contents (second node))
            (yes (third node))
            (no (fourth node)))
        (if yes
            (let ((yes-fn (compile-net yes))
                  (no-fn (compile-net no)))
              (lambda ()
                (printf "%s > " contents)
                (funcall (if (eq (read) 'yes)
                             yes-fn
                           no-fn))))
          (lambda () contents))))))

(setup-nodes)
;; (define net (compile-net 'people))

;; After compile-net has run we can dump the nodes list, because
;; *everything* was compiled into code -- the tell-tale sign of a
;; compiler. The first two implementations don't allow this.
;; (define nodes nil)

;; (funcall net)

;; ----------------------------------------------------------------------
;; Note that compile-net compiles in both senses. It compiles in the
;; general sense, by translating the abstract representation of the
;; network into code. Moreover, if compile-net itself is compiled, it
;; will return compiled functions. (see pp 25) (*)

;; (*) pp 25: Later chapters will depend on another effect of
;; compilation: when one function occurs within another function, and
;; the containing function is compiled, the inner function will also
;; get compiled. CLTL2 does not seem to say explicitly that this will
;; happen, but in a decent implementation you can count on it.  The
;; compiling of inner functions becomes evident in functions which
;; return functions. When make-adder (page 18) is compiled, it will
;; return compiled functions:
;;
;; > (compile 'make-adder)
;; MAKE-ADDER
;; > (compiled-function-p (make-adder 2))
;; T
;; 
;; As later chapters will show, this fact is of great importance in
;; the implementation of embedded languages. If a new language is
;; implemented by transformation, and the transformation code is
;; compiled, then it yields compiled output -- and so becomes in
;; effect a compiler for the new language.