Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!rice!hedera!dorai
From: dorai@hedera.rice.edu (Dorai Sitaram)
Newsgroups: comp.lang.scheme
Subject: Re: call/cc
Summary: and P and F
Keywords: continuations
Message-ID: <5832@brazos.Rice.edu>
Date: 16 Mar 90 22:16:02 GMT
References: <1990Mar8.064319.28399@brutus.cs.uiuc.edu> <4459@daffy.cs.wisc.edu>
Sender: root@rice.edu
Distribution: comp
Organization: Rice University, Houston
Lines: 123

In article <4459@daffy.cs.wisc.edu> schaut@cat9.cs.wisc.edu (Rick Schaut) writes:
>But, noone has answered this yet, so here goes.  The following is a function
>that maps a function to a "tree" where a list represents a node in the
>tree.  The top level list is the root node, and intermediate level lists
>are intermediate nodes (and are the children of the list which contains
>them), and any atoms are the leaves.  For example, (1 (2 3) (4 (5 6)) 7)
>is one such tree.
>
>The catch is that the mapped function may return a value indicating that
>the value that was passed to it was not acceptable (for whatever reason).
>The tree-map function, then, should return a list of the form
>
>	('not-yet <unacceptable input value>).
>
>If the map was applied successfully, then the return sould be
>
>	('done <mapped tree>).
>
>The code that implements this is:
>
[cps-style code deleted]
>
>This is _very_ ugly code, and sufficient reason to understand and use
>call/cc.  The equivalent code that uses call/cc is:
>
>(define (tree-map filter tree)
>  (let ((result (call/cc (lambda(return)(tree-mapc filter tree return)))))
>    (if (and (not (null? result)) (list? result) (equal? 'not-yet (car result)))
>      result
>      (list 'done result))))
>
>(define (tree-mapc filter tree return)
>  (cond
>    ((null? tree) '())
>    ((atom? tree)
>      (let ((result (filter tree)))
>	(if (equal? result '*not-acceptable*)
>	  (tree-mapc 
>	    filter
>	    (call/cc (lambda(context)(return (list 'not-yet tree context))))
>	    return)
>	  result)))
>    (else (cons
>            (tree-mapc filter (car tree) return)
>	    (tree-mapc filter (cdr tree) return)))))
>
>Note also that this version uses call/cc to return control to the top-level
>tree-map function.  This allows the calling routine to provide a substitute
>value back to tree-map, and tree-map will continue the original computation
>using the substituted value.  As you mentioned, interpreters use this same
>construct when they encounter an error.  They use a call/cc to invoke a
>debugging routine which, in turn, allows the user to correct the data/code.
>The corrections are then dropped back into the computation in which the
>error occurred and the computation is restarted where it left off.  If your
>interpreter has a continue option in its break package, then it is using
>a call/cc in the error trap.

The above is OK, but schleps around too many arguments (filter,
return) for no good reason.  Tweaking a bit (and making do without the
'done tag):

(define tree-map
  (lambda (filter tree)
    (call/cc 
      (lambda (return)
        (let loop ([tree tree])
	  (cond [(null? tree) '()]
		[(atom? tree)
		 (let ([result (filter tree)])
		   (if (eq? result 'not-acceptable)
		       (call/cc 
			 (lambda (context)
			   (return (list 'not-yet tree context))))
		       result))]
		[else (cons (loop (car tree)) 
			    (loop (cdr tree)))]))))))

Ach, the above is _also_ unsatisfactory code: _two_ call/cc's; the
first continuation-grab only contributes towards identifying the
entry-point; the second grab doesn't need to be the whole
continuation, just the difference between the entry and break points.
The so-far best solution, based on one by Felleisen for a similar
tree-walk problem in the paper "Theory and Practice of First-class
Prompts", uses prompt (P) and the functional-continuation analog of
call/cc (F).  It certainly is more efficient and IMHO less
sledgehammer-like than the call/cc version:

(define tree-map
  (lambda (filter tree)
    (let loop ([tree tree])
      (cond [(null? tree) '()]
            [(atom? tree)
	     (let ([result (filter tree)])
	       (if (eq? result 'not-acceptable)
		   (F (lambda (context)
			(list 'not-yet tree context)))))]
	    [else (cons (loop (car tree))
			(loop (cdr tree)))]))))

A sample session:

> (set! result (P (tree-map double-if-not-0 '(1 2 (3 0 (4 0 5))))))
(not-yet 0 #<procedure>)

> (set! result (P ((caddr result) 'debug-insert)))
(not-yet 0 #<procedure>)

> (set! result (P ((caddr result) 'debug-insert-2)))
(2 4 (6 debug-insert (8 debug-insert-2 10)))

--dorai

ps: (define double-if-not-0 (lambda (n)
	(if (zero? n) 'not-acceptable (* 2 n))))

ps2: For details about P and F, read the paper, or contact 'most
anybody (once) from Indiana (except maybe the veep).  Regular Scheme
doesn't have them, though it should :-].
--
-------------------------------------------------------------------------------
It may be that the gulfs will wash us down;
It may be we shall touch the Happy Isles.
-------------------------------------------------------------------------------