Prev Up Next
In order to generalize the code above to accommodate
the nestable type of engine, we need to incorporate
into it some tick management that will take
care of the apportioning of the right amounts of ticks
all the engines in a nested run.
To run a new engine (the child), we need to
stop the currently engine (the parent). We
then need to assign an appropriate number of ticks to
the child. This may not be the same as the ticks
assigned by the program text, because it would be unfair for a child to consume more ticks than its
parent has left. After the child completes, we need to
update the parent's ticks. If the child finished in
time, any leftover ticks it has revert to the parent.
If ticks were denied from the child because the parent
couldn't afford it, then if the child fails, the parent
will fail too, but must remember to restart the child
with its promised ticks when it (the parent) restarts.
We also need to fluid-let the globals
*engine-escape* and *engine-entrance*, because
each nested engine must have its own pair of these
sentinel continuations. As an engine exits (whether
through success or failure), the fluid-let will
ensure that the next enclosing engine's sentinels take
over.
Combining all this, the code for nestable engines looks
as follows:
(define make-engine
(lambda (th)
(lambda (ticks s f)
(let* ((parent-ticks
(clock 'set *infinity*))
;A child can't have more ticks than its parent's
;remaining ticks
(child-available-ticks
(clock-min parent-ticks ticks))
;A child's ticks must be counted against the parent
;too
(parent-ticks-left
(clock-minus parent-ticks child-available-ticks))
;If child was promised more ticks than parent could
;afford, remember how much it was short-changed by
(child-ticks-left
(clock-minus ticks child-available-ticks))
;Used below to store ticks left in clock
;if child completes in time
(ticks-left 0)
(engine-succeeded? #f)
(result
(fluid-let ((*engine-escape* #f)
(*engine-entrance* #f))
(call/cc
(lambda (k)
(set! *engine-escape* k)
(let ((result
(call/cc
(lambda (k)
(set! *engine-entrance* k)
(clock 'set child-available-ticks)
(let ((v (th)))
(*engine-entrance* v))))))
(set! ticks-left
(let ((n (clock 'set *infinity*)))
(if (eqv? n *infinity*) 0 n)))
(set! engine-succeeded? #t)
result))))))
;Parent can reclaim ticks that child didn't need
(set! parent-ticks-left
(clock-plus parent-ticks-left ticks-left))
;This is the true ticks that child has left --
;we include the ticks it was short-changed by
(set! ticks-left
(clock-plus child-ticks-left ticks-left))
;Restart parent with its remaining ticks
(clock 'set parent-ticks-left)
;The rest is now parent computation
(cond
;Child finished in time -- celebrate its success
(engine-succeeded? (s result ticks-left))
;Child failed because it ran out of promised time --
;call failure procedure
((= ticks-left 0)
(f (make-engine (lambda () (result 'resume)))))
;Child failed because parent didn't have enough time,
;ie, parent failed too. If so, when parent is
;resumed, its first order of duty is to resume the
;child with its fair amount of ticks
(else
((make-engine (lambda () (result 'resume)))
ticks-left s f)))))))
Note that we have used the arithmetic operators
clock-min, clock-minus, and clock-plus
instead of min, -, and +. This is because
the values used by the clock arithmetic includes
*infinity* in addition to the integers. Some Scheme
dialects provide an *infinity* value in their
arithmetic8 -- if so, you can use the regular
arithmetic operators. If not, it is an easy exercise
to define the enhanced operators.
8 Eg, in Guile, you can (define
*infinity* (/ 1 0)).
Prev Up Next