;;
;; define-datatype and cases
;;

(load "chez-init.scm")

(define-datatype 3Dtree 3Dtree? 
  (leaf-node 
    (datum number?))
  (interior-node
    (key symbol?) 
    (x 3Dtree?)
    (y 3Dtree?)
    (z 3Dtree?)))

(define leaf-sum 
  (lambda (tree)
    (cases 3Dtree tree
	   (leaf-node (datum) datum)
	   (interior-node (key x y z)
			  (+ (leaf-sum x) (leaf-sum y) (leaf-sum z))))))

;; e.g.:

(define a-tree (interior-node 'a (leaf-node 1) (leaf-node 2) (leaf-node 3)))

(leaf-sum a-tree)

(define pre-order
  (lambda (tree)
    (cases 3Dtree tree
	   (leaf-node (datum) datum)
	   (interior-node (key x y z)
		(list key (pre-order x)
		      (pre-order y)
		      (pre-order z))))))

(define post-order
  (lambda (tree)
    (cases 3Dtree tree
	   (leaf-node (datum) datum)
	   (interior-node (key x y z)
		(list (post-order x)
		      (post-order y)
		      (post-order z) key )))))

(define b-tree (interior-node 'b (leaf-node 4) (leaf-node 5) (leaf-node 6)))
(define c-tree (interior-node 'c (leaf-node 7) (leaf-node 8) (leaf-node 9)))

(define the-tree
  (interior-node 't a-tree b-tree c-tree))

(pre-order the-tree)
(post-order the-tree)

;;
;; following copied from book's online code:
;;

(define-datatype expression expression? 
  (var-exp
    (id symbol?))
  (lambda-exp
    (id symbol?)
    (body expression?))
  (app-exp
    (rator expression?)
    (rand expression?)))

(define unparse-expression
  (lambda (exp)
    (cases expression exp
      (var-exp (id) id)
      (lambda-exp (id body) 
        (list 'lambda (list id)
          (unparse-expression body)))
      (app-exp (rator rand)
        (list (unparse-expression rator)
              (unparse-expression rand))))))

(define parse-expression
  (lambda (datum)
    (cond
      ((symbol? datum) (var-exp datum))
      ((pair? datum)
       (if (eqv? (car datum) 'lambda)
         (lambda-exp (caadr datum)
           (parse-expression (caddr datum)))
         (app-exp
           (parse-expression (car datum))
           (parse-expression (cadr datum)))))
      (else (eopl:error 'parse-expression
              "Invalid concrete syntax ~s" datum)))))

(define occurs-free?
  (lambda (var exp)
    (cases expression exp
      (var-exp (id) (eqv? id var))
      (lambda-exp (id body)
        (and (not (eqv? id var))
             (occurs-free? var body)))
      (app-exp (rator rand)
        (or (occurs-free? var rator)
            (occurs-free? var rand))))))