;;; CLIPS functions for checking CPM TED diagrams
;;; Steve Polyak, Dept. of AI, University of Edinburgh
;;; Date: August 3, 1998

;;; Ancestor Rules

(defrule ancestor-of-1
  "A diagram is an ancestor of another if it is the direct parent."
  (has-parent ?card1 ?label1)
  (has-title ?card2 ?label1)
  (has-reference ?card1 ?ref1)
  (has-reference ?card2 ?ref2)
  =>
  (assert (ancestor-of ?ref2 ?ref1)))

(defrule ancestor-of-2
  "A diagram is an ancestor of another if it can be found in the 
   transitive ancestor relationship."
  (has-parent ?card1 ?label1)
  (has-title ?card2 ?label1)
  (has-reference ?card1 ?ref1)
  (has-reference ?card2 ?ref2)
  (ancestor-of ?anc ?ref2)
  =>
  (assert (ancestor-of ?anc ?ref1)))

;;; Action Rules

(defrule valid-action-1
  "An action is valid if it has at least one input."
  (action ?ref ?act)
  (has-input ?ref ?act ?inp)
  ?inv <- (invalid ?ref ?act)
  =>
  (retract ?inv)
  )

(defrule valid-action-2
  "An action is valid if it has at least one output."
  (action ?ref ?act)
  (has-output ?ref ?act ?out)
  ?inv <- (invalid ?ref ?act)
  =>
  (retract ?inv)
  )

;;;  Input Rules

;;; Inputs have 2 properties: validity, and consistency

(defrule consistent-input-1
  "An input is consistent if its source outputs directly to it."
  (input ?ref ?inp)
  (has-source ?ref ?inp ?source)
  (source ?ref ?source)
  (output ?source ?inp)
  (has-destination ?source ?inp ?ref)
  ?inv <- (inconsistent ?ref ?inp)
  =>
  (retract ?inv)
  )

(defrule consistent-input-2
  "An input is consistent if its source outputs directly to an ancestor of it."
  (input ?ref ?inp)
  (has-source ?ref ?inp ?source)
  (source ?ref ?source)
  (output ?source ?inp)
  (ancestor-of ?anc ?ref)
  (has-destination ?source ?inp ?anc)
  ?inv <- (inconsistent ?ref ?inp)
  =>
  (retract ?inv)
  )

(defrule valid-input-1
  "An input is valid if it has a source."
  (input ?ref ?inp)
  (has-source ?ref ?inp ?source)
  (source ?ref ?source)
  ?inv <- (invalid ?ref ?inp)
  =>
  (retract ?inv)
  )
    
;;;  Output Rules

;;; Outputs have 2 properties: validity, and consistency

(defrule consistent-output-1
  "An output is consistent if its destin inputs it from this source."
  (output ?ref ?out)
  (has-destination ?ref ?out ?destin)
  (destination ?ref ?destin)
  (input ?destin ?out)
  (has-source ?destin ?out ?ref)
  ?inv <- (inconsistent ?ref ?out)
  =>
  (retract ?inv)
  )

(defrule consistent-output-2
  "An output is consistent if its destin inputs it from an ancest. of source"
  (output ?ref ?out)
  (has-destination ?ref ?out ?destin)
  (destination ?ref ?destin)
  (input ?destin ?out)
  (ancestor-of ?anc ?ref)
  (has-source ?destin ?out ?anc)
  ?inv <- (inconsistent ?ref ?out)
  =>
  (retract ?inv)
  )

(defrule consistent-output-3
  "An output is consistent if its destin inputs it from an ancest. of source.
   Special case when destin and ancestor are same."
  (output ?ref ?out)
  (has-destination ?ref ?out ?destin)
  (destination ?ref ?destin)
  (input ?destin ?out)
  (ancestor-of ?destin ?ref)
  (has-source ?destin ?out ?destin)
  ?inv <- (inconsistent ?ref ?out)
  =>
  (retract ?inv)
  )

(defrule valid-output-1
  "An output is valid if it has a destination."
  (output ?ref ?out)
  (has-destination ?ref ?out ?destination)
  (destination ?ref ?destination)
  ?inv <- (invalid ?ref ?out)
  =>
  (retract ?inv)
  )
    
;;;  Source Rules

(defrule valid-source-1
  "An source is valid if it contributes an input."
  (source ?ref ?src)
  (has-source ?ref ?inp ?src)
  (input ?ref ?inp)
  ?inv <- (invalid ?ref ?src)
  =>
  (retract ?inv)
  )
    
;;;  Destination Rules

(defrule valid-destination-1
  "A destination is valid if it receives an output."
  (destination ?ref ?dest)
  (has-destination ?ref ?out ?dest)
  (output ?ref ?out)
  ?inv <- (invalid ?ref ?dest)
  =>
  (retract ?inv)
  )
    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Report phase rules

;;; action reporting

(defrule invalid-action
  "If an action is still invalid, then notify"
  (phase report)
  (action ?ref ?act)
  (invalid ?ref ?act)
  =>
  (bind ?*error-count* (+ ?*error-count* 1))
  (printout t ?*error-count* 
	    ". Action " ?act " on " ?ref
	    " requires an input or output." crlf)
  )

;;; Destination reporting

(defrule invalid-destination
  "If a destination is still invalid, then notify"
  (phase report)
  (destination ?ref ?dest)
  (invalid ?ref ?dest)
  =>
  (bind ?*error-count* (+ ?*error-count* 1))
  (printout t ?*error-count* 
	    ". Destination " ?dest
	    " on " ?ref 
	    " receives no output." crlf)
  )

;;; Source Reporting

(defrule invalid-source
  "If a source is still invalid, then notify"
  (phase report)
  (source ?ref ?src)
  (invalid ?ref ?src)
  =>
  (bind ?*error-count* (+ ?*error-count* 1))
  (printout t ?*error-count* 
	    ". Source " ?src
	    " on " ?ref 
	    " contributes no input." crlf)
  )

;;; Input reporting

(defrule inconsistent-input
  "If an input is still inconsistent, then notify"
  (phase report)
  (input ?ref ?inp)
  (inconsistent ?ref ?inp)
  ;;(has-source ?ref ?inp ?source)
  ;;(source ?ref ?source)
  =>
  (bind ?*error-count* (+ ?*error-count* 1))
  (printout t ?*error-count* 
	    ". Input " ?inp
	    " on " ?ref
	    " does not connect to a valid output." crlf)
  )

(defrule invalid-input
  "If an input is still invalid, then notify"
  (phase report)
  (input ?ref ?inp)
  (invalid ?ref ?inp)
  =>
  (bind ?*error-count* (+ ?*error-count* 1))
  (printout t ?*error-count* 
	    ". Input " ?inp 
	    " on " ?ref
	    " requires a valid source." crlf)
  )

;;; output reporting

(defrule invalid-output
  "If an output is still invalid, then notify"
  (phase report)
  (output ?ref ?out)
  (invalid ?ref ?out)
  =>
  (bind ?*error-count* (+ ?*error-count* 1))
  (printout t ?*error-count* 
	    ". Output " ?out
	    " on " ?ref
	    " requires a valid destination." crlf)
  )

(defrule inconsistent-output
  "If an output is still inconsistent, then notify"
  (phase report)
  (output ?ref ?out)
  (inconsistent ?ref ?out)
  =>
  (bind ?*error-count* (+ ?*error-count* 1))
  (printout t ?*error-count* 
	    ". Output " ?out
	    " on " ?ref
	    " does not connect to a valid input." crlf)
  )
