From: Kurt Parten
Subject: coroutines in lisp?
Date: 
Message-ID: <KPARTEN.92Mar14004249@sneeze.resp-sci.arizona.edu>
Has anyone ever tried to implement coroutines in lisp?
I have been playing with them in icon, and reading up
on them in Knuth, vol. 1, and would like more info
on whether people actually use this nifty concept.

Thanks,
Kurt
--
Kurt Parten (I don't grow pears)
Respiratory Sciences Staff & Computer Engineering Student
University of Arizona, Tucson
·······@resp-sci.arizona.edu | ······@ece.arizona.edu

From: Barry Margolin
Subject: Re: coroutines in lisp?
Date: 
Message-ID: <ks4sqmINNa2k@early-bird.think.com>
In article <·····················@sneeze.resp-sci.arizona.edu> ·······@sneeze.resp-sci.arizona.edu (Kurt Parten) writes:
>Has anyone ever tried to implement coroutines in lisp?

Common Lisp doesn't have the primitives necessary to implement coroutines,
at least not if you want to use the built-in function calling mechanism to
invoke them.  You can do it in Scheme, as its continuations permit calling
back into an environment.

Symbolics Common Lisp has a facility called "stack groups" that implements
coroutines.  They're also the underlying mechanism used to implement
processes on Lisp Machines.
-- 
Barry Margolin
System Manager, Thinking Machines Corp.

······@think.com          {uunet,harvard}!think!barmar
From: lou
Subject: Re: coroutines in lisp?
Date: 
Message-ID: <LOU.92Mar15000849@atanasoff.rutgers.edu>
In article <············@early-bird.think.com> ······@think.com (Barry Margolin) writes:
   In article <·····················@sneeze.resp-sci.arizona.edu> ·······@sneeze.resp-sci.arizona.edu (Kurt Parten) writes:
   >Has anyone ever tried to implement coroutines in lisp?

   Common Lisp doesn't have the primitives necessary to implement coroutines,
   at least not if you want to use the built-in function calling mechanism to
   invoke them.

Well, you can't implement them in the same pretty way you can in Scheme,
but you CAN implement them using a continuation-passing style of coding,
and in this approach you DO "use the built-in function calling mechanism to
invoke them."  See AI Programming by Charniak et al.
--
					Lou Steinberg

uucp:   {pretty much any major site}!rutgers!aramis.rutgers.edu!lou 
internet:   ···@cs.rutgers.edu
From: Marty Hall
Subject: Re: coroutines in lisp?
Date: 
Message-ID: <1992Mar16.170436.12314@aplcen.apl.jhu.edu>
[Kurt Parten writes]
>   >Has anyone ever tried to implement coroutines in lisp? [...]

[Barmar replies]
>   Common Lisp doesn't have the primitives necessary to implement coroutines,
>   at least not if you want to use the built-in function calling mechanism to
>   invoke them. [...]

[Lou Steinberg adds]
>Well, you can't implement them in the same pretty way you can in Scheme,
>but you CAN implement them using a continuation-passing style of coding,
>and in this approach you DO "use the built-in function calling mechanism to
>invoke them."  See AI Programming by Charniak et al.
                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Better yet, see Lou's own handouts from his excellent (at least to a neophyte
in this area like me) tutorial at LUV-91 on this subject.

Are these available from LUV (or elsewhere) to people who didn't attend?

					- Marty Hall
(setf (need-p 'disclaimer) NIL)
From: Jeff Dalton
Subject: Re: coroutines in lisp?
Date: 
Message-ID: <6415@skye.ed.ac.uk>
In article <·················@atanasoff.rutgers.edu> ···@cs.rutgers.edu writes:
>In article <············@early-bird.think.com> ······@think.com (Barry Margolin) writes:
>   In article <·····················@sneeze.resp-sci.arizona.edu> ·······@sneeze.resp-sci.arizona.edu (Kurt Parten) writes:
>   >Has anyone ever tried to implement coroutines in lisp?
>
>   Common Lisp doesn't have the primitives necessary to implement coroutines,
>   at least not if you want to use the built-in function calling mechanism to
>   invoke them.
>
>Well, you can't implement them in the same pretty way you can in Scheme,
>but you CAN implement them using a continuation-passing style of coding,
>and in this approach you DO "use the built-in function calling mechanism to
>invoke them."  See AI Programming by Charniak et al.

I have written code that way, but it's a pain.  If anyone has a way
to make it look nicer, I'd be very interested.

For what it's worth, here's an example.  I wrote this in 1983 or so,
so I don't know if I still stand by the style.  Also, it was originally
written in T because I didn't have any other Lisp that could handle
functions well enough.  Nonetheless, it seemed to give the T compiler
some trouble, even though it ran successfully.  On the other hand,
several Common Lisp compilers I tried a while after couldn't handle
it at all.  (Recent versions have no problem, though.)

----------------------------------------------------------------------

;;;; MsC Pattern Matcher (continuation-passing version)
;;;;     (converted from T)
;;;
;;; Jeff Dalton
;;;
;;; A pattern is a (possibly nested) list structure that can contain varaibles,
;;; written "+name".  Such a variable can match one or more elements of a list.
;;;
;;; Note: the matcher initially puts both the pattern and unknown each in
;;; an extra pair or parens so that the case of atomic patters doesn't have
;;; to be handled specially.
;;;

(defmacro define ((name &rest args) &body body)
  `(defun ,name ,args . ,body))

;;;; The Matcher
;;;

(define (match pat x)
  (labels
      ((match-loop (success? env producer)
	   (cond (success?
		  (format t "~&~S more? " env)
		  (cond ((not (eq (read) 'no))
			 (funcall producer #'match-loop))
			(t 'done)))
		 (t (format t "fail~%")
		       'done))))
    (match1 (list pat) (list x) nil #'match-loop)))

(define (all-matches pat x)
  (labels
      ((match-loop (s? env pr all)
             (cond (s? ;; one success -- get next match, remembering this
		       ;; in the list of all matches.
		       (funcall pr #'(lambda (s? new-env pr)
			     (match-loop s? new-env pr (cons env all)))))
		   (t all))))
    (match1 (list pat) (list x) nil
	    #'(lambda (s? env pr) (match-loop s? env pr nil)))))

(define (match1 pat x env consumer)
  (assert (and (listp pat) (listp x)))
  (cond ((null pat)
	 (cond ((null x) (funcall consumer t env #'no-more))
	       (t (funcall consumer nil nil #'no-more))))
	((null x) (funcall consumer nil nil #'no-more))
	((variable? (car pat))
	 (cond ((instantiated? (car pat) env)
		(match-with-prefix
		    (value (car pat) env) (cdr pat) x env consumer))
	       (t (try-extensions (car pat) (cdr pat) x env consumer))))
	((atom (car pat))
	 (cond ((equal (car pat) (car x))
		(match1 (cdr pat) (cdr x) env consumer))
	       (t (funcall consumer nil nil #'no-more))))
	((consp (car pat))
	 (cond ((consp (car x))
		(match-with-sublist pat x env consumer))
	       (t (funcall consumer nil nil #'no-more))))
	(t (error "Strange pattern ~S" pat))))

(define (match-with-prefix prefix pat x env consumer)
  ;; the prefix is the value of an instantiated variable;
  ;; therefore, it contains no variables but may have sublists.
  (cond ((null prefix)
	 (match1 pat x env consumer))
	((null x)
	 (funcall consumer nil nil #'no-more))
	((equal (car prefix) (car x))
	 (match-with-prefix (cdr prefix) pat (cdr x) env consumer))
	(t (funcall consumer nil nil #'no-more))))

(define (try-extensions var pat-tail x env con)
  ;; here we instantiate the variable to successive initial segments of
  ;; x and then try to match the rest of the pattern to the rest of x.
  (assert (consp x))
  (labels
      ((tail-loop (s? tail-env tail-pr init x-tail con)
           (cond (s? (funcall con t tail-env
			 #'(lambda (con)
			    (funcall tail-pr
			     #'(lambda (s? tail-env tail-pr)
				 (tail-loop s? tail-env tail-pr
					    init x-tail con))))))
		 ((null x-tail)
		  (funcall con nil nil #'no-more))
		 (t (extend-loop
			(append init (list (car x-tail)))
			(cdr x-tail)
			con))))
       (extend-loop (init x-tail con)
	   (match1 pat-tail x-tail (instantiate var init env)
		   #'(lambda (s? tail-env tail-pr)
		       (tail-loop s? tail-env tail-pr
				  init x-tail con)))))
    (extend-loop (list (car x)) (cdr x) con)))

(define (match-with-sublist pat x env match-con)
  (assert (and (consp pat) (consp x)
	       (consp (car pat)) (consp (car x))))
  (labels
      ((car-loop (s? car-env car-pr match-con)
           (cond (s? (match1 (cdr pat) (cdr x) car-env
			#'(lambda (s? cdr-env cdr-pr)
			   (cdr-loop s? cdr-env cdr-pr car-pr match-con))))
		 (t (funcall match-con nil nil #'no-more))))
       (cdr-loop (s? cdr-env cdr-pr car-pr match-con)
	   (cond (s? ;; one total success
		     (funcall match-con t cdr-env
			 #'(lambda (n-match-con)
			     (funcall cdr-pr
			      #'(lambda (s? cdr-env cdr-pr)
				  (cdr-loop s? cdr-env cdr-pr
				            car-pr n-match-con))))))
		 (t (funcall car-pr
			#'(lambda (s? car-env car-pr)
			   (car-loop s? car-env car-pr match-con)))))))
    (match1 (car pat) (car x) env
      #'(lambda (s? car-env car-pr)
          (car-loop s? car-env car-pr match-con)))))

(define (no-more consumer)
  (funcall consumer nil nil #'error-if-asked))

(define (error-if-asked consumer)
  (error "~S cannot ask for more values" consumer))


;;;; variables and environments
;;;
;;; The standard way to define a character marker for variables
;;; is to modify the readtable, but it's easier just to look at
;;; the first character of the print-name.
;;; 

(define (variable? x)
  (and (symbolp x)
       (char= (schar (symbol-name x) 0) #\+)))

(define (instantiated? var env)
  (assoc var env))

(define (value var env)
  (cadr (assoc var env)))

(define (instantiate var val env)
  (cons (list var val) env))

----------------------------------------------------------------------

Jeff Dalton,                      JANET: ········@uk.ac.ed             
AI Applications Institute,        ARPA:  ·················@nsfnet-relay.ac.uk
Edinburgh University.             UUCP:  ...!ukc!ed.ac.uk!J.Dalton
From: D. Gerdemann
Subject: Re: coroutines in lisp?
Date: 
Message-ID: <nnsge01.700740735@convex>
In <············@early-bird.think.com> ······@think.com (Barry Margolin) writes:

>Common Lisp doesn't have the primitives necessary to implement coroutines,
>at least not if you want to use the built-in function calling mechanism to
>invoke them.  You can do it in Scheme, as its continuations permit calling
>back into an environment.

Is there anywhere where it is described in more detail how to do this in Scheme?

-- Dale Gerdemann
From: Jeff Dalton
Subject: Re: coroutines in lisp?
Date: 
Message-ID: <6414@skye.ed.ac.uk>
In article <·················@convex> ·······@convex.zdv.uni-tuebingen.de (D. Gerdemann) writes:
>In <············@early-bird.think.com> ······@think.com (Barry Margolin) writes:
>
>>Common Lisp doesn't have the primitives necessary to implement coroutines,
>>at least not if you want to use the built-in function calling mechanism to
>>invoke them.  You can do it in Scheme, as its continuations permit calling
>>back into an environment.
>
>Is there anywhere where it is described in more detail how to do this
>in Scheme?

It's described in a number of places, including (I think) in a paper
by Wand in the 1980 Lisp Conference.  In any case, here's some code I
wrote in 1982 or so that refers to "[Wand 80]".

Some of the procedures appear in several versions.  My guess is that
ones not called "old-X" are th eones to use.  Note too that it uses
catch instead of call/cc.  Sorry.

----------------------------------------------------------------------

;;; MPX Program from MB Scheme

;;; J. Dalton, AIAI, University of Edinburgh

(define (make-process name)
  ;; a process is an object that understands certain messages
  ;; there could be a message that calls the restart, but there isn't
  (let ((resumer 'no-resumer)		;process that last resumed this one
	(restart 'no-restart))		;state for restarting when resumed
    (lambda (ms . args)
      (cond ((eq? ms 'name) name)
	    ((eq? ms 'restart) restart)
	    ((eq? ms 'resumer) resumer)
	    ((eq? ms 'set-restart!) (set! restart (car args)))
	    ((eq? ms 'set-resumer!) (set! resumer (car args)))
	    (else (error "Unknown message for process" ms name))))))

(define (init-process! p fn . args)
  ;; set up process p for the 1st time it's resumed
  (p 'set-restart!
     (lambda (x)
       ;; value passed on 1st resume is ignored
       ;; instead call init fn with init args
       (set! *cp* *fcp*)		;/\/
       (let ((result (apply fn args)))
	 ;; fn might eventually return instead of calling resume
	 ;; then, yield the result and prevent further resumes
	 (resume-no-restart (*cp* 'resumer) result))))
  (p 'set-resumer! 'no-resumer)
  p)

(define (wand-init-process! p fn . args)
  ;; set-up process p for the 1st time it's resumed (see [Wand 80])
  (catch
   (lambda (caller)			;so we can get back
     (catch
      (lambda (process)			;1st resume will throw to this
	(p 'set-restart! process)
	(p 'set-resumer! 'no-resumer)
	(caller p)))			;return now to our caller
     ;; the 1st resume throw lands here
     (let ((result (apply fn args)))
       ;; function may just return rather than call resume
       ;; then, we yield the result and prevent further resumes
       (resume-no-restart (*cp* 'resumer) result)))))

(define *main* ())			;start here
(define *cp* ())			;current process
(define *fcp* ())			;future current process

(define (initmain)
  (set! *main* (make-process "main"))	;start with one active process
  (set! *cp* *main*))

(define (old-resume p x)
  ;; resume process p giving it value x
  (catch
   (lambda (return-state)
     (*cp* 'set-restart! return-state)	;remember how to restart c.p.
     (p 'set-resumer! *cp*)		;make it default for yield
     (set! *cp* p)			;switch to resumed process
     ((p 'restart) x))))		;and restart it

(define (resume p x)
  ;; resume process p giving it value x
  (let ((returned-value
	 (catch
	  (lambda (return-state)
	    (*cp* 'set-restart! return-state)	;remember how to restart c.p.
	    (p 'set-resumer! *cp*)		;make it default for yield
	    (set! *fcp* p)			;future current process
	    ((p 'restart) x)))))		;and restart resumed process
    ;; The process that called resume has now itself been resumed and has
    ;; a returned value.  It is now safe to make it the current process.
    (set! *cp* *fcp*)
    returned-value))

(define (old-resume-no-restart p x)
  ;; resume a process disallowing resume in return
  (*cp* 'set-restart! 'exhausted)
  (p 'set-resumer! *cp*)
  (set! *cp* p)
  ((p 'restart) x))

(define (resume-no-restart p x)
  ;; resume a process disallowing resume in return
  (*cp* 'set-restart! 'exhausted)
  (p 'set-resumer! *cp*)
  (set! *fcp* p)
  ((p 'restart) x))

;;; For generators, there is a somewhat simpler interface

(define (genext p) (resume p 'ignored))

(define (yield x)
  (resume (*cp* 'resumer) x)		;give generated value to caller
  x)					;and ignore what we get back

;;; Initialize system

(initmain)

----------------------------------------------------------------------

;;; MPX Examples from MB Scheme

;;; J. Dalton, AIAI, University of Edinburgh

;;; Some simple generators

(define (integers-from n)
  (yield n)
  (integers-from (1+ n)))

(define (genlist l)
  (cond ((not (pair? l)) (yield l))
	(else (yield (car l))
	      (genlist (cdr l)))))

;;; Samefringe -- Lisp Machine Manual, July 1981

(define (fringe tree endflag)
  (define (fringe1 tree)
    (cond ((not (pair? tree))
	   (yield tree))
	  (else (fringe1 (car tree))
		(if (pair? (cdr tree))
		    (fringe1 (cdr tree))))))
  (fringe1 tree)
  endflag)

(define (samefringe tree1 tree2)
  (let ((gen1 (make-process "samefringe1"))
	(gen2 (make-process "samefringe2"))
	(exhausted (cons () ())))
    (init-process! gen1 fringe tree1 exhausted)
    (init-process! gen2 fringe tree2 exhausted)
     (define (loop leaf1 leaf2)
       (cond ((not (eq? leaf1 leaf2)) #!false)
	     ((eq? leaf1 exhausted) #!true)
	     (else (loop (resume gen1 ()) (resume gen2 ())))))
     (loop (resume gen1 ()) (resume gen2 ()))))

 ----------------------------------------------------------------------

Jeff Dalton,                      JANET: ········@uk.ac.ed             
AI Applications Institute,        ARPA:  ········@ed.ac.uk
Edinburgh University.             UUCP:  ...!ukc!ed.ac.uk!J.Dalton
From: Erann Gat
Subject: Re: coroutines in lisp?
Date: 
Message-ID: <1992Mar17.223925.10386@elroy.jpl.nasa.gov>
In article <····@skye.ed.ac.uk> ····@aiai.ed.ac.uk (Jeff Dalton) writes:
>In article <·················@convex> ·······@convex.zdv.uni-tuebingen.de (D. Gerdemann) writes:
>>In <············@early-bird.think.com> ······@think.com (Barry Margolin) writes:
>>
>>>Common Lisp doesn't have the primitives necessary to implement coroutines,
>>>at least not if you want to use the built-in function calling mechanism to
>>>invoke them.  You can do it in Scheme, as its continuations permit calling
>>>back into an environment.
>>
>>Is there anywhere where it is described in more detail how to do this
>>in Scheme?
>
>It's described in a number of places, including (I think) in a paper
>by Wand in the 1980 Lisp Conference.  In any case, here's some code I
>wrote in 1982 or so that refers to "[Wand 80]".
>
>Some of the procedures appear in several versions.  My guess is that
>ones not called "old-X" are th eones to use.  Note too that it uses
>catch instead of call/cc.  Sorry.

[About 100 lines of code deleted]

Here's a simpler version written in T.  It's fairly straightforward
to convert to scheme.  The main difference is that T allows continuations
to take an arbitrary number of arguments (including 0) returning them as
multiple values to the continuation.  To convert to scheme you have to
put in some dummy arguments to give the continuations values (which then
get discarded).

;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  A demo of coroutines using call/cc.  This only works in T.
;;;

(define *process-queue* '())
(define call/cc call-with-current-continuation)
(call/cc (lambda (top-level) (define *top-level* top-level)))

(define-syntax (define-coroutine name&args . body)
  `(define ,name&args
     (call/cc run-coroutines)
     ,@body))

(define (run-coroutines . new-coroutines)
  (set *process-queue* (append *process-queue* new-coroutines))
  (if (null? *process-queue*)
    (*top-level*)
    (let ( (current-process (car *process-queue*)) )
      (set *process-queue* (cdr *process-queue*))
      (current-process)
      (run-coroutines))))

---
That's it!  About 10 lines of code.  Here's an example of how to use it:


(define-coroutine (process1 n)
  (format t "~&Entering process 1 with argument ~S~%" n)
  (if (zero? n)
    'value1
    (cons n (process1 (- n 1)))))

(define-coroutine (process2 n)
  (format t "~&Entering process 2 with argument ~S~%" n)
  (if (zero? n)
    'value2
    (cons n (process2 (- n 1)))))

(define (test)
  (run-coroutines
   (lambda () (format t "~&Instance 1 of process 1 returned ~S" (process1 5)))
   (lambda () (format t "~&Instance 2 of process 1 returned ~S" (process1 7)))
   (lambda () (format t "~&Process 2 returned ~S" (process2 6)))))

And a sample run:
> (test)

Entering process 1 with argument 5
Entering process 1 with argument 7
Entering process 2 with argument 6
Entering process 1 with argument 4
Entering process 1 with argument 6
Entering process 2 with argument 5
Entering process 1 with argument 3
Entering process 1 with argument 5
Entering process 2 with argument 4
Entering process 1 with argument 2
Entering process 1 with argument 4
Entering process 2 with argument 3
Entering process 1 with argument 1
Entering process 1 with argument 3
Entering process 2 with argument 2
Entering process 1 with argument 0
Instance 1 of process 1 returned (5 4 3 2 1 . VALUE1)
Entering process 1 with argument 2
Entering process 2 with argument 1
Entering process 1 with argument 1
Entering process 2 with argument 0
Process 2 returned (6 5 4 3 2 1 . VALUE2)
Entering process 1 with argument 0
Instance 2 of process 1 returned (7 6 5 4 3 2 1 . VALUE1)
;no value
>

---
Erann Gat
···@robotics.jpl.nasa.gov