vis.scm

;;; AST
(define-class <expr> ()
  ())

(define-class <int-expr> (<expr>)
  ((value :init-keyword :value)))

(define-class <binop-expr> (<expr>)
  ())

(define-class <add-expr> (<binop-expr>)
  ((lhs :init-keyword :lhs)
   (rhs :init-keyword :rhs)
   ))

(define-class <mul-expr> (<binop-expr>)
  ((lhs :init-keyword :lhs)
   (rhs :init-keyword :rhs)
   ))

(define-class <postorder-visitor> ()
  ())

(define-method visited ((v <postorder-visitor>) (e <expr>))
  #f)

(define-method visit ((v <postorder-visitor>) (e <int-expr>))
  (visited v e))

(define-method visit ((v <postorder-visitor>) (e <binop-expr>))
  (visit v (slot-ref e 'lhs))
  (visit v (slot-ref e 'rhs))
  (visited v e))

;;; lispify - convert <expr> to lispy expression
(define-class <lispify-visitor> (<postorder-visitor>)
  ((stack :init-value '())))

(define-method visit ((v <lispify-visitor>) (e <int-expr>))
  (push! (slot-ref v 'stack) (slot-ref e 'value)))

(define-method visited ((v <lispify-visitor>) (e <add-expr>))
  (let* ((rhs (pop! (slot-ref v 'stack)))
         (lhs (pop! (slot-ref v 'stack))))
    (push! (slot-ref v 'stack) `(+ ,lhs ,rhs))))

(define-method visited ((v <lispify-visitor>) (e <mul-expr>))
  (let* ((rhs (pop! (slot-ref v 'stack)))
         (lhs (pop! (slot-ref v 'stack))))
    (push! (slot-ref v 'stack) `(* ,lhs ,rhs))))

(define (lispify expr)
  (let ((v (make <lispify-visitor>)))
    (visit v expr)
    (pop! (slot-ref v 'stack))))

;;; evaluator
(define-class <eval-visitor> (<postorder-visitor>)
  ((stack :init-value '())))

(define-method visited ((v <eval-visitor>) (e <int-expr>))
  (push! (slot-ref v 'stack) (slot-ref e 'value)))

(define-method visited ((v <eval-visitor>) (e <add-expr>))
  (let* ((rhs (pop! (slot-ref v 'stack)))
         (lhs (pop! (slot-ref v 'stack))))
    (push! (slot-ref v 'stack) (+ lhs rhs))))

(define-method visited ((v <eval-visitor>) (e <mul-expr>))
  (let* ((rhs (pop! (slot-ref v 'stack)))
         (lhs (pop! (slot-ref v 'stack))))
    (push! (slot-ref v 'stack) (* lhs rhs))))

(define (eval-expr expr)
  (let ((v (make <eval-visitor>)))
    (visit v expr)
    (pop! (slot-ref v 'stack))))

;;; leaf-count
(define-class <leaf-count-visitor> (<postorder-visitor>)
  ((count :init-value 0)))

(define-method visited ((v <leaf-count-visitor>) (e <int-expr>))
  (inc! (slot-ref v 'count)))

(define (count-leaves expr)
  (let ((v (make <leaf-count-visitor>)))
    (visit v expr)
    (slot-ref v 'count)))

;;; fold-visitor
(define-class <fold-visitor> ()
  ())

(define-method visit ((v <fold-visitor>) (e <int-expr>))
  ((visitor-folder v e) (slot-ref e 'value)))

(define-method visit ((v <fold-visitor>) (e <binop-expr>))
  ((visitor-folder v e)
   (visit v (slot-ref e 'lhs))
   (visit v (slot-ref e 'rhs))))

(define-class <fold-eval-visitor> (<fold-visitor>)
  ())

(define-method visitor-folder ((v <fold-eval-visitor>) (e <int-expr>))
  values)

(define-method visitor-folder ((v <fold-eval-visitor>) (e <add-expr>))
  +)

(define-method visitor-folder ((v <fold-eval-visitor>) (e <mul-expr>))
  *)

(define (fold-eval-expr expr)
  (let ((v (make <fold-eval-visitor>)))
    (visit v expr)))

;;; test
(define expr
  ;; 1 + 2 * 3
  (make <add-expr>
    :lhs (make <int-expr> :value 1)
    :rhs (make <mul-expr>
           :lhs (make <int-expr> :value 2)
           :rhs (make <int-expr> :value 3))))

(lispify expr)
;; => (+ 1 (* 2 3))

(eval-expr expr)
;; => 7

(count-leaves expr)
;; => 3

(fold-eval-expr expr)
;; => 7