Changeset 4573


Ignore:
Timestamp:
10/29/03 21:23:45 (18 years ago)
Author:
piso
Message:

SLOT-MISSING

File:
1 edited

Legend:

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

    r4572 r4573  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: clos.lisp,v 1.2 2003-10-29 18:54:07 piso Exp $
     4;;; $Id: clos.lisp,v 1.3 2003-10-29 21:23:45 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    376376      (position 'effective-slots the-slots-of-standard-class
    377377                :key #'slot-definition-name)
    378       (let ((slot (find slot-name
    379                         (class-slots class)
     378      (let ((slot (find slot-name (class-slots class)
    380379                        :key #'slot-definition-name)))
    381         (if (null slot)
    382             (error "the slot ~S is missing from the class ~S"
    383                    slot-name class)
    384             (let ((pos (position slot
    385                                  (remove-if-not #'instance-slot-p
    386                                                 (class-slots class)))))
    387               (if (null pos)
    388                   (error "the slot ~S is not an instance slot in the class ~S"
    389                          slot-name class)
    390                   pos))))))
     380        (if slot
     381            (position slot (remove-if-not #'instance-slot-p (class-slots class)))
     382            nil))))
    391383
    392384(defun slot-contents (slots location)
     
    397389
    398390(defun std-slot-value (instance slot-name)
    399   (let* ((location (slot-location (class-of instance) slot-name))
    400          (slots (std-instance-slots instance))
    401          (val (slot-contents slots location)))
    402     (if (eq secret-unbound-value val)
    403         (error "the slot ~S is unbound in the object ~S" slot-name instance)
    404         val)))
     391  (let ((location (slot-location (class-of instance) slot-name)))
     392    (if location
     393        (let* ((slots (std-instance-slots instance))
     394               (val (slot-contents slots location)))
     395          (if (eq secret-unbound-value val)
     396              (error "the slot ~S is unbound in the object ~S" slot-name instance)
     397              val))
     398        (slot-missing (class-of instance) instance slot-name 'slot-value))))
     399
    405400(defun slot-value (object slot-name)
    406401  (if (eq (class-of (class-of object)) the-class-standard-class)
     
    411406  (let ((location (slot-location (class-of instance) slot-name))
    412407        (slots (std-instance-slots instance)))
    413     (setf (slot-contents slots location) new-value)))
     408    (if location
     409        (setf (slot-contents slots location) new-value)
     410        (progn
     411          (slot-missing (class-of instance) instance slot-name 'setf new-value)
     412          new-value))))
    414413(defun (setf slot-value) (new-value object slot-name)
    415414  (if (eq (class-of (class-of object)) the-class-standard-class)
     
    421420  (let ((location (slot-location (class-of instance) slot-name))
    422421        (slots (std-instance-slots instance)))
    423     (not (eq secret-unbound-value (slot-contents slots location)))))
     422    (if location
     423        (not (eq secret-unbound-value (slot-contents slots location)))
     424        (not (null (slot-missing (class-of instance) instance slot-name 'slot-boundp))))))
    424425(defun slot-boundp (object slot-name)
    425426  (if (eq (class-of (class-of object)) the-class-standard-class)
     
    430431  (let ((location (slot-location (class-of instance) slot-name))
    431432        (slots (std-instance-slots instance)))
    432     (setf (slot-contents slots location) secret-unbound-value))
    433   instance)
     433    (if location
     434        (setf (slot-contents slots location) secret-unbound-value)
     435        (slot-missing (class-of instance) instance slot-name 'slot-makunbound))
     436  instance))
    434437(defun slot-makunbound (object slot-name)
    435438  (if (eq (class-of (class-of object)) the-class-standard-class)
     
    13251328  (std-slot-makunbound instance slot-name))
    13261329
     1330(defgeneric slot-missing (class instance slot-name operation &optional new-value))
     1331(defmethod slot-missing ((class t) instance slot-name operation &optional new-value)
     1332  (error "the slot ~S is missing from the class ~S" slot-name class))
     1333
    13271334;;; Instance creation and initialization
    13281335
Note: See TracChangeset for help on using the changeset viewer.