Re: VTP exception handling

[Guido.Bosch@loria.fr (Guido Bosch)]

Guido Bosch writes:
 > My todays (or better "tonights") question concerns the VTP exceptions:
 > 
 > 		...
 > 
 > Do you use in your VTP programs a VTP exeption handler, e.g., a kind
 > of `vtp-condition-case' with a similar behavior than the
 > condition-case form in Common Lisp?
			  ^^^^^^^^^^^^
		Read Emacs Lisp, not Common Lisp.

 > 
 > If not so, I suppose that the LeLisp fsubr `lock' is the best way to
 > program one. Is this right? 
 > 

I'm answering to my own question, since I've now written a
`vtp-condition-case' exception handler. Maybe sombody else will find it
also useful,  so here it is: 

;; ----------------------------------------------------------------------------
;; VTP exception handler
;; ----------------------------------------------------------------------------
;; 
;; Regain control when a VTP exit exception  is signaled.
;; Usage looks like
;;
;; (vtp-condition-case VAR
;;     BODYFORM
;;   HANDLERS
;;   ...)
;;
;; Executes BODYFORM and returns its value if no exception happens.
;; Each element of HANDLERS looks like (EXIT-TAG BODY ...)  where the
;; BODY is made of Lisp expressions.
;; 
;; A handler is applicable to an error if EXIT-TAG is the exits tag
;; name.  If an exit happens, the first applicable handler is run.
;; 
;; When a handler handles an error, control returns to the
;; condition-case and the handler BODY... is executed with VAR bound
;; to (SIGNALED-EXIT . EXIT-DATA).
;; 
;; The value of the last BODY form is returned from the condition-case.
;;

(dmd vtp-condition-case (exit-val protected-form . cases)
  (let ((tag (gensym))
	(val (gensym)))
  `(lock (lambda (,tag ,val)
	   (let ((,exit-val (cons ,tag ,val)))
	     (if ,tag
	       (selectq ,tag
		 ,@cases
		 (t (evexit ,tag,val)))
	     ,val)))
    ,protected-form)))

;; Here is an example of the macroexpansion:
;; 
;; (vtp-condition-case err
;;     (protected-form)
;;   (exit1 form11 form12)
;;   (exit2 form21 form22))
;;
;;  -->
;; 
;; (lock (lambda  (g168 g169) 
;; 	(let  ((err (cons g168 g169))) 
;; 	  (if g168
;; 	      (selectq g168
;; 		(exit1 form11 form12)
;; 		(exit2 form21 form22)
;; 		(t (evexit g168 g169)))
;; 	      g169) ))
;;       (protected-form))
;;