;; Copyright Chris Vine 2014 and 2016

;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;; 
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;; 
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

(define-module (coroutines)
  #:use-module (event-loop) ;; for event-post!
  #:export (make-iterator
	    make-coroutine
	    a-sync
	    a-sync-run-task-in-thread))

;; this procedure takes a generator procedure, namely a procedure
;; which has a 'yield' parameter for its first or only argument,
;; followed by such other arguments (other than the one for the
;; 'yield' parameter) as the generator procedure requires, and
;; constructs an iterator from them.  When the iterator is invoked, it
;; will begin executing the procedure unless and until the argument
;; comprising the yield procedure is called, which will cause the
;; iterator to suspend computation and instead return the value passed
;; to yield (yield is a procedure taking no or one argument).  If
;; invoked again, the iterator will resume computation at the point
;; where it last left off (returning the value, if any, passed to the
;; iterator on resuming).  When the generator procedure has executed
;; to the end, the iterator returns 'stop-iteration.  This procedure
;; has some resemblance to call/ec, except that (i) instead of
;; executing the passed procedure immediately, it returns an iterator
;; which will do so, (ii) it is resumable, and (iii) the procedure to
;; be executed can receive starting arguments in addition to the
;; yield/break argument, to provide an alternative to binding them
;; with a lambda closure.  It is similar to ECMAScript generators and
;; python generators.
(define (make-iterator proc . args)
  (define tag (make-prompt-tag))
  (define send-back '())
  (define (thunk)
    (apply proc
	   (lambda* (#:optional val)
	     (abort-to-prompt tag val)
	     send-back)
	   args)
    ;; the generator procedure has returned - reset thunk to do
    ;; nothing except return 'stop-iteration and return
    ;; 'stop-iteration after this last call to proc
    (set! thunk (lambda () 'stop-iteration))
    'stop-iteration)
  (lambda* (#:optional send-arg)
    (set! send-back send-arg)
    (call-with-prompt tag
		      thunk
		      (lambda (cont ret)
			(set! thunk cont)
			ret))))

;; this procedure takes a generator procedure, namely a procedure
;; which has a 'yield' parameter for its first or only argument,
;; followed by such other arguments (other than the one for the
;; 'yield' parameter) as the generator procedure requires, and
;; constructs a coroutine.  It is similar to make-iterator, in that it
;; takes a generator procedure and returns a lambda object (a
;; coroutine) which when called will begin executing the generator
;; procedure unless and until the argument comprising the yield
;; procedure is called, which will cause computation to be suspended.
;; However unlike make-iterator, the resumption continuation generated
;; on yielding is returned by the coroutine when yielding rather than
;; being stored internally in an iterator, so there is no explicit
;; retained mutable state.  The return value of the coroutine
;; comprises two values: first the resumption continuation, and second
;; the value (if any) passed to 'yield' when called.  If the returned
;; resumption continuation is subsequently called again, computation
;; will be resumed at the point where it last left off (the yield
;; procedure returning the value, if any, passed to the continuation
;; on resuming) until it completes or it again calls the yield
;; procedure.
;;
;; Upon the generator procedure finally completing, the value to which
;; it evaluates is returned by the resumption continuation together
;; with a continuation value of #f.  This differs from the behaviour
;; of make-iterator, which returns 'stop-iteration when the generator
;; procedure finishes to completion and ignores its return value.
(define (make-coroutine proc . args)
  (define tag (make-prompt-tag))
  (define (abort-handler cont ret)
    (define* (resume #:optional arg)
      (call-with-prompt
       tag
       (lambda () (cont arg))
       abort-handler))
    (values resume ret))
  ;; 'arg' is ignored - it is provided only for consistency with the
  ;; interface of resume
  (lambda* (#:optional arg)
	   (call-with-prompt
	    tag
	    (lambda ()
	      (values #f
		      (apply proc
			     (lambda* (#:optional arg)
				      (abort-to-prompt tag arg))
			     args)))
	    abort-handler)))
     
;; a-sync takes a waitable procedure (namely a procedure which takes
;; 'await' as its first parameter, which is a yield procedure obtained
;; by a call to make-iterator, and 'resume' as its second parameter,
;; which is an iterator constructed by make-iterator), followed by
;; such other arguments (if any) as the waitable procedure requires to
;; be passed on to it.  The 'resume' argument must only be called by
;; an asynchronous callback, and the 'await' argument must only be
;; called by the waitable procedure in order to block until the
;; callback is ready to let it resume.  When it unblocks, the 'await'
;; argument returns the value (if any) passed to 'resume' by the
;; callback.  This async procedure must be called in the same thread
;; as that in which the event loop which will execute the callback
;; runs.
;;
;; There can be as many calls to 'await' and asynchronous callbacks in
;; any one waitable procedure as wanted, to enable composition of
;; asynchronous operations.  None of the code in the waitable
;; procedure should block on other things in the program, except by
;; calls to await (which do not in fact block, even though they appear
;; to do so).  async must be called in the thread in which the
;; callback will execute, namely the main loop thread.
;;
;; This can be used with any event loop, including the glib event loop
;; provided by guile-gnome and so with gtk+ callbacks, and with the
;; event loop in the event-loop module.
(define (a-sync waitable . args)
  (letrec ([resume (make-iterator (lambda (await)
				  (apply waitable await resume args)))])
    (resume)))

;; this is a convenience procedure for use with the event loop in the
;; event-loop module, which will run thunk in its own thread and then
;; post the result to the main loop specified by the loop argument,
;; where it then applies resume (obtained from a call to async) to
;; that result.  It is intended to be called in a waitable procedure.
;; It will normally be necessary to call event-loop-block! before
;; invoking this procedure.
(define (a-sync-run-task-in-thread thunk loop resume)
  (call-with-new-thread
   (lambda ()
     (let ([res (thunk)])
       (event-post! loop (lambda ()
			   (resume res)))))))