/[gcl]/gcl/pcl/gcl_pcl_defs.lisp
ViewVC logotype

Diff of /gcl/pcl/gcl_pcl_defs.lisp

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

revision 1.3 by camm, Fri Jun 10 15:37:57 2005 UTC revision 1.4 by camm, Sat Jul 23 08:55:50 2005 UTC
# Line 71  Line 71 
71  (defmacro parse-gspec (spec  (defmacro parse-gspec (spec
72                         (non-setf-var . non-setf-case)                         (non-setf-var . non-setf-case)
73                         (setf-var . setf-case))                         (setf-var . setf-case))
74    (declare (indentation 1 1))  ;  (declare (indentation 1 1))
75    #+setf (declare (ignore setf-var setf-case))    #+setf (declare (ignore setf-var setf-case))
76    (once-only (spec)    (once-only (spec)
77      `(cond (#-setf (symbolp ,spec) #+setf t      `(cond (#-setf (symbolp ,spec) #+setf t
# Line 370  Line 370 
370             type))))             type))))
371    
372  ;;; not used...  ;;; not used...
373  #+nil  ;#+nil
374  (defun *typep (object type)  (defun *typep (object type)
375    (setq type (*normalize-type type))    (setq type (*normalize-type type))
376    (cond ((member (car type) '(eql wrapper-eq class-eq class))    (cond ((member (car type) '(eql wrapper-eq class-eq class))
# Line 434  Line 434 
434    ;; better.  Note that for most ports, providing this definition    ;; better.  Note that for most ports, providing this definition
435    ;; should just speed up class definition.  It shouldn't have an    ;; should just speed up class definition.  It shouldn't have an
436    ;; effect on performance of most user code.    ;; effect on performance of most user code.
437    (eval `(deftype ,name () '(satisfies ,predicate))))    (progn ;(break "foo ~a ~a~%" name predicate)
438      (eval `(deftype ,name () '(satisfies ,predicate)))))
439    
440  (defun make-type-predicate-name (name &optional kind)  (defun make-type-predicate-name (name &optional kind)
441    (if (symbol-package name)    (if (symbol-package name)
# Line 624  Line 625 
625    (defclass kernel:funcallable-instance (function) ()    (defclass kernel:funcallable-instance (function) ()
626      (:metaclass built-in-class)))      (:metaclass built-in-class)))
627    
628    ;(defclass function (t) ()
629    ;  (:metaclass built-in-class))
630    
631    ;(defclass stream (si::instance) ()
632    ;  (:metaclass built-in-class))
633    
634    
635  (defclass slot-object (#-cmu17 t #+cmu17 kernel:instance) ()  (defclass slot-object (#-cmu17 t #+cmu17 kernel:instance) ()
636    (:metaclass slot-class))    (:metaclass slot-class))
637    
638  (defclass structure-object (slot-object) ()  ;(defclass si::instance (slot-object) ())
639    
640    ;(defclass si::funcallable-instance (slot-object) ())
641    
642    (defclass structure-object (slot-object ;si::instance
643                                ) ()
644    (:metaclass structure-class))    (:metaclass structure-class))
645    
646  (defstruct (#-cmu17 structure-object #+cmu17 dead-beef-structure-object  (defstruct (#-cmu17 structure-object #+cmu17 dead-beef-structure-object
# Line 638  Line 651 
651    
652  (defclass metaobject (standard-object) ())  (defclass metaobject (standard-object) ())
653    
654  (defclass specializer (metaobject)  (defclass funcallable-standard-object (standard-object)
655    ;                                      si::funcallable-instance)
656      ()
657      (:metaclass funcallable-standard-class))
658    
659    (defclass specializer (metaobject); si::instance)
660       ((type       ((type
661          :initform nil          :initform nil
662          :reader specializer-type)))          :reader specializer-type)))
# Line 666  Line 684 
684  ;;; have the class CLASS in its class precedence list.  ;;; have the class CLASS in its class precedence list.
685  ;;;  ;;;
686  (defclass class (documentation-mixin dependent-update-mixin definition-source-mixin  (defclass class (documentation-mixin dependent-update-mixin definition-source-mixin
687                   specializer)                   specializer );si::instance)
688       ((name       ((name
689          :initform nil          :initform nil
690          :initarg  :name          :initarg  :name
# Line 771  Line 789 
789  ;;;  ;;;
790  ;;; Slot definitions.  ;;; Slot definitions.
791  ;;;  ;;;
792  (defclass slot-definition (metaobject)  (defclass slot-definition (metaobject );si::instance)
793       ((name       ((name
794          :initform nil          :initform nil
795          :initarg :name          :initarg :name
# Line 859  Line 877 
877                                                 effective-slot-definition)                                                 effective-slot-definition)
878    ())    ())
879    
880  (defclass method (metaobject) ())  (defclass method (metaobject );si::instance)
881      ())
882    
883  (defclass standard-method (definition-source-mixin plist-mixin method)  (defclass standard-method (definition-source-mixin plist-mixin method)
884       ((generic-function       ((generic-function
# Line 908  Line 927 
927                              definition-source-mixin                              definition-source-mixin
928                              documentation-mixin                              documentation-mixin
929                              metaobject                              metaobject
930                              #+cmu17 kernel:funcallable-instance)                              funcallable-standard-object)
931       ()       ()
932    (:metaclass funcallable-standard-class))    (:metaclass funcallable-standard-class))
933            
# Line 940  Line 959 
959    (:default-initargs :method-class *the-class-standard-method*    (:default-initargs :method-class *the-class-standard-method*
960                       :method-combination *standard-method-combination*))                       :method-combination *standard-method-combination*))
961    
962  (defclass method-combination (metaobject) ())  (defclass method-combination (metaobject); si::instance)
963      ())
964    
965  (defclass standard-method-combination  (defclass standard-method-combination
966            (definition-source-mixin method-combination)            (definition-source-mixin method-combination)
# Line 981  Line 1001 
1001      (method-combination method-combination-p)      (method-combination method-combination-p)
1002      (long-method-combination long-method-combination-p)))      (long-method-combination long-method-combination-p)))
1003    
1004    
1005    (defun early-find-class-symbol (x &optional errorp environment)
1006      (declare (ignore errorp environment))
1007      (when (or (member x *early-class-definitions* :key 'cadr)
1008                (gethash x *find-class*))
1009        x))
1010    
1011    (defun mk-early-cpl (sym)
1012      (let ((l (nth 4 (car (member sym *early-class-definitions* :key 'cadr)))))
1013        (append l (reduce (lambda (&rest r) (when r (apply 'union r))) (mapcar 'mk-early-cpl l)))))
1014    
1015    (defun early-class-precedence-list-symbol (x &aux tem)
1016      (cond ((mk-early-cpl x))
1017            ((setq tem (gethash x *find-class*))
1018             (early-class-precedence-list (car tem)))))
1019    
1020    (setf (symbol-function 'si::find-class) (symbol-function 'early-find-class-symbol))
1021    (setf (symbol-function 'si::class-precedence-list) (symbol-function 'early-class-precedence-list-symbol))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26