saito's memo

(define-condition-type <stop-iteration> <condition> #f
  )

(define (make-generator proc)
  (let* ((next #f)
       (break #f)
       (yield (lambda arg (call/cc (lambda (cc) (set! next cc) (apply break arg)))))
       (result (lambda () (call/cc (lambda (cc) (set! break cc) (next)))))
       )
    (call/cc
     (lambda (return)
       (call/cc (lambda (cc) (set! next cc) (return result)))
       (proc yield)
       (call/cc (lambda (cc) (set! next cc)))
       (error <stop-iteration>)
       ))
    ))

(define (new-fib)
  (make-generator
   (lambda (yield)
     (let loop ((a 0) (b 1))
       (yield a)
       (loop b (+ a b))))))
(let ((f (new-fib)))
  (dotimes (i 10) (print (f))))

(define-module macro-utilities
  (export with-gensyms
        once-only
        aif
        awhen
        ))
(select-module macro-utilities)

(define-macro (with-gensyms syms . body)
  `(let ,(map (lambda (s) `(,s (gensym ,(string-append (x->string s) "-")))) syms)
     ,@body)
  )

(define-macro (once-only names . body)
  (let ((gensyms (map (lambda (n) (gensym (x->string n))) names)))
    (list 'let (map (lambda (g) `(,g (gensym))) gensyms)
        (list 'quasiquote
                `(let ,(map (lambda (g n) (list (list 'unquote g) (list 'unquote n))) gensyms names)
                   ,(list 'unquote `(let ,(map (lambda (n g) (list n g)) names gensyms) ,@body))
                   )))
    ))

(define-macro (aif test then . rest)
  (let-optionals* rest ((else (if #f #f)))
  `(let ((it ,test))
     (if it ,then ,else)))
  )

(define-macro (awhen test . body)
  `(let ((it ,test)) (when it . ,body))
  )

(provide "macro-utilities")