Am Di., 29. Okt. 2024 um 15:01 Uhr schrieb Marc Nieper-Wißkirchen
<marc.nie...@gmail.com>:
>
> As I didn't test the code I posted, of course, I introduced a mistake:
>
> [...]
>
> > Note that when K^ is the empty continuation in the sense of SRFI 248,
> > the code above builds unnecessary objects. A version without a space
> > leak is thus:
> >
> > (app-second
> > (guard
> > (c k^
> > (else
> > (let ((k (if (empty-continuation? k^) k^ (lambda (x) (app-first
> > (k^ x))))))
> > (values
> > (lambda () (k (raise-continuable c)))
> > (lambda () H)))))
> > (let ((v E))
> > (values
> > (lambda () v)
> > (lambda () v)))))
>
> Please replace the condition
>
> (if (empty-continuation? k^) k^ (lambda (x) (app-first k^ x)))
>
> with
>
> (if (empty-condition? k^) values (lambda (x) (app-first (k^ x))))
>
> PS I am going to add one more comment later.
The above code is still not good because the way I wrote it, the
continuation will never be empty. So, I wrote it anew by implementing
prompt0/control0 (the -F- pair), using empty-continuation? to prevent
space leaks:
;; prompt0 and control0
(define (empty-continuation? k) #f) ;not supported by Guile, so
conservative approximation
(define-condition-type &control-condition &condition
make-control-condition control-condition?
(control condition-control))
(define-record-type prompt
(fields first second))
(define-syntax first
(syntax-rules ()
((first e)
(call-with-values (lambda () e)
(case-lambda
((p)
(if (prompt? p)
((prompt-first p))
p))
(val* (apply values val*)))))))
(define-syntax second
(syntax-rules ()
((second e)
(call-with-values (lambda () e)
(case-lambda
((p) (if (prompt? p)
((prompt-second p))
p))
(val* (apply values val*)))))))
(define-syntax prompt0
(syntax-rules ()
((prompt0 e)
(second
(guard
(c k
((control-condition? c)
(if (empty-continuation? k)
(make-prompt
(lambda ()
(raise-continuable c))
(lambda ()
((condition-control c) values)))
(let ((k (lambda arg* (first (apply k arg*)))))
(make-prompt
(lambda ()
(call-with-values
(lambda () (raise-continuable c))
k))
(lambda ()
((condition-control c) k)))))))
e)))))
(define-syntax control0
(syntax-rules ()
((control0 k e)
(raise-continuable
(make-control-condition
(lambda (k) e))))))
(test-eqv 1 (prompt0 1))
(test-eqv 2 (prompt0 (+ 1 (control0 k 2))))
(test-eqv 4 (prompt0 (+ 1 (control0 k (k (k 2))))))
(test-eqv 0 (prompt0 (+ 4 (prompt0 (+ 1 (let ((x (control0 k (k 0))))
(control0 l x)))))))
