;;; -*- Mode: LISP; Syntax: Common-lisp; Package: LOOM; 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.                                          ;
;                                                                             ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; PENULTIMATE.LISP (ABOX)

(in-package "LOOM")

  ;;
;;;;;; "defmethod"
  ;;

;;; Note: To redefine "defmethod" safely, it and "ensure-shadow-classes"
;;;    must be placed within an "eval-when" or at the end of a file.

;;; "defmethod" macro which calls either "CLOS:defmethod" or
;;;    "LOOM::def-loom-method".  In the former case, it checks to
;;;    see if it can ensure the existence of a CLOS class for each
;;;    typed argument.

(eval-when (load eval compile)
  (defun ensure-shadow-classes (methodArguments)
    ;; Helping function for "defmethod";
    ;; Ensure that any shadowing CLOS classes referenced in
    ;;    "methodArguments" have been created;
    ;; If we can't detect the presence of a LOOM network, this is a no-op;
    (unless (null (eval-concept-id 'META-THING BUILT-IN-THEORY))
      (loop for arg in methodArguments
	   when (consp arg)
	   do (find-or-create-clos-class (second arg)))) ))

(defmacro defmethod (name &rest definition)
  #+(or :lcl3.0 (and (not :lucid) (not :xerox)))
  (declare (arglist name &optional qualifiers (&rest arguments) 
		    &key situation response))
  (let ((unqualifiedDefinition definition)
	arguments body)
    (loop
      (if (atom (first unqualifiedDefinition))
	  (setq unqualifiedDefinition (rest unqualifiedDefinition))
	  (return nil))) ;; exit loop when there are no more qualifiers
    (setq arguments (first unqualifiedDefinition))
    (setq body (rest unqualifiedDefinition))
    (if (or (member :situation body)
	    (member :response body)
	    (member :action body))		; OBSOLETE SYNTAX
	`(LOOM::def-loom-method ,name ,arguments ,@body)
	(progn
	  (ensure-shadow-classes arguments)
	  `(progn
             (eval-when (load)
              (LOOM::ensure-shadow-classes ',arguments)) 
             (CLOS::defmethod ,name ,@definition)))) ))
