[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] compute-restarts
From: |
Camm Maguire |
Subject: |
[Gcl-devel] compute-restarts |
Date: |
15 Oct 2002 13:08:59 -0400 |
Greetings! I'm a bit confused as to whether the fix I recently
committed to get handler-case to see the restarts is indicative of
some underlying lexical scope problem.
The main error handler called by any internal gcl function looks like:
=============================================================================
>(macroexpand ' (with-simple-restart
(continue "~a" (apply #'format nil continue-format-string args))
(apply #'error condition-name
:function-name function-name
(let ((k-a (mapcan #'list (cdr e-d) args)))
(if (simple-condition-class-p condition-name)
(list* :format-string error-format-string
:format-arguments args
k-a)
k-a))))
)
(BLOCK #:G1967
(LET ((#:G1968 NIL))
(TAGBODY
(RESTART-BIND
((CONTINUE
#'(LAMBDA (&REST CONDITIONS::TEMP)
(SETQ #:G1968 CONDITIONS::TEMP)
(GO #:G1969))
:REPORT-FUNCTION
#'(LAMBDA (STREAM)
(FORMAT STREAM "~a"
(APPLY #'FORMAT NIL CONTINUE-FORMAT-STRING
ARGS)))))
(RETURN-FROM #:G1967
(PROGN
(APPLY #'ERROR CONDITION-NAME :FUNCTION-NAME FUNCTION-NAME
(LET ((K-A (MAPCAN #'LIST (CDR E-D) ARGS)))
(IF (SIMPLE-CONDITION-CLASS-P CONDITION-NAME)
(LIST* :FORMAT-STRING ERROR-FORMAT-STRING
:FORMAT-ARGUMENTS ARGS K-A)
K-A))))))
#:G1969
(RETURN-FROM #:G1967
(APPLY #'(LAMBDA () (VALUES NIL T)) #:G1968)))))
T
>(macroexpand '(RESTART-BIND
((CONTINUE
#'(LAMBDA (&REST CONDITIONS::TEMP)
(SETQ #:G1968 CONDITIONS::TEMP)
(GO #:G1969))
:REPORT-FUNCTION
#'(LAMBDA (STREAM)
(FORMAT STREAM "~a"
(APPLY #'FORMAT NIL CONTINUE-FORMAT-STRING
ARGS)))))
(RETURN-FROM #:G1967
(PROGN
(APPLY #'ERROR CONDITION-NAME :FUNCTION-NAME FUNCTION-NAME
(LET ((K-A (MAPCAN #'LIST (CDR E-D) ARGS)))
(IF (SIMPLE-CONDITION-CLASS-P CONDITION-NAME)
(LIST* :FORMAT-STRING ERROR-FORMAT-STRING
:FORMAT-ARGUMENTS ARGS K-A)
K-A)))))))
(LET ((CONDITIONS::*RESTART-CLUSTERS*
(CONS (LIST (CONDITIONS::MAKE-RESTART :NAME 'CONTINUE
:FUNCTION
#'(LAMBDA (&REST CONDITIONS::TEMP)
(SETQ #:G1968 CONDITIONS::TEMP)
(GO #:G1969))
:REPORT-FUNCTION
#'(LAMBDA (STREAM)
(FORMAT STREAM "~a"
(APPLY #'FORMAT NIL
CONTINUE-FORMAT-STRING ARGS)))))
CONDITIONS::*RESTART-CLUSTERS*)))
(RETURN-FROM #:G1967
(PROGN
(APPLY #'ERROR CONDITION-NAME :FUNCTION-NAME FUNCTION-NAME
(LET ((K-A (MAPCAN #'LIST (CDR E-D) ARGS)))
(IF (SIMPLE-CONDITION-CLASS-P CONDITION-NAME)
(LIST* :FORMAT-STRING ERROR-FORMAT-STRING
:FORMAT-ARGUMENTS ARGS K-A)
K-A))))))
T
>
=============================================================================
If I make the following small patch to handler.lisp undoing my fix:
(Here 'error called above invokes 'signal in turn, which then calls
each handler funtion registered by handler-case and handler-bind.)
'signal patch:
(WHEN (TYPEP CONDITION (CAR HANDLER))
(progn
(setf *HANDLER-RESTART-CLUSTERS* *RESTART-CLUSTERS*)
+ (format t "in signal, restart clusters is ~S~%"
*restart-clusters*)
(FUNCALL (CDR HANDLER) CONDITION)
(setf *HANDLER-RESTART-CLUSTERS* nil))
(RETURN NIL) ;?
'handler-case patch:
@@ -128,8 +129,8 @@
`(RETURN-FROM ,TAG
,(COND ((CADDR ANNOTATED-CASE)
`(LET ((,(CAADDR
ANNOTATED-CASE)
- ,VAR)
- (*RESTART-CLUSTERS*
*HANDLER-RESTART-CLUSTERS*))
+ ,VAR))
+; (*RESTART-CLUSTERS*
*HANDLER-RESTART-CLUSTERS*))
,@BODY))
((NOT (CDR BODY))
(CAR BODY))
I get the folowing behavior:
=============================================================================
> (handler-case
(make-package "A")
(error (c)
(if (position 'abort (compute-restarts c)
:key #'restart-name :test-not #'eq)
'success
'failure)))
#<"A" package>
> (handler-case
(make-package "A")
(error (c)
(if (position 'abort (compute-restarts c)
:key #'restart-name :test-not #'eq)
'success
'failure)))
in signal, restart clusters is ((#<RESTART.0>))
FAILURE
> (handler-case
(make-package "A")
(error (c)(format t "restart-clusters is ~S~%"
conditions::*restart-clusters*)
(if (position 'abort (compute-restarts c)
:key #'restart-name :test-not #'eq)
'success
'failure)))
in signal, restart clusters is ((#<RESTART.1>))
restart-clusters is NIL
FAILURE
> (macroexpand ' (handler-case
(make-package "A")
(error (c)(format t "restart-clusters is ~S~%"
conditions::*restart-clusters*)
(if (position 'abort (compute-restarts c)
:key #'restart-name :test-not #'eq)
'success
'failure))))
(BLOCK #:G1976
(LET ((#:G1977 NIL))
#:G1977
(TAGBODY
(HANDLER-BIND
((ERROR #'(LAMBDA (CONDITIONS::TEMP)
(SETQ #:G1977 CONDITIONS::TEMP)
(GO #:G1978))))
(RETURN-FROM #:G1976 (MAKE-PACKAGE "A")))
#:G1978
(RETURN-FROM #:G1976
(LET ((C #:G1977))
(FORMAT T "restart-clusters is ~S~%"
CONDITIONS::*RESTART-CLUSTERS*)
(IF (POSITION 'ABORT (COMPUTE-RESTARTS C) :KEY #'RESTART-NAME
:TEST-NOT #'EQ)
'SUCCESS 'FAILURE))))))
T
(macroexpand '(HANDLER-BIND
((ERROR #'(LAMBDA (CONDITIONS::TEMP)
(SETQ #:G1977 CONDITIONS::TEMP)
(GO #:G1978))))))
(LET ((CONDITIONS::*HANDLER-CLUSTERS*
(CONS (LIST (CONS 'ERROR
#'(LAMBDA (CONDITIONS::TEMP)
(SETQ #:G1977 CONDITIONS::TEMP)
(GO #:G1978))))
CONDITIONS::*HANDLER-CLUSTERS*))))
T
=============================================================================
When handler-case defines the new error processing lambda function, it
is appearing to carry with it the current *restart-clusters* as
opposed to the dynamically bound value at invocation time. Or
something similar. What I'd like to know is if this is the correct
lexical binding behavior, i.e. whether the bug is in handler.lisp, or
in the lexical binding. If the former, it would seem rather difficult
to know in LISP which variables need exporting in this manner amd in
which circumstances.
Take care,
--
Camm Maguire address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah
- [Gcl-devel] compute-restarts,
Camm Maguire <=