(require scheme/control)
(require srfi/41)

(display (reset
          (display 1)
          (display 2)
          (shift k 3)
          (display 4)))

>123

(stream->;list (reset
               (shift k (stream-cons 1 (k (void))))
               (shift k (stream-cons 2 (k (void))))
               (shift k (stream-cons 3 (k (void))))
               stream-null))

>(1 2 3)

(define-syntax define-generator
  (syntax-rules ()
    ((_ (name args ...) body ...)
     (define (name args ...)
       (reset body ... stream-null)))))

(define (yield value)
  (shift k (stream-cons value (k (void)))))

(define-generator (make-123)
  (yield 1)
  (yield 2)
  (yield 3))

(stream->;list (make-123))

>(1 2 3)

(define (yield-splice stream)
  (shift k (stream-append stream (k (void)))))

(define-generator (make-0-4)
  (yield 0)
  (yield-splice (make-123))
  (yield 4))

(stream->;list (make-0-4))

>(0 1 2 3 4)

def fib(n):
    a, b = 1, 1
    for i in range(n):
        yield a
        a, b = b, a + b
        
for i in fib(10):
    print i

FR>def fib(n):
FR>    a, b = 1, 1
FR>    for i in range(n):
FR>        yield a
FR>        a, b = b, a + b
        
FR>for i in fib(10):
FR>    print i
FR>

(define-generator (fib)
  (let fib/iter ((curr 1)
                      (next 1))
    (yield curr)
    (fib/iter next (+ curr next))))

FR>def fib(n):
FR>    a, b = 1, 1
FR>    for i in range(n):
FR>        yield a
FR>        a, b = b, a + b
        
FR>for i in fib(10):
FR>    print i

FR>

def counter (maximum):
    i = 0
    while i < maximum:
        val = (yield i)
        # If value provided, change counter
        if val is not None:
            i = val
        else:
            i += 1

>>> it = counter(10)
>>> print it.next()
0
>>> print it.next()
1
>>> print it.send(8)
8
>>> print it.next()
9
>>> print it.next()
Traceback (most recent call last):
  File "t.py", line 15, in ?
    print it.next()
StopIteration

>; (require scheme/control)
>; (require srfi/41)
>;

reference to undefined identifier: require

 (stream->;list (fib))

 (stream->;list 10 (fib))

(define (bubblesort pred arglist)
    (define (cmppr pr al) (and (pair? al) (pair? (cdr al)) (pr (car al) (cadr al))))
    (define (iter pr al)
        (let ((forw (if (pair? al) (cons (car al) (iter pr (cdr al)) ))))
            (if (cmppr pr forw) 
                (let ((swapped (cons (cadr forw) (cons (car forw) (cddr forw)))))
                   (let ((backw (iter pr (cdr swapped)) ))
                       (iter pr (cons (car swapped) backw))
                   )
                ) 
                forw
            )
        )
    )
    (iter pred arglist)
)

(bubblesort < (list 7 1 4 2 9))

(require mzlib/defmacro)

(defmacro generator ()
  `(define (_generator)
     (call/cc _control-state)))

(defmacro start-generator ( end-value . code )
  `(define (_control-state _return)
     ,@code (_return ,end-value)))

(defmacro end-generator ()
  '_generator)

(defmacro yeild (value)
  `(set! _return
         (call/cc (lambda (_resume-here)
                    (set! _control-state _resume-here)
                    (_return ,value)))))

(defmacro make-generator-fast (input finish . code)
  `((lambda (,input)
      (generator)
      (start-generator ,finish ,@code)
      (end-generator)) ,input))

(require scheme/control)

(define-syntax stateful-lambda
  (syntax-rules ()    
    ((_ yield fin args body ...)
     ;;В state мы будем хранить континуацию, если функция уже вызывалась
     ;;и была прервана йилдом и #f в противном случае.
     
     ;;Функцию yield будет на этот раз для каждой лямбды своя, поскольку
     ;;она должна иметь доступ к специфичному для каждой лямбды state

     ;;При таком раскладе гигиеничность системы макросов заставляет нас
     ;;явно передавать в макрос имя, которое будет использоваться для yield
     ;;в качестве параметра.
     (let* ((state #f)
            (yield (lambda v (shift k (begin (set! state k)
                                             (apply values v))))))
       (lambda args1
         ;;Если в состоянии лежит захваченная ранее шифтом континуация -
         ;;мы просто ее вызовем
         (if state
             (apply state (if (= (length args1) 0)
                              (list (void))
                              args1))
             ;;При первом же вызове лямбды-с-состоянием мы просто начнем выполнять
             ;;ее тело.

             ;;При выходе из лямбды-с-состоянием не посредством yield, мы обнулим ее
             ;;состояние и при этом возвратим специальное значение fin, которое мы
             ;;также указали при объявлении лямбды.
             (apply (lambda args (reset body ...
                                        (set! state #f)
                                        fin)) args1)))))))

(define (list-walker l)
  (let ((head (drop-right l 1))
        (tail (last l)))
    (stateful-lambda yield tail ()                   
                     (for-each yield head))))

(define-syntax fsm-lambda
  (syntax-rules (->;)
    ;;При создании автомата будем задавать начальное состояние и конечное.
    
    ;;С начальным все понятно. Конечное мы выделяем затем, чтобы бросать
    ;;искючение всегда, когда в это состояние приходит сообщение
    ((_ start fin
        ;;Правила перехода будем задавать в виде
        ;;(состояние сообщение -> (новое-состояние . возвращаемое-значение))
        ;;Понятное дело, что после стрелки не обязательно должна стоять
        ;;непосредственно пара, достаточно возвращающего ее выражения
        (from message ->; to) ...)
     (stateful-lambda yield final (message1)
                      (let iter ((state start)
                                 (message2 message1))
                        (let ((result
                               (match (cons state message2)
                                      ((cons fin _) (error 'fin))
                                      ((cons from message) to) ...)))
                          (iter (car result) (yield (cdr result)))))))))

(define counter
  (fsm-lambda 0 'foo
              (value 'restart ->; (cons 0 0))
              (value increment ->; (let ((newvalue (+ value increment)))
                                    (cons newvalue newvalue)))))

> (counter 1)
1
> (counter 1)
2
> (counter 1)
3
> (counter 1)
4
> (counter 1)
5
> (counter 'restart)
0
> (counter 1)
1
> (counter 1)
2