/[cmucl]/src/pcl/defs.lisp
ViewVC logotype

Diff of /src/pcl/defs.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by pmai, Tue Aug 27 19:01:38 2002 UTC revision 1.25 by pmai, Mon Sep 9 16:08:58 2002 UTC
# Line 197  Line 197 
197      (setf (lisp:find-class name)      (setf (lisp:find-class name)
198            (lisp::make-standard-class :name name))))            (lisp::make-standard-class :name name))))
199    
 (defun make-class-eq-predicate (class)  
   (when (symbolp class) (setq class (find-class class)))  
   (lambda (object) (eq class (class-of object))))  
   
 (defun make-eql-predicate (eql-object)  
   (lambda (object) (eql eql-object object)))  
   
   
200  ;;; Internal to this file.  ;;; Internal to this file.
201  ;;;  ;;;
202  ;;; These functions are a pale imitiation of their namesake.  They accept  ;;; These functions are a pale imitiation of their namesake.  They accept
# Line 300  Line 292 
292  (pushnew 'class *variable-declarations*)  (pushnew 'class *variable-declarations*)
293  (pushnew 'variable-rebinding *variable-declarations*)  (pushnew 'variable-rebinding *variable-declarations*)
294    
 (defun variable-class (var env)  
   (caddr (variable-declaration 'class var env)))  
   
295  (defvar *name->class->slotd-table* (make-hash-table))  (defvar *name->class->slotd-table* (make-hash-table))
296    
   
 ;;;  
 ;;; This is used by combined methods to communicate the next methods to  
 ;;; the methods they call.  This variable is captured by a lexical variable  
 ;;; of the methods to give it the proper lexical scope.  
 ;;;  
 (defvar *next-methods* nil)  
   
 (defvar *not-an-eql-specializer* '(not-an-eql-specializer))  
   
 (defvar *umi-gfs*)  
 (defvar *umi-complete-classes*)  
 (defvar *umi-reorder*)  
   
 (defvar *invalidate-discriminating-function-force-p* ())  
 (defvar *invalid-dfuns-on-stack* ())  
   
   
297  (defvar *standard-method-combination*)  (defvar *standard-method-combination*)
298    
 (defvar *slotd-unsupplied* (list '*slotd-unsupplied*))  ;***  
299    
300    
 (defmacro define-gf-predicate (predicate-name &rest classes)  
   `(progn  
      (defmethod ,predicate-name ((x t)) nil)  
      ,@(mapcar (lambda (c) `(defmethod ,predicate-name ((x ,c)) t))  
                classes)))  
   
301  (defun make-class-predicate-name (name)  (defun make-class-predicate-name (name)
302    (intern (format nil "~A::~A class predicate"    (intern (format nil "~A::~A class predicate"
303                    (package-name (symbol-package name))                    (package-name (symbol-package name))

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25

  ViewVC Help
Powered by ViewVC 1.1.5