1.17.2 Examples

Assume there is a type ‘length’ representing physical length; the type has an accessor procedure meters returning the length in meters (a real number):

(define-record-type length
  (fields (immutable meters     meters)))

A compare procedure for lengths can then be defined in terms of real-compare as:

(define (length-compare length1 length2)
  (real-compare (meters length1) (meters length2)))

now:

(<? length-compare x y)

tests if length x is shorter than length y. Also,

(<=/<? length-compare a x b)

tests if length x lies between length a (included) and length b (excluded). The expression:

(min-compare length-compare x y z)

is the shortest of the lengths x, y, and z. Likewise,

(chain<? length-compare x1 x2 x3 x4)

tests if the lengths x1, x2, x3, x3 are strictly increasing, and so on.

Furthermore, assume there is another type box representing a physical box; the type has procedures width, height, and depth accessing the dimension (each giving a length):

(define-record-type box
  (fields (immutable width      width)
          (immutable height     height)
          (immutable depth      depth)))

A comparison procedure for boxes, comparing first by width then by height and then by depth, can be defined using the control structure refine-compare as:

(define (box-compare box1 box2)
  (refine-compare
    (length-compare (width  box1) (width  box2))
    (length-compare (height box1) (height box2))
    (length-compare (depth  box1) (depth  box2))))

so:

(<? box-compare b1 b2)

tests if box b1 is smaller than box b2, in the sense of the order defined. Of course, all the other tests, minimum, maximum etc. are available, too.

As a final complication, assume that there is also a type bowl with accessors radius (a ‘length’) and open? (a boolean):

(define-record-type bowl
  (fields (immutable radius   radius)
          (immutable open?    open?)))

Bowls are to be compared first by whether they are open or closed, and then by radius. However, bowls and boxes also need to be compared to each other, ordered such that a bowl is considered “smaller” than a box. (There are type–test predicates box? and bowl?). Using the control structure select-compare this can be expressed as:

(define (container-compare c1 c2)
  (select-compare c1 c2
    (bowl? (boolean-compare (open?  c1) (open?  c2))
           (length-compare  (radius c1) (radius c2)))
    (box?  (box-compare c1 c2))
    (else "neither bowls nor boxes" c1 c2)))

This is an example of “hierarchical extension” of compare procedures. Also note the implicit use of refine-compare in the bowl? case.