Am Di., 29. Okt. 2024 um 15:01 Uhr schrieb Marc Nieper-Wißkirchen
<xxxxxx@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)))))))