(in-package "KPML")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;COPYRIGHT (C) UNIVERSITY OF SOUTHERN CALIFORNIA, 1987                        ;
;University Of Southern California, Information Sciences Institute            ;
;4676 Admiralty Way                                                           ;
;Marina Del Rey, California 90292                                             ;
;                                                                             ;
;This software was developed under the terms and conditions of Contract       ;
;No. MDA903 81 C 0335 between the Defense Advanced Research Projects          ;
;Agency and the University of Southern California, Information Sciences       ;
;Institute. Use and distribution of this software is further subject to       ;
;the provisions of that contract and any other agreements developed           ;
;between the user of the software and the University of Southern              ;
;California, Information Sciences Institute.                                  ;
;This software is within the scope of the "AGREEMENT FOR SOFTWARE             ;
;EXCHANGE" between BBN Laboratories Incorporated and the University           ;
;of Southern California, dated February 18, 1986.  It is supplied             ;
;"AS IS," without any warranties of any kind.  It is furnished only           ;
;on the basis that any party who receives it indemnifies and holds            ;
;harmless the parties who furnish and originate it against any                ;
;claims, demands or liabilities connected with using it, furnishing           ;
;it to others or providing it to a third party.  THIS NOTICE MUST             ;
;NOT BE REMOVED FROM THE SOFTWARE, AND IN THE EVENT THAT THE                  ;
;SOFTWARE IS DIVIDED, IT SHOULD BE ATTACHED TO EVERY PART.                    ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; ======================================================================
;;; John:IPSI:Feb95; unclear how many of the following are used
;;; at all, or even work....
;;;
;;;
;;; KPML4 note (Jan03)...
;;;  None of these definitions are used by KPML. This file is therefore
;;;  removed from the KPML-LOOM system definition (selected-kpml-kr.lisp)
;;;  but preserved here "just in case"
;;; ======================================================================

(defun upper-model-sub-concepts (um-concept)
  ;;;Returns a list of penman-interned symbols as names of subcs of UM-CONCEPT.
  (let (sub-concept-symbols)
    (dolist (subc (loom::sub-concepts 
		    (loom::find-concept 
		      (intern (symbol-name um-concept) "PENMAN-KB"))))
      (when (upper-model-node-p subc)
	(push (intern (symbol-name (loom::name subc)) (find-package 'penman))
	      sub-concept-symbols)))
    sub-concept-symbols))

(defun upper-model-super-concepts (um-concept)
  "Returns a list of penman-interned symbols as names of supercs of
   UM-CONCEPT."
  (let (super-concept-symbols)
    (dolist (superc (loom::super-concepts 
		    (loom::find-concept 
		      (intern (symbol-name um-concept) "PENMAN-KB"))))
      (when (upper-model-node-p superc)
	(push (intern (symbol-name (loom::name superc)) (find-package 'penman))
	      super-concept-symbols)))
    super-concept-symbols))

(defun upper-model-node-p (concept)
  "Nil only if concept is not in the upper model."
  (eq (loom::find-kb "PENMAN-KB") (loom::knowledge-base (loom::find-concept concept))))

(defun make-domain-kb (kb-name kb-package-name)
  
  ;;;  Define a KB, and relate it and its package to Penman & Penman-KB.
  ;;;  N.B.  The domain KB will use the Penman-KB, but the domain package
  ;;;  will not use the Penman-KB package.
  
  (unless (find-package kb-package-name) (make-package kb-package-name))
  (use-package '(lisp) kb-package-name)
  (shadow kb-name 'loom)
  (shadowing-import kb-name kb-package-name)
  (shadowing-import 
    '(loom::defmethod loom::find-method loom::pi loom::trace loom::untrace 
		      penman-kb::domain penman-kb::range ;penman-kb::set
		      ) 
    kb-package-name)
  
  (use-package '(loom) kb-package-name)
  
  (unless (loom::find-kb kb-name)
    (Loom::def-knowledge-base kb-name '("PENMAN-KB")
			      `(:package ,kb-package-name))))