;;; Date: Thu,  7 Oct 1993 12:45:38 -0400 (EDT)
;;; From: Daniel D Suthers

;;; Here's a hands-on tutorial on shared Loom/Clos instances ...

;;;=============================================================================
;;; This shows how we can mix CLOS and LOOM and have
;;; 1. roles used only by LOOM
;;; 2. roles/slots shared between LOOM and CLOS
;;; 3. slots used only by CLOS
;;; Example by Dan Suthers
;;;============================================================================
;;; EVALATE THESE FORMS AT THE BEGINNING OF EACH SESSION
;;;============================================================================

(unless (find-package "TEST") (make-package "TEST"))
(in-package "TEST")
(loom:use-loom "TEST")
(loom:defkb "TEST-KB" nil :path-name "test.kb")
(change-kb "TEST-KB")

(defclass TEST-MIXIN ()
  ;;
  ;; We will use CLOS mixins for anything that cannot be saved out to
  ;; a KB and read back in -- e.g., CLIM output records and streams.
  ;;
  ((record :initarg :record
	   :accessor record
	   :initform nil)
   (stream :initarg :stream
	   :accessor stream
	   :initform nil)))

(loom:defconcept TEST-CONCEPT
    ;;
    ;; CLOS slots will be made for all required roles.
    ;;
    :is (:and (:at-least 1 loom-role-1)
	      (:at-least 1 loom-role-2))
    :characteristics :clos-class
    ;;
    ;; Instance-with-everything gives the CLOS instance as much
    ;; LOOM functionality as possible. Test-mixin gives us
    ;; the above-defined CLOS-only slots.
    ;;
    :mixin-classes (loom:instance-with-everything test-mixin))

(loom:defconcept TEST-SUBCONCEPT
    :is (:and test-concept
	      (:at-least 1 subconcept-role))
    ;;
    ;; Note that these declarations must be repeated for the subclass.
    ;; When they were left off, TEST-CONCEPT "inherited" the subconcept-role
    ;; CLOS slot from its subclass!!! (because the two concepts were
    ;; represented as one class in CLOS?)
    ;; 
    :characteristics :clos-class
    :mixin-classes (loom:instance-with-everything test-mixin))

(loom:defrelation loom-role-1) ; define the above shared roles
(loom:defrelation loom-role-2)
(loom:defrelation loom-role-3) ; used below as Loom-only role.
(loom:defrelation subconcept-role)

;;; Note that the CLOS class is not defined until the first call
;;; to MAKE-OBJECT! Definitions loaded from KB files won't work until 
;;; then. [There may be another way around this -- ask ISI -- Dan.]
(loom:make-object 'test-concept)

;;;=============================================================================
;;;  EVALATE THESE FORMS IN FIRST SESSION ONLY
;;;=============================================================================
;;; We must give it an identifier so references to it can be saved to a LOOM KB.
;;; But for convenience we'll bind the instance to a variable for the duration
;;; of this example.

(setq test-instance (loom:make-object 'test-concept    :identifier 'test-instance))
(setq sub-instance  (loom:make-object 'test-subconcept :identifier 'sub-instance))

(loom:tellm (loom-role-1 test-instance role-filler-1)  ; these two will show up 
	    (loom-role-2 test-instance role-filler-2)  ;   as CLOS slots, while
            (loom-role-3 test-instance role-filler-3)) ; this will only be in LOOM

(loom:tellm (subconcept-role sub-instance sub-role-filler))

;;; to see what LOOM and CLOS knows ...
(loom:pi test-instance)
#+:XLT (xlt:wi test-instance)
#-:XLT (inspect test-instance)

(loom:pi sub-instance)
#+:XLT (xlt:wi sub-instance)
#-:XLT (inspect sub-instance)

;;; LOOM can of course access its own fillers, regardless
;;; of whether or not they are CLOS slots too.
(loom:get-value test-instance 'loom-role-1)
(loom:get-value test-instance 'loom-role-3)

;;; CLOS can access the fillers of required LOOM roles ...
(loom-role-1 test-instance)

;;; CLOS can also access the instance found via LOOM's instance identifier. 
(loom-role-2 (loom:find-instance 'test-instance))

;;; But CLOS cannot access pure LOOM roles ...
;;; (loom-role-3 test-instance) ; --> error

;;; CLOS can accesses its own slots
(stream test-instance)
(setf (stream test-instance) *standard-output*)
(stream test-instance)

;;; But LOOM cannot access pure CLOS slots ...
;;; (loom:get-value test-instance 'stream) ; --> error

;;; CLOS slots do not show up in the Loom representation, so it
;;; is safe to save to a KB. (Look at the resulting file.)
(loom:pi test-instance)
(loom:save-kb "TEST-KB" :path-name "test.kb" :partitions ':instances)

;;; Now leave Lisp, re-enter it, and run this example again but using the
;;; following forms instead of those you just did.

;;;============================================================================
;;;  EVALATE THESE FORMS IN SECOND SESSION ONLY
;;;============================================================================
;;; At this point if you have already been through this example once you could
;;; load the test.kb to check that loading works.

(loom:load-kb "TEST-KB" :path-name "test.kb")

;;; to see what LOOM and CLOS knows ...
(loom:pi test-instance)
#+:XLT (xlt:wi (loom:find-instance 'test-instance))
#-:XLT (inspect (loom:find-instance 'test-instance))

;;; Checking that each can access the roles/slots they are supposed to ...
;;; Loom accessing shared slot
(loom:get-value (loom:find-instance 'test-instance) 'loom-role-1)

;;; Loom accessing Loom-only slot.
(loom:get-value (loom:find-instance 'test-instance) 'loom-role-3)

;;; CLOS accessing and changing shared slot, result being visible in Loom.
(loom-role-1 (loom:find-instance 'test-instance))
(setf (loom-role-1 (loom:find-instance 'test-instance)) 'new-role-filler-1)
(loom:get-value (loom:find-instance 'test-instance) 'loom-role-1)

;;; CLOS accessing CLOS-only slot.
(stream (loom:find-instance 'test-instance))
(setf (stream (loom:find-instance 'test-instance)) *standard-output*)
(stream (loom:find-instance 'test-instance))

;;;============================================================================
;;; The end.
;;; --------------------------------------------------
;;; Dan Suthers           | LRDC, room 505A
;;;                       | 3939 O'Hara Street
;;;                       | University of Pittsburgh
;;;                       | Pittsburgh, PA 15260
;;; --------------------------------------------------