(in-package :vag)

(vagprim foo anything ((x anything))
    (true)
  `(foo ,x))

(defun test0 ()
  (vag-init)
  (equate-vars (intern-exp 'x) (intern-exp 'y))
  (list (intern-exp '(foo x)) (intern-exp '(foo y))))

(defun test.5 ()
  (vag-init)
  (let ((v1 (intern-exp '(foo (foo x))))
	(v2 (intern-exp '(foo (foo y)))))
    (equate-vars (intern-exp 'x) (intern-exp 'y))
    (list (var-find v1) (var-find v2))))

(defun test1 ()
  (vag-init)
  (setq a (intern-exp 'x))
  (setq fffa (intern-exp '(foo (foo (foo x)))))
  (setq f5a (intern-exp `(foo (foo ,fffa))))
  (equate-vars f5a a)
  (equate-vars fffa a)
  (list (intern-exp 'x) (intern-exp '(foo x))))

(vagdef sum number ((l (list-of number)))
    (true)
  (if (equal l (nil))
      0
      (+ (car l) (sum (cdr l)))))

(defun test2 ()
  (vag-init)
  (setq mapvar (intern-exp '(sum (map (lambda (x) (+ 1 x)) (list 1 2 3)))))
  (add-property mapvar 'compute! nil)
  (var-value mapvar))



;========================================================================
;a cabinet design
;========================================================================


(declare-sort drawer)

(vagdef make-drawer drawer ((height number) (width number))
    (true)
  (list 'the-drawer height width))

(vagdef drawer-width float ((d drawer))
    (true)
  (car (cdr (cdr d))))

(vagdef drawer-height float ((d drawer))
    (true)
  (car (cdr d)))

(vagdef every boolean ((l (list-of boolean)))
    (true)
  (if (equal l (nil))
      (true)
      (and (car l) (every (cdr l)))))

(vagdef some boolean ((l (list-of boolean)))
    (true)
  (if (equal l (nil))
      (false)
      (or (car l) (some (cdr l)))))

(declare-sort cabinet)


(vagdef make-cabinet cabinet ((height float) (width float) (drawers (list-of drawer)))
    (and (> height 0)
	 (> width 0)
	 (= (sum (map (lambda (x) (drawer-height x)) drawers))
	    (- height .5))
	 (every (map (lambda (drawer) (= (drawer-width drawer) (- width .5)))
		     drawers)))
  (list 'the-cabinet height width drawers))

(vagdef cabinet-height float ((c cabinet))
    (true)
  (car (cdr c)))

(vagdef cabinet-width float ((c cabinet))
    (true)
  (car (cdr (cdr c))))

(vagdef cabinet-drawers (list-of drawer) ((c cabinet))
    (true)
  (car (cdr (cdr (cdr c)))))

(defun test3 ()
  (vag-init)
  (setq d1 (intern-exp '(make-cabinet 10.0 w1
			 (list (make-drawer 3.0 3.0)
			       (make-drawer 3.0 w2)
			       (make-drawer h1 w3)))))
  (add-property d1 'filter! nil)
  (mapcar 'show-value '(w1 w2 h1 w3)))

(defun show-value (varname)
  (list varname (var-value (intern-exp varname))))


;========================================================================
;a second cabinet design
;this shows how lisp can be used as the underlying language for
;implementing the components.  Note the use of vagprim rather than
;vagdef.
;========================================================================


(declare-sort drawer2)

(defstruct drawer2
  height
  width)

;the body of the following definitions are in lisp (because of the use
;of vagprim rather than vagdef).

(vagprim drawer2-width float ((d drawer2))
    (true)
  (drawer2-width d))

(vagprim drawer2-height float ((d drawer2))
    (true)
  (drawer2-height d))

(vagprim make-drawer2 drawer2 ((height number) (width number))
    (and (= (drawer2-height (make-drawer2 height width)) height)
	 (= (drawer2-width (make-drawer2 height width)) width))
  (make-drawer2 :height height :width width))


(declare-sort cabinet2)

(defstruct cabinet2
  height
  width
  drawers)

(vagprim cabinet2-height float ((c cabinet2))
    (true)
  (cabinet2-height c))

(vagprim cabinet2-width float ((c cabinet2))
    (true)
  (cabinet2-width c))

(vagprim cabinet2-drawers (list-of drawer) ((c cabinet2))
    (true)
  (cabinet2-drawers c))

(vagprim make-cabinet2 cabinet2 ((height float) (width float) (drawers (list-of drawer2)))
    (and (> height 0)
	 (> width 0)
	 (= (cabinet2-height (make-cabinet2 height width drawers)) height)
	 (= (cabinet2-width (make-cabinet2 height width drawers)) width)
	 (equal (cabinet2-drawers (make-cabinet2 height width drawers)) drawers)
	 (= (sum (map (lambda (x) (drawer2-height x)) drawers))
	    (- height .5))
	 (every (map (lambda (drawer) (= (drawer2-width drawer) (- width .5)))
		     drawers)))
  (make-cabinet2 :height height :width width :drawers drawers))

(defun test4 ()
  (vag-init)
  (setq d1 (intern-exp '(make-cabinet2 10.0 w1
			 (list (make-drawer2 3.0 3.0)
			       (make-drawer2 3.0 w2)
			       (make-drawer2 h1 w3)))))
  (add-property d1 'filter! nil)
  (mapcar 'show-value '(w1 w2 h1 w3)))


;========================================================================
;test5
;========================================================================

;This is a rudimentary test of the user interface.

(defvar root nil)

(defun test5 ()
  (vag-init)
  (setq root (new_instance 'make-cabinet))
  (let ((c1 (new_instance 'cons))
	(c2 (new_instance 'cons))
	(c3 (new_instance 'cons)))
    (make-connection root 3 c1)
    (make-connection c1 2 c2)
    (make-connection c2 2 c3)
    (rprint (glue-expression root))
    (undo-connection root 3)
    (rprint (glue-expression root))
    (make-connection root 3 c1)
    (rprint (glue-expression root))))



;========================================================================
;example6
;this shows the consrtruction of a circular structure.
;========================================================================

(declare-sort simple-filter)

(declare-sort signal)

(declare-function (filter-input simple-filter) signal)

(declare-function (filter-output simple-filter) signal)

(declare-function (signal-sum signal signal) signal)

(declare-function (signal-scale float signal) signal)

(vagprim feedback-loop simple-filter ((internal-filter simple-filter) (gain float))
    (and (equal (filter-input internal-filter)
		(filter-output (feedback-loop internal-filter gain)))
	 (equal (filter-output (feedback-loop internal-filter gain))
		(signal-sum (filter-input (feedback-loop internal-filter gain))
			    (signal-scale gain (filter-output internal-filter)))))
  (make-feedback-loop internal-filter gain))

;in a real system this would create a circuit with a feedback loop.
;I have not connected this to the software circuits code.

(defun make-feedback-loop (f g)
  (list 'make-feedback-loop f g))