Ignore:
Timestamp:
10/11/03 17:35:48 (19 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/defclass.lisp

    r4309 r4310  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defclass.lisp,v 1.8 2003-10-11 17:31:00 piso Exp $
     4;;; $Id: defclass.lisp,v 1.9 2003-10-11 17:35:48 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    10971097          (append lambda-list '(&key &allow-other-keys))
    10981098          lambda-list)))
     1099
     1100;;; Slot access
     1101
     1102(defgeneric slot-value-using-class (class instance slot-name))
     1103(defmethod slot-value-using-class
     1104  ((class standard-class) instance slot-name)
     1105  (std-slot-value instance slot-name))
     1106
     1107(defgeneric (setf slot-value-using-class) (new-value class instance slot-name))
     1108(defmethod (setf slot-value-using-class)
     1109  (new-value (class standard-class) instance slot-name)
     1110  (setf (std-slot-value instance slot-name) new-value))
     1111;;; N.B. To avoid making a forward reference to a (setf xxx) generic function:
     1112(defun setf-slot-value-using-class (new-value class object slot-name)
     1113  (setf (slot-value-using-class class object slot-name) new-value))
     1114
     1115(defgeneric slot-exists-p-using-class (class instance slot-name))
     1116(defmethod slot-exists-p-using-class
     1117  ((class standard-class) instance slot-name)
     1118  (std-slot-exists-p instance slot-name))
     1119
     1120(defgeneric slot-boundp-using-class (class instance slot-name))
     1121(defmethod slot-boundp-using-class
     1122  ((class standard-class) instance slot-name)
     1123  (std-slot-boundp instance slot-name))
     1124
     1125(defgeneric slot-makunbound-using-class (class instance slot-name))
     1126(defmethod slot-makunbound-using-class
     1127  ((class standard-class) instance slot-name)
     1128  (std-slot-makunbound instance slot-name))
     1129
     1130;;; Instance creation and initialization
     1131
     1132;; (defgeneric allocate-instance (class))
     1133;; (defmethod allocate-instance ((class standard-class))
     1134;;   (std-allocate-instance class))
     1135
     1136(defgeneric make-instance (class &key))
     1137(defmethod make-instance ((class standard-class) &rest initargs)
     1138  (let ((instance (allocate-instance class)))
     1139    (apply #'initialize-instance instance initargs)
     1140    instance))
     1141(defmethod make-instance ((class symbol) &rest initargs)
     1142  (apply #'make-instance (find-class class) initargs))
     1143
     1144(defgeneric initialize-instance (instance &key))
     1145(defmethod initialize-instance ((instance standard-object) &rest initargs)
     1146  (apply #'shared-initialize instance t initargs))
     1147
     1148(defgeneric reinitialize-instance (instance &key))
     1149(defmethod reinitialize-instance
     1150  ((instance standard-object) &rest initargs)
     1151  (apply #'shared-initialize instance () initargs))
     1152
     1153(defgeneric shared-initialize (instance slot-names &key))
     1154(defmethod shared-initialize ((instance standard-object)
     1155                              slot-names &rest all-keys)
     1156  (dolist (slot (class-slots (class-of instance)))
     1157    (let ((slot-name (slot-definition-name slot)))
     1158      (multiple-value-bind (init-key init-value foundp)
     1159        (get-properties
     1160         all-keys (slot-definition-initargs slot))
     1161        (declare (ignore init-key))
     1162        (if foundp
     1163            (setf (slot-value instance slot-name) init-value)
     1164            (when (and (not (slot-boundp instance slot-name))
     1165                       (not (null (slot-definition-initfunction slot)))
     1166                       (or (eq slot-names t)
     1167                           (member slot-name slot-names)))
     1168              (setf (slot-value instance slot-name)
     1169                    (funcall (slot-definition-initfunction slot))))))))
     1170  instance)
Note: See TracChangeset for help on using the changeset viewer.