Next: , Previous: , Up: srfi err5rs records   [Index]

2.32.4 Examples

R6RS library section 6.3 includes two extended examples that provide a nice comparison of the R6RS and ERR5RS record systems, especially since these two examples were designed to highlight the use of R6RS record–constructor descriptors in combination with inheritance.

Example 1

Using ERR5RS records, the first example becomes: 

(define rtd1
  (make-rtd 'rtd1 '#((immutable x1) (immutable x2))))

(define rtd2
  (make-rtd 'rtd2 '#((immutable x3) (immutable x4)) rtd1))

(define rtd3
  (make-rtd 'rtd3 '#((immutable x5) (immutable x6)) rtd2))

(define protocol1
  (lambda (p)
    (lambda (a b c)
      (p (+ a b) (+ b c)))))

(define protocol2
  (lambda (n)
    (lambda (a b c d e f)
      (let ((p (n a b c)))
        (p (+ d e) (+ e f))))))

(define protocol3
  (lambda (n)
    (lambda (a b c d e f g h i)
      (let ((p (n a b c d e f)))
        (p (+ g h) (+ h i))))))

(define make-rtd1
  (protocol1 (rtd-constructor rtd1)))

(define make-rtd2
  (let ((maker2 (rtd-constructor rtd2)))
    (protocol2
     (protocol1
      (lambda (x1 x2)
        (lambda (x3 x4)
          (maker2 x1 x2 x3 x4)))))))

(define make-rtd3
  (let ((maker3 (rtd-constructor rtd3)))
    (protocol3
     (protocol2
      (protocol1
       (lambda (x1 x2)
         (lambda (x3 x4)
           (lambda (x5 x6)
             (maker3 x1 x2 x3 x4 x5 x6)))))))))

(make-rtd3 1 2 3 4 5 6 7 8 9)

; evaluates to a record whose fields contain
; 3 5 9 11 15 17

The purpose of the R6RS record–constructor descriptors is to automate the idiom shown in the definitions of make-rtd1, make-rtd2, and make-rtd3 above, and to provide an alternative to procedural abstraction when eliminating the duplication of code seen in make-point/abs and make-cpoint/abs below.

Example 2

The second example illustrates the shadowing of fields in a parent record–type by fields in a derived record–type. Using ERR5RS records, the second example becomes: 

(define :point
  (make-rtd 'point '#((mutable x) (mutable y))))

(define make-point (rtd-constructor :point))

(define point? (rtd-predicate :point))
(define point-x (rtd-accessor :point 'x))
(define point-y (rtd-accessor :point 'y))
(define point-x-set! (rtd-mutator :point 'x))
(define point-y-set! (rtd-mutator :point 'y))

(define p1 (make-point 1 2))
(point? p1)                     ⇒ #t
(point-x p1)                    ⇒ 1
(point-y p1)                    ⇒ 2
(point-x-set! p1 5)
(point-x p1)                    ⇒ 5

(define :point2
  (make-rtd 'point2 '#((mutable x) (mutable y)) :point))

(define make-point2
  (rtd-constructor :point2))
(define point2? (rtd-predicate :point2))
(define point2-xx (rtd-accessor :point2 'x))
(define point2-yy (rtd-accessor :point2 'y))

(define p2 (make-point2 1 2 3 4))
(point? p2)                     ⇒ #t
(point-x p2)                    ⇒ 1
(point-y p2)                    ⇒ 2
(point2-xx p2)                  ⇒ 3
(point2-yy p2)                  ⇒ 4

(define make-point/abs
  (let ((maker (rtd-constructor :point)))
    (lambda (x y)
      (maker (abs x) (abs y)))))

(point-x (make-point/abs -1 -2)) ⇒ 1
(point-y (make-point/abs -1 -2)) ⇒ 2

(define :cpoint
  (make-rtd 'cpoint '#((mutable rgb)) :point))

(define make-cpoint
  (let ((maker (rtd-constructor :cpoint)))
    (lambda (x y c)
      (maker x y (color->rgb c)))))

(define make-cpoint/abs
  (let ((maker (rtd-constructor :cpoint)))
    (lambda (x y c)
      (maker (abs x) (abs y) (color->rgb c)))))

(define cpoint-rgb
  (rtd-accessor :cpoint 'rgb))

(define (color->rgb c)
  (cons 'rgb c))

(cpoint-rgb (make-cpoint -1 -3 'red))   ⇒ (rgb . red)
(point-x (make-cpoint -1 -3 'red))      ⇒ -1
(point-x (make-cpoint/abs -1 -3 'red))  ⇒ 1

Next: , Previous: , Up: srfi err5rs records   [Index]