;;; -*- Mode: LISP; Syntax: Common-lisp; Package: KBCLASSES; Base: 10. -*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;                                                                             ;
;  Copyright (c) 1988, 1995, 1999 by the University of Southern California    ;
;  All rights reserved.                                                       ;
;                                                                             ;
;  Permission to use, copy, modify, and distribute this software and its      ;
;  documentation in source and binary forms for non-commercial purposes       ;
;  and without fee is hereby granted, provided that this notice               ;
;  be reproduced in any copy or modification thereof, and that                ;
;  any documentation, advertising materials, and other materials related      ;
;  to such distribution and use acknowledge that the software was             ;
;  developed by the University of Southern California, Information            ;
;  Sciences Institute.  The name of the University may not be used to         ;
;  endorse or promote products derived from this software without             ;
;  specific prior written permission.                                         ;
;                                                                             ;
;  THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT THE   ;
;  SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE.  THIS SOFTWARE IS PROVIDED   ;
;  "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,          ;
;  WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND          ;
;  FITNESS FOR A PARTICULAR PURPOSE.                                          ;
;                                                                             ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
				    
;;; BRAIDEFS.LISP (KBCLASSES)

;;; This file contains the class definitions which define the kernel
;;;    for the KB-CLASSES system.


(in-package "KBCLASSES")

;(export '())


;;; This code defines the two classes that constitute the meta
;;;    objects for the KB-CLASSES system.


  ;;
;;;;;; KB-CLASS
  ;;

(def-class KB-CLASS ()
  ( name
   definition
   super-classes
   sub-classes
   precedence-list-cache
   local-slots
   slots
   is-defined-p
   is-finalized-p))

(defmethod CLOS-class ((self KB-CLASS))
  ;; Defines the slot-accessor "CLOS-class"
  (CLOS::find-class (name self)) )

;(defun instance-slot-names-of-class (kbClass)
;  ;; Return a list of instance-slot names
;  (let ((closClass (CLOS-class kbClass)))
;    (get-slot-names closClass) ))

;(defun instance-slots-of-class (kbClass)
;  ;; Return a list of instance slots
;  (loop for slotName in (instance-slot-names-of-class kbClass)
;       collect (find-slot kbClass slotName)) )

(defmethod print-object ((self KB-CLASS) stream)
  (format stream "#<KB-CLASS: ~S>" (name self)) )

(defmethod is-finalized-p (nonConcept)
  (error "The object ~S is not of type KB-CLASS" nonConcept) )

(defmethod (setf precedence-list) (newValue (self KB-CLASS))
  ;; Defines the slot-accessor "precedence-list"
  (setf (CLOS::slot-value self 'precedence-list-cache) newValue) )

(defmethod precedence-list ((self KB-CLASS))
  ;; Defines the slot-accessor "precedence-list"
  (or (CLOS::slot-value self 'precedence-list-cache)
      (setf (precedence-list self)
	    (compute-precedence-list self))) )

(defun compute-precedence-list (class)
  ;; Compute a breadth-first left-to-right list of "class" and its
  ;;    super-classes;  Assumes that the superClass class precedence
  ;;    lists have already been computed.
  (let ((classList (append (list class) (copy-list (super-classes class))))) 
    (loop for superClass in (super-classes class) do
	 (setq classList (right-union classList (precedence-list superClass))))
    classList ))

(defun right-union (list1 list2)
  ;; Return the union of "list1" and "list2", with left-most duplicates
  ;;    removed.  The operation destroys "list1", but leaves "list2" intact.
  (let ((result (copy-list list2)))
    (loop for item in (nreverse list1) when (not (member item list2)) do
	 (push item result))
    result ))


  ;;
;;;;;; KB-SLOT
  ;;

(def-class KB-SLOT ()
  ( name
   domain
   range
   initform
   allocation
   accessors
   collection-p
   inverse-slot
   one-way-inverse
   aliases
   aliasing-slots
   do-not-reinitialize
   invisible-p
   context-sensitive-p))

(defmethod print-object ((self KB-SLOT) stream)
  (format stream "~S.~S" (name (domain self)) (name self)) )

