Update of /project/cl-store/cvsroot/cl-store/sbcl In directory clnet:/tmp/cvs-serv22833/sbcl
Modified Files: custom.lisp Log Message: Fixed structure definition storing for more recent sbcl versions.
--- /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp 2005/10/04 08:14:02 1.10 +++ /project/cl-store/cvsroot/cl-store/sbcl/custom.lisp 2006/03/14 10:58:59 1.11 @@ -101,11 +101,36 @@ (funcall (compile nil `(lambda () ,@(sbcl-struct-defs dd)))) (find-class (dd-name dd)))
+;; From 0.9.6.25 sb-kernel::%defstruct +;; takes a source location as a third argument. +(eval-when (:compile-toplevel) + (labels ((make-version (string) + (map-into (make-list 4 :initial-element 0) + #'parse-integer + (asdf::split string nil '(#.)))) + (version>= (v1 v2) + (loop for x in (make-version v1) + for y in (make-version v2) + when (> x y) :do (return t) + when (> y x) :do (return nil) + finally (return t)))) + (when (version>= (lisp-implementation-version) + "0.9.6.25") + (pushnew :defstruct-has-source-location *features*)))) + +asdf::version-satisfies +(defun sb-kernel-defstruct (dd supers source) + (declare (ignorable source)) + #+defstruct-has-source-location + (sb-kernel::%defstruct dd supers source) + #-defstruct-has-source-location + (sb-kernel::%defstruct dd supers)) + (defun sbcl-define-structure (dd supers) (cond ((or *nuke-existing-classes* (not (find-class (dd-name dd) nil))) ;; create-struct - (sb-kernel::%defstruct dd supers) + (sb-kernel-defstruct dd supers nil) ;; compiler stuff (sb-kernel::%compiler-defstruct dd supers) ;; create make-?