gcl-devel
[Top][All Lists]
Advanced

[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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]