experiments/bidi-generator.ss
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Tue, 06 Apr 2010 08:11:57 +1200
changeset 283 94f780251884
permissions -rw-r--r--
Bidirectional generator for MzScheme.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
283
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     1
#lang scheme
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     2
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     3
(provide yield generator)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     4
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     5
(define current-yielder
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     6
  (make-parameter
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     7
   (lambda (v)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     8
     (error 'yield "must be called in the context of a generator"))))
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     9
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    10
(define (yield . vals)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    11
  (apply (current-yielder) vals))
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    12
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    13
(define-syntax-rule (generator init-formals body0 body ...)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    14
  (letrec ((yielder (lambda vals
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    15
                      (call-with-current-continuation
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    16
                         (lambda (new-inner-k)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    17
                           (set! inner-k new-inner-k)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    18
                           (apply outer-k vals)))))
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    19
           (outer-k #f)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    20
           (inner-k (lambda init-formals
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    21
                      (call-with-values
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    22
                       (lambda ()
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    23
                         (parameterize ((current-yielder yielder))
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    24
                           body0 body ...))
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    25
                       (lambda results
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    26
                         (set! inner-k (lambda ignored (error "Generator is terminated")))
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    27
                         (apply outer-k results))))))
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    28
    (lambda args
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    29
      (call-with-current-continuation
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    30
       (lambda (new-outer-k)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    31
         (set! outer-k new-outer-k)
94f780251884 Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    32
         (apply inner-k args))))))