;; company.stk -- Company & employee example

;; useful utility function for resetting the object store
(define (new . argv)
  (begin (apply run-process *program-name* :wait #t argv) (bye)))

(load "ap")

;; define the class graph

(define-class <company> ()
  ((depts :accessor depts :init-keyword :depts)))

(define-class <department> ()
  ((name :accessor name :init-keyword :name)
   (emps :accessor emps :init-keyword :emps)))

(define-class <employee> ()		;; abstract
  ((salary :accessor salary :init-keyword :salary)))

(define-class <full-time> (<employee>) ())
(define-class <part-time> (<employee>)
  ((hours :accessor hours :init-keyword :hours)))

;; define an object graph

(define the-company
  (make <company>
    :depts (list
	    (make <department> :name "marketing"
	      :emps (list (make <full-time> :salary 60000)
			  (make <full-time> :salary 90000)
			  (make <part-time> :salary 70000 :hours 20)))
	    (make <department> :name "sales"
	      :emps (list (make <full-time> :salary 70000)
			  (make <part-time> :salary 60000 :hours 25))))))


;; define some visitors

(define-visitor <count>
  :params (target)
  :locals ((total :initform 0))
  :polymorphic-methods? #t
  :methods ((before target
	      (set! total (1+ total)))))

(define-visitor <sum>
  :params (target part)
  :locals ((total :initform 0))
  :polymorphic-methods? #t
  :methods ((before (elt target)
	      (set! total (+ total [part elt])))))

(define-visitor <avg-per-emp-in-comp>
  :params (part)
  :locals (cv sv)
  :methods ((before <company>
	      (set! cv (make <count> :target <employee>))
	      (set! sv (make <sum> :target <employee> :part part))
	      (add-visitors cv sv))))

(define-method count ((v <avg-per-emp-in-comp>))
  [total [cv v]])
(define-method sum ((v <avg-per-emp-in-comp>))
  [total [sv v]])
(define-method average ((v <avg-per-emp-in-comp>))
  (/ (sum v) (count v)))

(define-visitor <print-count-sum-avg-sal-emp-comp>
  :locals (avg)
  :methods ((before <company>
	      (set! avg (make <avg-per-emp-in-comp> :part salary))
	      (add-visitors avg))
	    (after <company>
	      (format #t "~%employees: ~a total salary: ~a average salary: ~a~%"
		      (count avg) (sum avg) (average avg)))))

;; define some directives

(define whole-company (make <path>))
(define to-full-time (to <employee> :bypassing <part-time>))
(define to-dept (to <department>))

;; now visit some visitors

(define-method test ()
  (traverse whole-company the-company
	    (make <print-count-sum-avg-sal-emp-comp> :path to-full-time)
	    (make <pretty-print>)))