[Bese-devel] can we do coroutines with cps?

[Pascal Bourguignon]

With cps from ucw-0.3.9, I'm trying to implement coroutines suspend/resume:

(defparameter *coroutine* (cons t t))

(defun/cc resume ()
  (print `(:resume-1 *coroutine* = ,*coroutine*))
  (setf (cdr *Coroutine*) t)
  (call/cc (car *coroutine*))
  (print `(:resume-2 *coroutine* = ,*coroutine*)))

(defun/cc suspend (escape)
  (print `(:suspend-1 *coroutine* = ,*coroutine*))
  (setf (car *Coroutine*) (progn (setf (cdr *Coroutine*) nil)
                                 (call/cc (function identity))))
  (print `(:suspend-2 *coroutine* = ,*coroutine*))
  (unless (cdr *coroutine*)
    (funcall escape nil))
  (print `(:suspend-3 *coroutine* = ,*coroutine*)))

(defun/cc routine (escape)
  (let ((i 0))
    (loop
       (print `(:routine *coroutine* = ,*coroutine*))
       (print (incf i))
       (suspend escape))))

(defun/cc f (dummy)
  (print `(:f *coroutine* = ,*coroutine*))
  (call/cc (function routine)))

(with-call/cc
    (progn   (setf (car *Coroutine*) (function f))
             (loop repeat 4 do (print :before) (resume) (print :after))))

Unfortunately this doesn't work: routine is not resumed.  It seems the
(call/cc (function identity)) doens't return the current continuation,
but jumps to the end of with-call/cc:

:BEFORE 
(:RESUME-1 *COROUTINE* =
 (#<FUNCTION F (DUMMY) (DECLARE (SYSTEM::IN-DEFUN F))
    (BLOCK F
     (LET ((#:K-12203 (OR IT.BESE.ARNESI::*K* #'IT.BESE.ARNESI::TOPLEVEL-K)))
      (DECLARE (IGNORABLE #:K-12203))
      (IT.BESE.ARNESI::DRIVE-CPS
       (PROGN (PRINT (LIST ':F '*COROUTINE* '= *COROUTINE*))
        (LAMBDA NIL
         (FUNCALL #'IT.BESE.ARNESI::TOPLEVEL-K
          (FUNCALL #'ROUTINE
           (IT.BESE.ARNESI::MAKE-CALL/CC-K #:K-12203))))))))>)) 
(:F *COROUTINE* =
 (#<FUNCTION F (DUMMY) (DECLARE (SYSTEM::IN-DEFUN F))
    (BLOCK F
     (LET ((#:K-12203 (OR IT.BESE.ARNESI::*K* #'IT.BESE.ARNESI::TOPLEVEL-K)))
      (DECLARE (IGNORABLE #:K-12203))
      (IT.BESE.ARNESI::DRIVE-CPS
       (PROGN (PRINT (LIST ':F '*COROUTINE* '= *COROUTINE*))
        (LAMBDA NIL
         (FUNCALL #'IT.BESE.ARNESI::TOPLEVEL-K
          (FUNCALL #'ROUTINE (IT.BESE.ARNESI::MAKE-CALL/CC-K #:K-12203))))))))>
  . T)) 
(:ROUTINE *COROUTINE* =
 (#<FUNCTION F (DUMMY) (DECLARE (SYSTEM::IN-DEFUN F))
    (BLOCK F
     (LET ((#:K-12203 (OR IT.BESE.ARNESI::*K* #'IT.BESE.ARNESI::TOPLEVEL-K)))
      (DECLARE (IGNORABLE #:K-12203))
      (IT.BESE.ARNESI::DRIVE-CPS
       (PROGN (PRINT (LIST ':F '*COROUTINE* '= *COROUTINE*))
        (LAMBDA NIL
         (FUNCALL #'IT.BESE.ARNESI::TOPLEVEL-K
          (FUNCALL #'ROUTINE (IT.BESE.ARNESI::MAKE-CALL/CC-K #:K-12203))))))))>
  . T)) 
1 
(:SUSPEND-1 *COROUTINE* =
 (#<FUNCTION F (DUMMY) (DECLARE (SYSTEM::IN-DEFUN F))
    (BLOCK F
     (LET ((#:K-12203 (OR IT.BESE.ARNESI::*K* #'IT.BESE.ARNESI::TOPLEVEL-K)))
      (DECLARE (IGNORABLE #:K-12203))
      (IT.BESE.ARNESI::DRIVE-CPS
       (PROGN (PRINT (LIST ':F '*COROUTINE* '= *COROUTINE*))
        (LAMBDA NIL
         (FUNCALL #'IT.BESE.ARNESI::TOPLEVEL-K
          (FUNCALL #'ROUTINE (IT.BESE.ARNESI::MAKE-CALL/CC-K #:K-12203))))))))>
  . T)) 
#<COMPILED-FUNCTION IT.BESE.ARNESI::MAKE-CALL/CC-K-1>


Is it possible to do co-routines with arnesi cps?

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
Kitty like plastic.
Confuses for litter box.
Don't leave tarp around.