(define *interactive-printing* #t)

(define (referent ckt path)
  ((eq-path path) ckt))

(define (the-value ckt variable-path)
  (let ((connector ((eq-path variable-path) ckt)))
    (if connector
	(let ((assignment (connector-assignment connector)))
	  (if (value-assigned? assignment)
	      (begin
		(if *interactive-printing*
		    (let ((just (node-in? assignment)))
		      (display "; ")
		      (pp `(,(name-of connector)
			    =
			    ,(assignment-value assignment)))
		      (let ((j (name-of (justification-reason just))))
			(display ";   ")
			(if j
			    (begin (pp `(set by ,j))
				   (display ";     ")
				   (pp `(because
					 ,(map (compose name-of
							(lambda (ass)
							  (eq-get ass 'connector)))
					       (justification-antecedents just)))))
			    (pp `(set by assumption))))))
		(assignment-value assignment))
	      (if *interactive-printing*
		  (begin (display "; ")
			 (pp `(,(name-of connector) is not assigned))
			 #f)
		  #f)))
	(if *interactive-printing*
	    (begin (display "; ")
		   (pp `(,variable-path does not specify a variable))
		   #f)
	    (error "variable-path does not specify a variable" variable-path)))))

(define (assume-value ckt variable-path value)
  (let ((connector ((eq-path variable-path) ckt)))
    (if connector
	(let ((assignment (connector-assignment connector)))
	  (if (value-assigned? assignment)
	      (let ((just (node-in? assignment)))
		(if *interactive-printing*
		    (begin
		      (display "; Already assigned a value")
		      (newline)
		      (display "; ")
		      (pp `(,(name-of connector) = ,(assignment-value assignment))))))
	      (connector-assume-value! connector value)))
	(if *interactive-printing*
	    (begin (display "; ")
		   (pp `(,variable-path does not specify a variable))
		   #f)
	    (error "variable-path does not specify a variable" variable-path)))))

(define (retract-assumed-value ckt variable-path)
  (let ((connector ((eq-path variable-path) ckt)))
    (if connector
	(if (connector-retract-value-assumption! connector)
	    'done
	    (if *interactive-printing*
		(begin
		  (display "; ")
		  (pp `(Cannot retract -- value supported by other assumptions)))))
	(if *interactive-printing*
	    (begin (display "; ")
		   (pp `(,variable-path does not specify a variable))
		   #f)
	    (error "variable-path does not specify a variable" variable-path)))))

(define (show-reasons ckt path)
  (if (tms-node? path)
      (if (node-in? path)
	  (explain path)
	  `(There is no support for ,path))
      (let ((target ((eq-path path) ckt)))
	(cond ((connector? target)
	       (let ((assignment (connector-assignment target)))
		 (if (value-assigned? assignment)
		     (explain assignment)
		     `(There is no support for an assignment of ,path))))
	      (else
	       `(Support? ,path))))))


(define (support ckt path)
  (if (tms-node? path)
      (if (node-in? path)
	  (map (compose name-of circuit-object)
	       (assumptions-supporting path))
	  `(There is no support for ,path))
      (let ((target ((eq-path path) ckt)))
	(cond ((connector? target)
	       (let ((assignment (connector-assignment target)))
		 (if (value-assigned? assignment)
		     (map (compose name-of circuit-object)
			  (assumptions-supporting assignment))
		     `(There is no support for an assignment of ,path))))
	      (else
	       `(Support? ,path))))))

(define (assumptions-supporting node)
  (let ((just (node-in? node)))
    (assert just)
    (if (symbol? just)
	(list node)
	(let ((p (eq-get node 'premise-node)))
	  (if (and p (node-in? p))
	      (list node)
	      (begin (assert (not (eq? (justification-reason just) 'assumption)))
		     (reduce eq-set/union '()
			     (map assumptions-supporting
				  (justification-antecedents just)))))))))