Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!usc!snorkelwacker.mit.edu!ai-lab!zurich.ai.mit.edu!jinx
From: jinx@zurich.ai.mit.edu (Guillermo J. Rozas)
Newsgroups: comp.lang.scheme
Subject: Re: catch/throw in scheme - how to ??
Message-ID: <JINX.91Jun10165336@chamarti.ai.mit.edu>
Date: 10 Jun 91 20:53:36 GMT
References: <1991Jun10.124127.17926@eua.ericsson.se>
Sender: news@ai.mit.edu
Reply-To: jinx@zurich.ai.mit.edu
Organization: M.I.T. Artificial Intelligence Lab.
Lines: 89
In-reply-to: joe@erix.ericsson.se's message of 10 Jun 91 12:41:27 GMT

In article <1991Jun10.124127.17926@eua.ericsson.se> joe@erix.ericsson.se (Joe Armstrong) writes:

   Path: ai-lab!mintaka!bloom-beacon!eru!hagbard!sunic!ericom!eua.ericsson.se!erix.ericsson.se!joe
   From: joe@erix.ericsson.se (Joe Armstrong)
   Newsgroups: comp.lang.scheme
   Date: 10 Jun 91 12:41:27 GMT
   Sender: news@eua.ericsson.se
   Organization: Ellemtel Telecom Systems Labs, Stockholm, Sweden
   Lines: 9
   Nntp-Posting-Host: gordons.eua.ericsson.se

   Could sombody who understands these things kindly explain how 
   to do the equivalent of 'catch' and 'throw' in scheme?? -
   can one use call/cc for such operations? - if so how?

   Why? I want to do a non local return from a deep recursion 
   when I dedect an error but not go to all the trouble of unwinding the
   stack and building a lot of stuff which I'm going to junk anyway.

   Joe Armstrong.

call-with-current-continuation (I hate the cutesy call/cc) can be
considered a generalization of catch and throw, although it has an
apparently more confusing interface.

You can easily rewrite programs that use catch and throw to use
call-with-current-continuation instead, but if you find the
catch/throw model more easily understood, we can define catch and
throw in terms of it.

Assuming that there are no CL-style multiple values (or that you are
not using them), and that the program will not error or be
interrupted, we can define catch an throw as macros in the following
way

(define-macro (catch tag . forms)
  `(catch-proc
    ,tag
    (lambda ()
      ,@forms)))

(define-macro (throw tag result-form)
  `(throw-proc
    ,tag
    (lambda ()
      ,result-form)))
	       
where the missing procedures are defined as

(define *catch-tags* '())

(define (catch-proc tag thunk)
  (let ((saved-tags *catch-tags*))
    (let ((value
	   (call-with-current-continuation
	    (lambda (cont)
	      (set! *catch-tags*
		    (cons (cons tag cont)
			  saved-tags))
	      (thunk)))))
      (set! *catch-tags* saved-tags)
      value)))

(define (throw-proc tag thunk)
  (let ((pair (assq tag *catch-tags*)))
    (if (not pair)
	(error "throw: No such tag" tag)
	((cdr pair) (thunk)))))

If you are using CL-style multiple values, and have fluid-let to boot,
then you can replace the definitions of catch-proc and throw-proc with
the following:

(define (catch-proc tag thunk)
  (apply values				; (values-list (call...))
   (call-with-current-continuation
    (lambda (cont)
      (fluid-let ((*catch-tags*
		   (cons (cons tag cont)
			 *catch-tags*)))
	(with-values thunk list))))))	; (multiple-values-list (thunk))

(define (throw-proc tag thunk)
  (let ((pair (assq tag *catch-tags*)))
    (if (not pair)
	(error "throw: No such tag" tag)
	(with-values thunk		; (multiple-value-call #'(lambda all ...)
	  (lambda all			;                      (thunk))
	    ((cdr pair) all))))))