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
arithmetic^{8} -- 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