Changeset 5036


Ignore:
Timestamp:
12/09/03 20:02:31 (17 years ago)
Author:
piso
Message:

DEFCLASS: support :DEFAULT-INITARGS option.

File:
1 edited

Legend:

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

    r5032 r5036  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: clos.lisp,v 1.18 2003-12-09 02:48:27 piso Exp $
     4;;; $Id: clos.lisp,v 1.19 2003-12-09 20:02:31 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    147147                (mapplist
    148148                 #'(lambda (key value)
    149                     `(',key ,value))
     149                    `(',key ,(make-initfunction value)))
    150150                 (cdr option))))))
    151     (t (list `',(car option) `',(cadr option)))))
     151    (t
     152     (list `',(car option) `',(cadr option)))))
     153
     154(defun make-initfunction (initform)
     155  `(function (lambda () ,initform)))
    152156
    153157(defconstant +slot-unbound+ (make-symbol "SLOT-UNBOUND"))
     
    13581362
    13591363(defgeneric make-instance (class &key))
     1364
    13601365(defmethod make-instance ((class standard-class) &rest initargs)
     1366  (let ((class-default-initargs (class-default-initargs class)))
     1367    (when class-default-initargs
     1368      (let ((default-initargs ())
     1369            (not-found (gensym)))
     1370        (do* ((list class-default-initargs (cddr list))
     1371              (key (car list) (car list))
     1372              (fn (cadr list) (cadr list)))
     1373             ((null list))
     1374          (when (eq (getf initargs key not-found) not-found)
     1375            (setf default-initargs (append default-initargs (list key (funcall fn))))))
     1376        (setf initargs (append initargs default-initargs)))))
    13611377  (let ((instance (allocate-instance class)))
    1362     (apply #'initialize-instance instance
    1363            (append initargs (class-default-initargs class)))
     1378    (apply #'initialize-instance instance initargs)
    13641379    instance))
     1380
    13651381(defmethod make-instance ((class symbol) &rest initargs)
    13661382  (apply #'make-instance (find-class class) initargs))
    13671383
    13681384(defgeneric initialize-instance (instance &key))
     1385
    13691386(defmethod initialize-instance ((instance standard-object) &rest initargs)
    13701387  (apply #'shared-initialize instance t initargs))
    13711388
    13721389(defgeneric reinitialize-instance (instance &key))
     1390
    13731391(defmethod reinitialize-instance
    13741392  ((instance standard-object) &rest initargs)
     
    13761394
    13771395(defgeneric shared-initialize (instance slot-names &key))
     1396
    13781397(defmethod shared-initialize ((instance standard-object)
    13791398                              slot-names &rest all-keys)
     
    13811400    (let ((slot-name (slot-definition-name slot)))
    13821401      (multiple-value-bind (init-key init-value foundp)
    1383         (get-properties
    1384          all-keys (slot-definition-initargs slot))
     1402        (get-properties all-keys (slot-definition-initargs slot))
    13851403        (declare (ignore init-key))
    13861404        (if foundp
Note: See TracChangeset for help on using the changeset viewer.