202 |
#|| ; Need to finish this, then write the maintenance functions. |
#|| ; Need to finish this, then write the maintenance functions. |
203 |
(defun compute-emf-from-wrappers (call wrappers) |
(defun compute-emf-from-wrappers (call wrappers) |
204 |
(when call |
(when call |
205 |
(destructuring-bind (gf-name nreq restp arg-info) call |
; FIXME use regular destructuring-bind |
206 |
|
(pcl-destructuring-bind (gf-name nreq restp arg-info) call |
207 |
(if (eq gf-name 'make-instance) |
(if (eq gf-name 'make-instance) |
208 |
(error "should not get here") ; there is another mechanism for this. |
(error "should not get here") ; there is another mechanism for this. |
209 |
#'(lambda (&rest args) |
#'(lambda (&rest args) |
464 |
|
|
465 |
(defun optimize-slot-value (slots sparameter form) |
(defun optimize-slot-value (slots sparameter form) |
466 |
(if sparameter |
(if sparameter |
467 |
(destructuring-bind (ignore ignore slot-name-form) form |
; FIXME use regular destructuring-bind |
468 |
|
(pcl-destructuring-bind (ignore ignore slot-name-form) form |
469 |
(let ((slot-name (eval slot-name-form))) |
(let ((slot-name (eval slot-name-form))) |
470 |
(optimize-instance-access slots :read sparameter slot-name nil))) |
(optimize-instance-access slots :read sparameter slot-name nil))) |
471 |
`(accessor-slot-value ,@(cdr form)))) |
`(accessor-slot-value ,@(cdr form)))) |
472 |
|
|
473 |
(defun optimize-set-slot-value (slots sparameter form) |
(defun optimize-set-slot-value (slots sparameter form) |
474 |
(if sparameter |
(if sparameter |
475 |
(destructuring-bind (ignore ignore slot-name-form new-value) form |
; FIXME use regular destructuring-bind |
476 |
|
(pcl-destructuring-bind (ignore ignore slot-name-form new-value) form |
477 |
(let ((slot-name (eval slot-name-form))) |
(let ((slot-name (eval slot-name-form))) |
478 |
(optimize-instance-access slots :write sparameter slot-name new-value))) |
(optimize-instance-access slots :write sparameter slot-name new-value))) |
479 |
`(accessor-set-slot-value ,@(cdr form)))) |
`(accessor-set-slot-value ,@(cdr form)))) |
480 |
|
|
481 |
(defun optimize-slot-boundp (slots sparameter form) |
(defun optimize-slot-boundp (slots sparameter form) |
482 |
(if sparameter |
(if sparameter |
483 |
(destructuring-bind (ignore ignore slot-name-form new-value) form |
; FIXME use regular destructuring-bind |
484 |
|
(pcl-destructuring-bind (ignore ignore slot-name-form new-value) form |
485 |
(let ((slot-name (eval slot-name-form))) |
(let ((slot-name (eval slot-name-form))) |
486 |
(optimize-instance-access slots :boundp sparameter slot-name new-value))) |
(optimize-instance-access slots :boundp sparameter slot-name new-value))) |
487 |
`(accessor-slot-boundp ,@(cdr form)))) |
`(accessor-slot-boundp ,@(cdr form)))) |
493 |
|
|
494 |
(defun optimize-writer (slots sparameter gf-name form) |
(defun optimize-writer (slots sparameter gf-name form) |
495 |
(if sparameter |
(if sparameter |
496 |
(destructuring-bind (ignore ignore new-value) form |
; FIXME use regular destructuring-bind |
497 |
|
(pcl-destructuring-bind (ignore ignore new-value) form |
498 |
(optimize-accessor-call slots :write sparameter gf-name new-value)) |
(optimize-accessor-call slots :write sparameter gf-name new-value)) |
499 |
form)) |
form)) |
500 |
;;; |
;;; |