Ignore:
Timestamp:
08/07/11 22:11:31 (10 years ago)
Author:
ehuelsmann
Message:

Use pre-compiled closures to populate the reader/writer accessors
for structures. In order to make sure they are pre-compiled in our
build too, compile defstruct.lisp earlier in the compilation phase.

(Saves roughly 20s on my compilation runs.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/defstruct.lisp

    r13188 r13451  
    330330                 (simple-typep object ',*dd-name*))))))))
    331331
     332(defun make-list-reader (index)
     333  #'(lambda (instance)
     334      (elt instance index)))
     335
     336(defun make-vector-reader (index)
     337  #'(lambda (instance)
     338      (aref instance index)))
     339
     340(defun make-structure-reader (index structure-type)
     341  (declare (ignore structure-type))
     342  #'(lambda (instance)
     343      ;; (unless (typep instance structure-type)
     344      ;;   (error 'type-error
     345      ;;          :datum instance
     346      ;;          :expected-type structure-type))
     347      (structure-ref instance index)))
     348
    332349(defun define-reader (slot)
    333350  (let ((accessor-name (dsd-reader slot))
     
    336353    (cond ((eq *dd-type* 'list)
    337354           `((declaim (ftype (function * ,type) ,accessor-name))
    338              (defun ,accessor-name (instance) (elt instance ,index))))
     355             (setf (symbol-function ',accessor-name)
     356                   (make-list-reader ,index))))
    339357          ((or (eq *dd-type* 'vector)
    340358               (and (consp *dd-type*) (eq (car *dd-type*) 'vector)))
    341359           `((declaim (ftype (function * ,type) ,accessor-name))
    342              (defun ,accessor-name (instance) (aref instance ,index))
     360             (setf (symbol-function ',accessor-name)
     361                   (make-vector-reader ,index))
    343362             (define-source-transform ,accessor-name (instance)
    344363               `(aref (truly-the ,',*dd-type* ,instance) ,,index))))
    345364          (t
    346365           `((declaim (ftype (function * ,type) ,accessor-name))
    347              (defun ,accessor-name (instance)
    348                (structure-ref (the ,*dd-name* instance) ,index))
     366             (setf (symbol-function ',accessor-name)
     367                   (make-structure-reader ,index ',*dd-name*))
    349368             (define-source-transform ,accessor-name (instance)
    350369               ,(if (eq type 't)
     
    353372                        (structure-ref (the ,',*dd-name* ,instance) ,,index)))))))))
    354373
     374(defun make-list-writer (index)
     375  #'(lambda (value instance)
     376      (%set-elt instance index value)))
     377
     378(defun make-vector-writer (index)
     379  #'(lambda (value instance)
     380      (aset instance index value)))
     381
     382(defun make-structure-writer (index structure-type)
     383  (declare (ignore structure-type))
     384  #'(lambda (value instance)
     385      ;; (unless (typep instance structure-type)
     386      ;;   (error 'type-error
     387      ;;          :datum instance
     388      ;;          :expected-type structure-type))
     389      (structure-set instance index value)))
     390
     391
     392
    355393(defun define-writer (slot)
    356394  (let ((accessor-name (dsd-reader slot))
    357395        (index (dsd-index slot)))
    358396    (cond ((eq *dd-type* 'list)
    359            `((defun (setf ,accessor-name) (value instance)
    360                (%set-elt instance ,index value))))
     397           `((setf (get ',accessor-name 'setf-function)
     398                   (make-list-writer ,index))))
    361399          ((or (eq *dd-type* 'vector)
    362400               (and (consp *dd-type*) (eq (car *dd-type*) 'vector)))
    363            `((defun (setf ,accessor-name) (value instance)
    364                (aset instance ,index value))
     401           `((setf (get ',accessor-name 'setf-function)
     402                   (make-vector-writer ,index))
    365403             (define-source-transform (setf ,accessor-name) (value instance)
    366404               `(aset (truly-the ,',*dd-type* ,instance) ,,index ,value))))
    367405          (t
    368            `((defun (setf ,accessor-name) (value instance)
    369                (structure-set (the ,*dd-name* instance) ,index value))
     406           `((setf (get ',accessor-name 'setf-function)
     407                   (make-structure-writer ,index ',*dd-name*))
    370408             (define-source-transform (setf ,accessor-name) (value instance)
    371409               `(structure-set (the ,',*dd-name* ,instance)
Note: See TracChangeset for help on using the changeset viewer.