;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;     File:  model-k.lisp
;
;   Author:  Jim Davies jimmydavies@usa.net
;
;  Version:  SIRRINE2 Beta 0.5, 12/12/98

(in-package despina)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; KNOWLEDGE REPRESENTATIONS ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; INTEGER DOMAIN CONCEPT

(defdomain-concept integer-domain-concept
  :equal-relation (defdomain-relation integer-equal
                    :input (integer-domain-concept
                            integer-domain-concept)
                    :primitive (deflisp-primitive :procedure
                                 integer-equal-proc)))
(define-predicate-procedure integer-equal-proc equal)

;; MATH-OPERATOR DOMAIN CONCEPT

(defdomain-concept math-operator-domain-concept
  :equal-relation (defdomain-relation integer-equal
                    :input (math-operator-domain-concept
                            math-operator-domain-concept)
                    :primitive (deflisp-primitive :procedure
                                 math-operator-equal-proc)))
(define-predicate-procedure math-operator-equal-proc equal)

(defconcept-instance plus-concept-instance
  :domain-concept math-operator-domain-concept
  :symbol plus-value)
(setf plus-value 'plus)

(defconcept-instance minus-concept-instance
  :domain-concept math-operator-domain-concept
  :symbol minus-value)
(setf minus-value 'minus)

;; MATH-FACT DOMAIN CONCEPT

(defdomain-concept math-fact-domain-concept
  :selection-relations (math-fact-arg1
                        math-fact-operator
                        math-fact-arg2
                        math-fact-answer)
  :equal-relation (defdomain-relation math-fact-equal
                    :input (math-fact-domain-concept
                            math-fact-domain-concept)
                    :primitive (deflisp-primitive :procedure
                                 math-fact-equal-proc)))
(define-predicate-procedure math-fact-equal-proc equal)

;; MATH-FACT DOMAIN RELATIONS AND ASSOCIATED PRIMITIVES

(defvalue-domain-relation math-fact-arg1
  :input (math-fact-domain-concept)
  :output (integer-domain-concept)
  :primitive (deflisp-primitive :procedure retrieve-math-fact-arg1))

(defun retrieve-math-fact-arg1 (math-fact-value)
  ;; inputs a math fact value and returns the first argument of 
  ;; the math fact. 
  (first math-fact-value))

(defvalue-domain-relation math-fact-arg2
  :input (math-fact-domain-concept)
  :output (integer-domain-concept)
  :primitive (deflisp-primitive :procedure retrieve-math-fact-arg2))

(defun retrieve-math-fact-arg2 (math-fact-value)
  ;; inputs a math fact value and returns the second argument of 
  ;; the math fact. 
  (third math-fact-value))

(defvalue-domain-relation math-fact-operator
  :input (math-fact-domain-concept)
  :output (integer-domain-concept)
  :primitive (deflisp-primitive :procedure retrieve-math-fact-operator))

(defun retrieve-math-fact-operator (math-fact-value)
  ;; inputs a math fact value and returns the operator of 
  ;; the math fact. 
  (second math-fact-value))

(defvalue-domain-relation math-fact-answer
  :input (math-fact-domain-concept)
  :output (integer-domain-concept)
  :primitive (deflisp-primitive :procedure retrieve-math-fact-answer))

(defun retrieve-math-fact-answer (math-fact-value)
  ;; inputs a math fact value and returns the answer of 
  ;; the math fact. 
  (fourth math-fact-value))


;;;;;;;;;;;;;;;;;;;;;;;
;; FIND NEXT INTEGER ;;
;;;;;;;;;;;;;;;;;;;;;;;

(defdomain-concept find-next-integer-domain-concept
  :equal-relation (defdomain-relation find-next-integer-equal
		    :input (find-next-integer-domain-concept 
			    find-next-integer-domain-concept)
		    :primitive (deflisp-primitive :procedure 
				 find-next-integer-equal-proc)))

(define-predicate-procedure find-next-integer-equal-proc equal)