#| -*-Scheme-*-

$Id$

Copyright 2006 Massachusetts Institute of Technology

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
USA.

|#

;;; Explains why a connector has a particular assignment.

(define (cp:why? connector #!optional port)
  (if (cp:has-value? connector)
      (cp:explain-node (cp:supported-assignment connector) port)
      (display "; The connector is not assigned.\n" port)))

(define (cp:explain-contradiction network #!optional port)
  (let ((node (tms:contradiction (cp:network-tms network))))
    (if (tms:node-supported? node)
	(cp:explain-node node)
	(display "; There is no contradiction outstanding.\n" port))))

(define (cp:explain-node node #!optional port)
  (tms:walk-node-support node
    (lambda (consequent just antecedents support)
      (define (id) (tms:node-id consequent))
      (define (reason)
	(cond ((tms:premise-justification? just) '(premise))
	      (else
	       `(,(cp:just-id just)
		 ,@(map tms:node-id antecedents)))))
      (let ((support (map tms:node-id support)))
	(cond ((cp:assignment? consequent)
	       (pp-comment
		`(,(id)
		  ,(list (cp:connector-name
			  (cp:assignment-connector consequent))
			 '=
			 (simplify
			  (cp:assignment-value consequent)))
		  ,(reason)
		  ,support))
	       port)
	      ((cp:equation? consequent)
	       (pp-comment
		`(,(id)
		  ,(cp:equation-datum-residual (tms:node-datum consequent))
		  ,(reason)
		  ,support)
		port))
	      (else
	       (pp-comment
		`(,(id)
		  ,(tms:node-datum consequent)
		  ,(reason)
		  ,support)
		port)))))))

(define (tms:node-id node)
  (symbol 'n (object-hash node)))

(define (cp:just-id just)
  (let ((rule (tms:justification-rule just)))
    (cond ((cp:constraint? rule)
	   (let ((name (cp:constraint-name rule)))
	     (or name
		 (cp:constraint-type-name
		  (cp:constraint-type rule)))))
	  ((cp:connector? rule)
	   (cp:connector-name rule))
	  (else
	   (or rule just)))))