Teach Yourself Scheme: 15.3 Nestable engines

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⁸ -- if so, you can use the regular arithmetic operators. If not, it is an easy exercise to define the enhanced operators.

⁸ Eg, in Guile, you can (define *infinity* (/ 1 0)).

Prev Up Next