[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
method combination -- mayday PCL
- To: commonloops.PARC@Xerox.com
- Subject: method combination -- mayday PCL
- From: Neil Goldman <goldman@venera.isi.EDU>
- Date: Tue, 25 Sep 1990 08:28:00 PDT
- Cc: goldman@hpai23.isi.EDU
- Posted-date: Tue, 25 Sep 90 11:28:00 EDT
Has anyone encountered (and perhaps fixed) a problem with
MAYDAY pcl involving the use of the :ARGUMENTS option to
DEFINE-METHOD-COMBINATION?
My source code:
(define-method-combination help-string-merge ()
((primary () :required t))
(:arguments form)
`(block :done
,@(mapcar #'(lambda (method)
`(when
(multiple-value-call #'merge-into-help-strings
(call-method ,method ()))
(return-from :done nil)))
primary)
(structure-inherit-help-string ,form)))
Which macroexpands into:
(PROGN
'(DEFINE-METHOD-COMBINATION HELP-STRING-MERGE)
(EVAL-WHEN (LOAD EVAL)
(PCL::LOAD-LONG-DEFCOMBIN 'HELP-STRING-MERGE (QUOTE NIL)
#'(LAMBDA (PCL::.GENERIC-FUNCTION.
PCL::.METHOD-COMBINATION.
PCL::.APPLICABLE-METHODS.)
(PROGN
PCL::.GENERIC-FUNCTION.
PCL::.METHOD-COMBINATION.
PCL::.APPLICABLE-METHODS.)
(BLOCK PCL::.LONG-METHOD-COMBINATION-FUNCTION.
(LET ((PCL::INNER-RESULT.
(LET ((FORM '#:G74750)
PRIMARY
#:G74749)
(DOLIST (PCL::.METHOD.
PCL::.APPLICABLE-METHODS.)
(LET ((PCL::.QUALIFIERS.
(METHOD-QUALIFIERS
PCL::.METHOD.))
(PCL::.SPECIALIZERS.
(PCL::METHOD-SPECIALIZERS
PCL::.METHOD.)))
(PROGN
PCL::.QUALIFIERS.
PCL::.SPECIALIZERS.)
(COND ((OR
(NULL
PCL::.QUALIFIERS.))
(IF
(EQUAL
#:G74749
PCL::.SPECIALIZERS.)
(RETURN-FROM PCL::.LONG-METHOD-COMBINATION-FUNCTION.
'(ERROR
"More than one method of type ~S ~
with the same specializers."
'PRIMARY))
(SETQ
#:G74749
PCL::.SPECIALIZERS.))
(PUSH
PCL::.METHOD.
PRIMARY)))))
(WHEN (NULL PRIMARY)
(RETURN-FROM PCL::.LONG-METHOD-COMBINATION-FUNCTION.
'(ERROR
"No ~S methods."
'PRIMARY)))
(SETQ PRIMARY
(NREVERSE PRIMARY))
(LIST* 'BLOCK ':DONE
(APPEND
(MAPCAR
#'(LAMBDA (METHOD)
(LIST* 'WHEN
(LIST
'MULTIPLE-VALUE-CALL
'#'MERGE-INTO-HELP-STRINGS
(LIST*
'CALL-METHOD
METHOD
'(NIL)))
'((RETURN-FROM :DONE
NIL))))
PRIMARY)
(LIST
(LIST
'STRUCTURE-INHERIT-HELP-STRING
FORM)))))))
(LIST* 'APPLY
(LIST 'FUNCTION
(LIST 'LAMBDA
'(#:G74750
&REST
PCL::.IGNORE.)
'(DECLARE
(IGNORE
PCL::.IGNORE.))
PCL::INNER-RESULT.))
'(PCL::.COMBINED-METHOD-ARGS.))))))))
when compiling
Warning: Symbol PCL::.COMBINED-METHOD-ARGS. declared special
and, not surprisingly, when run,
error Unbound Symbol PCL::.COMBINED-METHOD-ARGS.
The source of the reference to this symbol is the PCL function
DEAL-WITH-ARGUMENTS-OPTION, which appears to be written expecting
a variable by this name to be (lexically perhaps) bound around
the code it produces. I can find no other references to the symbol
PCL::.COMBINED-METHOD-ARGS.
in the PCL sources I have.
(defun deal-with-arguments-option (wrapped-body arguments-option)
(let* ((intercept-lambda-list
(gathering1 (collecting)
(dolist (arg arguments-option)
(if (memq arg lambda-list-keywords)
(gather1 arg)
(gather1 (gensym))))))
(intercept-rebindings
(gathering1 (collecting)
(iterate ((arg (list-elements arguments-option))
(int (list-elements intercept-lambda-list)))
(unless (memq arg lambda-list-keywords)
(gather1 `(,arg ',int)))))))
;;
;;
(setf (cadr wrapped-body)
(append intercept-rebindings (cadr wrapped-body)))
;;
;; Be sure to fill out the intercept lambda list so that it can
;; be too short if it wants to.
;;
(cond ((memq '&rest intercept-lambda-list))
((memq '&allow-other-keys intercept-lambda-list))
((memq '&key intercept-lambda-list)
(setq intercept-lambda-list
(append intercept-lambda-list '(&allow-other-keys))))
(t
(setq intercept-lambda-list
(append intercept-lambda-list '(&rest .ignore.)))))
`(let ((inner-result. ,wrapped-body))
`(apply #'(lambda ,',intercept-lambda-list
,,(when (memq '.ignore. intercept-lambda-list)
''(declare (ignore .ignore.)))
,inner-result.)
.combined-method-args.))))