7 |
(setq *EVAL-WHEN-COMPILE* t) |
(setq *EVAL-WHEN-COMPILE* t) |
8 |
) |
) |
9 |
|
|
10 |
(defmacro memq (item list) `(member ,item ,list :test #'eq)) |
(import '(si::memq) 'pcl) |
11 |
|
;(defmacro memq (item list) `(member ,item ,list :test #'eq)) |
12 |
(defmacro assq (item list) `(assoc ,item ,list :test #'eq)) |
(defmacro assq (item list) `(assoc ,item ,list :test #'eq)) |
13 |
(defmacro posq (item list) `(position ,item ,list :test #'eq)) |
(defmacro posq (item list) `(position ,item ,list :test #'eq)) |
14 |
|
|
291 |
(si::s-data-name includes))))) |
(si::s-data-name includes))))) |
292 |
|
|
293 |
(defun structure-type-internal-slotds (type) |
(defun structure-type-internal-slotds (type) |
294 |
(si::s-data-slot-descriptions (get type 'si::s-data)) |
(si::s-data-slot-descriptions (get type 'si::s-data))) |
|
) |
|
295 |
|
|
296 |
(defun structure-type-slot-description-list (type) |
(defun structure-type-slot-description-list (type) |
297 |
(or (cdr (gethash type *structure-table*)) |
(or (cdr (gethash type *structure-table*)) |
298 |
(mapcan #'(lambda (slotd) |
(mapcan #'(lambda (slotd) |
299 |
(when (and slotd (car slotd)) |
(when (and slotd (car slotd)) |
300 |
(let ((offset (fifth slotd))) |
(let ((read-only-p (fourth slotd)) |
301 |
(let ((reader #'(lambda (x) |
(offset (fifth slotd))) |
302 |
(si:structure-ref1 x offset) |
(let ((reader (lambda (x) (si:structure-ref1 x offset))) |
303 |
)) |
(writer ;(if read-only-p |
304 |
(writer #'(lambda (v x) |
;(lambda (v x) (si:structure-ref1 x offset)) |
305 |
(si:structure-set x type offset v)))) |
(lambda (v x) (si:structure-set x type offset v)))) |
306 |
#+turbo-closure (si:turbo-closure reader) |
#+turbo-closure (si:turbo-closure reader) |
307 |
#+turbo-closure (si:turbo-closure writer) |
#+turbo-closure (si:turbo-closure writer) |
308 |
(let* ((reader-sym |
(let* ((reader-sym |
309 |
(let ((*package* *the-pcl-package*)) |
(let ((*package* *the-pcl-package*)) |
310 |
(intern (format nil "~s SLOT~D" type offset)))) |
(intern (format nil "~s SLOT~D" type offset)))) |
311 |
(writer-sym (get-setf-function-name reader-sym)) |
(writer-sym (get-setf-function-name reader-sym)) |
312 |
(slot-name (first slotd)) |
(slot-name (first slotd))) |
|
(read-only-p (fourth slotd))) |
|
313 |
(setf (symbol-function reader-sym) reader) |
(setf (symbol-function reader-sym) reader) |
314 |
(setf (symbol-function writer-sym) writer) |
(setf (symbol-function writer-sym) writer) |
315 |
(do-standard-defsetf-1 reader-sym) |
(do-standard-defsetf-1 reader-sym) |
316 |
(list (list slot-name |
(list (list slot-name |
317 |
|
(find-symbol (concatenate 'string (symbol-name type) "-" (symbol-name slot-name)) |
318 |
|
(symbol-package type)) |
319 |
reader-sym |
reader-sym |
320 |
(and (not read-only-p) writer)))))))) |
writer |
321 |
|
(third slotd) |
322 |
|
(second slotd)))))))) |
323 |
(let ((slotds (structure-type-internal-slotds type)) |
(let ((slotds (structure-type-internal-slotds type)) |
324 |
(inc (structure-type-included-type-name type))) |
(inc (structure-type-included-type-name type))) |
325 |
(if inc |
(if inc |
333 |
(defun structure-slotd-accessor-symbol (slotd) |
(defun structure-slotd-accessor-symbol (slotd) |
334 |
(second slotd)) |
(second slotd)) |
335 |
|
|
|
;(defun structure-slotd-writer-function (slotd) |
|
|
; (third slotd)) |
|
|
|
|
336 |
(defun structure-slotd-reader-function (slotd) |
(defun structure-slotd-reader-function (slotd) |
337 |
(third slotd)) |
(third slotd)) |
338 |
|
|
339 |
(defun structure-slotd-writer-function (slotd) |
(defun structure-slotd-writer-function (slotd) |
340 |
(fourth slotd)) |
(fourth slotd)) |
341 |
|
|
342 |
|
(defun structure-slotd-type (slotd) |
343 |
|
(fifth slotd)) |
344 |
|
|
345 |
|
(defun structure-slotd-init-form (slotd) |
346 |
|
(sixth slotd)) |
347 |
|
|
348 |
(defun renew-sys-files() |
(defun renew-sys-files() |
349 |
;; packages: |
;; packages: |
350 |
(compiler::get-packages "sys-package.lisp") |
(compiler::get-packages "sys-package.lisp") |