Changeset 29412 in project


Ignore:
Timestamp:
07/25/13 13:53:34 (6 years ago)
Author:
juergen
Message:

continuations version 1.2 with an extra module

File:
1 edited

Legend:

Unmodified
Added
Removed
  • wiki/eggref/4/continuations

    r29408 r29412  
    44== continuations
    55
    6 This module provides some syntactic sugar to Marc Feeley's continuation
     6This library contains two modules, continuations and continuations-used.
     7
     8The former provides some syntactic sugar to Marc Feeley's continuation
    79interface. In this interface, continuations are a datatype separate from
    810procedures. Hence it provides a continuation? predicate. I've stripped
     
    2830dangerous, is sometimes useful, e.g. in backtracking ....
    2931 
    30 === The routines
     32The second module, continuations-used, provides some applications of the
     33continuations module.
     34
     35=== The routines of the continuations module
    3136
    3237==== continuations
     
    108113The infamous goto, but with a continuation as argument instead of a label.
    109114
     115=== The routines of the continuations-used module
     116
     117==== continuations-used
     118
     119<procedure>(continuations-used [sym])</procedure>
     120
     121the usual documentation procedure
     122
     123==== make-amb
     124
     125<procedure>(make-amb)</procedure>
     126
     127produces an ambiguous choice object, which accepts three messages,
     128'choose, 'fail and 'assert.
     129
     130==== make-threads
     131
     132<procedure>(make-threads)</procedure>
     133
     134produces a threads object, which accepts five messages,
     135'halt, 'quit, 'spawn, 'yield and 'start, implementing cooperative
     136threads.
     137
     138==== iterate
     139
     140<macro>(iterate var iterator xpr . xprs)</macro>
     141
     142iterates var over iterater and applies the body, xpr . xprs, to each
     143item. iterator should be a curried procedure of a container and a yield
     144routine, the latter supplying one value at each pass.
     145
    110146=== Examples
    111147
     
    113149
    114150<enscript highlight=scheme>
    115 ;; multiple operators sharing common state
    116 (define-values (amb-fail amb-choose amb-assert)
    117   (let ((amb-stack '()))
    118     (values
    119       (lambda ()
    120         (if (pair? amb-stack)
    121           (let ((back-track-point (car amb-stack)))
    122             (set! amb-stack (cdr amb-stack))
    123             (goto back-track-point))
    124           (error 'amb-fail "amb-stack exhausted")))
    125       (lambda choices
    126         (let ((cc (continuation)))
    127           (cond
    128             ((null? choices)
    129              (amb-fail))
    130             ((pair? choices)
    131              (let ((choice (car choices)))
    132                (set! choices (cdr choices))
    133                (set! amb-stack (cons cc amb-stack))
    134                choice)))))
    135       (lambda (xpr)
    136         (if (not xpr)
    137           (amb-fail)
    138           #t))
    139       )))
     151(require-library continuations)
     152(import continuations continuations-used)
     153
     154(define amb (make-amb))
    140155
    141156(define (pythagoras . choices)
    142   (let ((a (apply amb-choose choices))
    143         (b (apply amb-choose choices))
    144         (c (apply amb-choose choices)))
    145     (amb-assert (= (* c c) (+ (* a a) (* b b))))
    146     (amb-assert (< b a))
     157  (let ((a (apply (amb 'choose) choices))
     158        (b (apply (amb 'choose) choices))
     159        (c (apply (amb 'choose) choices)))
     160    ((amb 'assert) (= (* c c) (+ (* a a) (* b b))))
     161    ((amb 'assert) (< b a))
    147162    (list a b c)))
    148163
     
    150165</enscript>
    151166
     167==== cooperative threads
     168
     169<enscript highlight=scheme>
     170(require-library continuations)
     171(import continuations continuations-used)
     172
     173(define threads (make-threads))
     174
     175(define make-thunk
     176        (let ((counter 10))
     177                (lambda (name)
     178                        (rec (loop)
     179                                (if (< counter 0)
     180                                        ((threads 'quit)))
     181                                (print (cons name counter))
     182                                (set! counter (- counter 1))
     183                                ((threads 'yield))
     184                                (loop)))))
     185
     186((threads 'spawn) (make-thunk 'a))
     187((threads 'spawn) (make-thunk 'aa))
     188((threads 'spawn) (make-thunk 'aaa))
     189((threads 'start))
     190
     191; prints (a . 10) (aa . 9) (aaa . 8) (a . 7) (aa . 6) (aaa . 5)
     192;        (a . 4) (aa .  3) (aaa . 2) (a . 1) (aa . 0)
     193; in sequence
     194</enscript>
     195
    152196==== iterators
    153197
    154198<enscript highlight=scheme>
    155 (define-syntax iterate
    156   (syntax-rules ()
    157     ((_ var iterator xpr . xprs)
    158      (let ((it iterator) (it-cont #f))
    159        (let loop ()
    160          (let ((cc (continuation)))
    161            (if (continuation? cc)
    162              ;; first let-pass
    163              (if (continuation? it-cont)
    164                (throw it-cont (void))
    165                (it (lambda (val)
    166                    (catch next-cc
    167                      (throw cc (cons next-cc val))))))
    168              ;; second let-pass (cc is now pair)
    169              (let ((next-cont (car cc))
    170                    (next-val (cdr cc)))
    171                (set! it-cont next-cont)
    172                (let ((var next-val)) xpr . xprs)
    173                (loop)))))))))
     199(require-library continuations)
     200(import continuations continuations-used)
    174201
    175202;; define an iterator for tree, i.e. a function of yield, which returns
     
    187214</enscript>
    188215
    189 ==== cooperative threads
    190 
    191 <enscript highlight=scheme>
    192 ;; multiple operators sharing common state
    193 (define-values
    194   (threads-halt threads-spawn threads-yield threads-quit threads-start)
    195   (let ((threads-queue '()))
    196     (values
    197       #f
    198       (lambda (thunk)
    199         (let ((cc (continuation)))
    200           (if (continuation? cc)
    201             (set! threads-queue
    202                   (append threads-queue (list cc)))
    203             (begin (thunk) (threads-quit)))))
    204       (lambda ()
    205         (let ((cc (continuation)))
    206           (if (and (continuation? cc) (pair? threads-queue))
    207             (let ((next-thread (car threads-queue)))
    208               (set! threads-queue
    209                     (append (cdr threads-queue) (list cc)))
    210               (throw next-thread 'resume)))))
    211       (lambda ()
    212         (if (pair? threads-queue)
    213           (let ((next-thread (car threads-queue)))
    214             (set! threads-queue (cdr threads-queue))
    215             (throw next-thread 'resume))
    216           (threads-halt)))
    217       (lambda ()
    218         (let ((cc (continuation)))
    219           (when cc;(continuation? cc)
    220             (set! threads-halt (lambda () (throw cc #f)))
    221             (if (not (null? threads-queue))
    222               (let ((next-thread (car threads-queue)))
    223                 (set! threads-queue (cdr threads-queue))
    224                 (throw next-thread 'resume))))))
    225       )))
    226 
    227 (define counter 10)
    228 (define (make-thunk name)
    229   (rec (loop)
    230     (if (< counter 0)
    231       (threads-quit))
    232     (print "in thread " name " with counter = " counter)
    233     (set! counter (- counter 1))
    234     (threads-yield)
    235     (loop)))
    236 
    237 (threads-spawn (make-thunk 'a))
    238 (threads-spawn (make-thunk 'aa))
    239 (threads-spawn (make-thunk 'aaa))
    240 
    241 (threads-start)
    242 ;-> prints
    243 ;in thread a with counter = 10
    244 ;in thread aa with counter = 9
    245 ;in thread aaa with counter = 8
    246 ;in thread a with counter = 7
    247 ;in thread aa with counter = 6
    248 ;in thread aaa with counter = 5
    249 ;in thread a with counter = 4
    250 ;in thread aa with counter = 3
    251 ;in thread aaa with counter = 2
    252 ;in thread a with counter = 1
    253 ;in thread a with counter = 0
    254 
    255 </enscript>
    256 
    257216== Requirements
    258217
     
    261220== Last update
    262221
    263 Jul 24, 2013
     222Jul 25, 2013
    264223
    265224== Author
     
    300259== Version History
    301260
     261; 1.2 : some tests rewritten and repackeged as an extra module continuations-used
    302262; 1.1.2 : test cases for iterators and cooperative threads added
    303263; 1.1.1 : bug fix in documentation procedure
Note: See TracChangeset for help on using the changeset viewer.