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.)
parent 7e08a868
......@@ -89,6 +89,7 @@
:defaults (merge-pathnames
file output-path))))
(compile-file-if-needed file :output-file out))))
(load (do-compile "defstruct.lisp"))
(load (do-compile "coerce.lisp"))
(load (do-compile "open.lisp"))
(load (do-compile "dump-form.lisp"))
......@@ -157,7 +158,6 @@
"defmacro.lisp"
"defpackage.lisp"
"defsetf.lisp"
"defstruct.lisp"
"deftype.lisp"
"delete-duplicates.lisp"
"deposit-field.lisp"
......
......@@ -329,44 +329,82 @@
`((defun ,pred (object)
(simple-typep object ',*dd-name*))))))))
(defun make-list-reader (index)
#'(lambda (instance)
(elt instance index)))
(defun make-vector-reader (index)
#'(lambda (instance)
(aref instance index)))
(defun make-structure-reader (index structure-type)
(declare (ignore structure-type))
#'(lambda (instance)
;; (unless (typep instance structure-type)
;; (error 'type-error
;; :datum instance
;; :expected-type structure-type))
(structure-ref instance index)))
(defun define-reader (slot)
(let ((accessor-name (dsd-reader slot))
(index (dsd-index slot))
(type (dsd-type slot)))
(cond ((eq *dd-type* 'list)
`((declaim (ftype (function * ,type) ,accessor-name))
(defun ,accessor-name (instance) (elt instance ,index))))
(setf (symbol-function ',accessor-name)
(make-list-reader ,index))))
((or (eq *dd-type* 'vector)
(and (consp *dd-type*) (eq (car *dd-type*) 'vector)))
`((declaim (ftype (function * ,type) ,accessor-name))
(defun ,accessor-name (instance) (aref instance ,index))
(setf (symbol-function ',accessor-name)
(make-vector-reader ,index))
(define-source-transform ,accessor-name (instance)
`(aref (truly-the ,',*dd-type* ,instance) ,,index))))
(t
`((declaim (ftype (function * ,type) ,accessor-name))
(defun ,accessor-name (instance)
(structure-ref (the ,*dd-name* instance) ,index))
(setf (symbol-function ',accessor-name)
(make-structure-reader ,index ',*dd-name*))
(define-source-transform ,accessor-name (instance)
,(if (eq type 't)
``(structure-ref (the ,',*dd-name* ,instance) ,,index)
``(the ,',type
(structure-ref (the ,',*dd-name* ,instance) ,,index)))))))))
(defun make-list-writer (index)
#'(lambda (value instance)
(%set-elt instance index value)))
(defun make-vector-writer (index)
#'(lambda (value instance)
(aset instance index value)))
(defun make-structure-writer (index structure-type)
(declare (ignore structure-type))
#'(lambda (value instance)
;; (unless (typep instance structure-type)
;; (error 'type-error
;; :datum instance
;; :expected-type structure-type))
(structure-set instance index value)))
(defun define-writer (slot)
(let ((accessor-name (dsd-reader slot))
(index (dsd-index slot)))
(cond ((eq *dd-type* 'list)
`((defun (setf ,accessor-name) (value instance)
(%set-elt instance ,index value))))
`((setf (get ',accessor-name 'setf-function)
(make-list-writer ,index))))
((or (eq *dd-type* 'vector)
(and (consp *dd-type*) (eq (car *dd-type*) 'vector)))
`((defun (setf ,accessor-name) (value instance)
(aset instance ,index value))
`((setf (get ',accessor-name 'setf-function)
(make-vector-writer ,index))
(define-source-transform (setf ,accessor-name) (value instance)
`(aset (truly-the ,',*dd-type* ,instance) ,,index ,value))))
(t
`((defun (setf ,accessor-name) (value instance)
(structure-set (the ,*dd-name* instance) ,index value))
`((setf (get ',accessor-name 'setf-function)
(make-structure-writer ,index ',*dd-name*))
(define-source-transform (setf ,accessor-name) (value instance)
`(structure-set (the ,',*dd-name* ,instance)
,,index ,value)))))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment