; By Toon Verwaest
; 
; This file schemifies the Composability example at:
; http://codespeak.net/pypy/dist/pypy/doc/stackless.html
;
; This file requires SchemeTalk
; http://smallwiki.unibe.ch/schemetalk
(require schemetalk)

; Convenience syntax. Making it look a bit more like python :)

; range always starts at 0 goes to n
; and binds values for behaviour to i.
(define-syntax-rule (range (i n) behaviour ...)
    (let loop ((i 0))
        (when (< i n)
            behaviour ...
            (loop (+ i 1)))))

; For x in y behaviour ...
; in the behaviour the current value
; is bound to x. Values are generated by y
; by calling "'next" on y. A valid result == '(result)
; '() signals y is out of values.
(define-syntax-rule (for x in generator behaviour ...)
    (let ((gen generator))
        (let loop ((value (gen 'next)))
            (when (not (null? value))
                (let ((x (car value)))
                    behaviour ...
                    (loop (gen 'next)))))))


(define worldview-class
  (new-class WorldView object-class (current) ()
             ((initialize ()
                          (let ((current (coroutine-class 'basic-new)))
                            (current 'set-future! (lambda args args))
                            (current 'set-view! self)
                            (self 'set-current! current)
                            self))
              (current ()
                       (self 'get-current))
              (new-coro args
                        (apply coroutine-class `(new ,self ,@args)))
              (new-coro-with-class (cls . args)
                        (apply cls `(new ,self ,@args))))
  ()))
                          
             
; The coroutine class.
; This class keeps track of the current running coroutine
; and spawns coroutines which are objects with a link to their future.
;
; Coroutines are initialized by passing behaviour and arguments to them which
; needs to be executed during their lifetime. This behaviour is not directly
; executed with the passed arguments, but rather delayed until somebody switches
; to the coroutine for the first time.
;
; Coroutines can be continued by sending 'switch with some arguments to them.
; The arguments to 'switch! are
;    - passed in combination with the initial arguments to the call of the
;      behaviour passed at coroutine initialization,
;    - or returned from the place where the coroutine called 'switch! on
;      another routine.
(define coroutine-class
  (new-class Coroutine object-class (future view) ()
             ((initialize (view behaviour . init-args)
                          (self 'set-view! view)
                          (let ((startup-behaviour 
                                 (lambda args
                                   (apply behaviour (append init-args args))
                                   )))
                                (call/ec (lambda (return)
                                           (let ((switch-args
                                                  (call/cc (lambda (future)
                                                             (self 'set-future! future)
                                                             (return self)))))
                                             (apply startup-behaviour switch-args))))))
              (switch! args
                       (call/cc (lambda (future)
                                  (let ((view (self 'get-view)))
                                    ((view 'current) 'set-future! future)
                                    (view 'set-current! self)
                                    ((self 'get-future) args))))))
             ; We could replace this method at runtime by a non-checking one, but
             ; we are too lazy ;)
             ()))

(define default-view (worldview-class 'new))

(define *data* '())

; Fix to the original python code: always pass the consumer to the producer
; so that he knows where to return to.
(define (data-producer consumer)
    (range (i 10)
      (set! *data* (append *data* (list i (* i 5) (* i 25))))
      (set! consumer (car (consumer 'switch!)))))

(define producer-coro (default-view 'new-coro data-producer))

(define (grab-next-value)
  (when (empty? *data*)
    ; When we come back we come back to whatever called us.
    (producer-coro 'switch! (default-view 'current)))
  (let ((current (car *data*)))
    (set! *data* (cdr *data*))
    current))

(newline) (display "Grab next value:") (newline)
(range (i 10)
    (display (grab-next-value)) (newline))

(define generator-iterator-class
    (new-class GeneratorIterator coroutine-class (caller) ()
        ((next ()
            (self 'set-caller! (default-view 'current))
            (self 'switch!)))
        ()))

(define (generator behaviour)
    (lambda init-args
      (apply default-view `(new-coro-with-class ,generator-iterator-class ,behaviour ,@init-args))))

(define (Yield value)
    (((default-view 'current) 'get-caller) 'switch! value))

(define (squares n)
    (range (i n)
        (Yield (* i i))))

(define squares (generator squares))

(newline) (display "Generator:") (newline)
(for value in (squares 5)
    (display value) (newline))

(define (grab-values n)
    (range (i n)
        (Yield (grab-next-value))))

(define grab-values (generator grab-values))

(newline) (display "Combined:") (newline)
(for value in (grab-values 10)
    (display value) (newline))


; Another example.
(define A (default-view 'new-coro
    (lambda (a)
        (display a) (newline)
        (display (B 'switch! 20)) (newline))))

(define B (default-view 'new-coro
    (lambda (b)
        (display b) (newline)
        (display (A 'switch! 10)) (newline))))

(newline)
(display "Finishing routine:") (newline)
(A 'switch! 5)
(display "Finished") (newline)