059-record-equal.scm (1586B)
1 ; equal? on records is structural: same TD (by identity) plus 2 ; field-by-field equal?. Different TDs are never equal even if their 3 ; shapes happen to match. Field comparison recurses through the same 4 ; equal? machinery, so nested records / pairs / bytevectors all work. 5 6 (define-record-type point 7 (make-point x y) 8 point? 9 (x point-x) 10 (y point-y)) 11 12 (define-record-type box 13 (make-box v) 14 box? 15 (v box-v)) 16 17 ; Distinct allocations, same TD, same fields -> equal. 18 (define p1 (make-point 3 4)) 19 (define p2 (make-point 3 4)) 20 (if (equal? p1 p2) 0 (sys-exit 1)) 21 22 ; eq? still distinguishes them. 23 (if (not (eq? p1 p2)) 0 (sys-exit 2)) 24 25 ; Same TD, differing field -> not equal. 26 (define p3 (make-point 3 5)) 27 (if (not (equal? p1 p3)) 0 (sys-exit 3)) 28 29 ; Different TDs but same arity / values -> not equal. 30 (define b (make-box 3)) 31 (if (not (equal? b (make-point 3 0))) 0 (sys-exit 4)) 32 33 ; Self -> equal (eq? short-circuit covers this). 34 (if (equal? p1 p1) 0 (sys-exit 5)) 35 36 ; Records nested in pairs. 37 (if (equal? (cons p1 '()) (cons p2 '())) 0 (sys-exit 6)) 38 (if (not (equal? (cons p1 '()) (cons p3 '()))) 0 (sys-exit 7)) 39 40 ; Records carrying bytevector fields are compared structurally. 41 (define s1 (make-box "abc")) 42 (define s2 (make-box "abc")) 43 (define s3 (make-box "abd")) 44 (if (equal? s1 s2) 0 (sys-exit 8)) 45 (if (not (equal? s1 s3)) 0 (sys-exit 9)) 46 47 ; Records nested inside records. 48 (define wrapped1 (make-box p1)) 49 (define wrapped2 (make-box p2)) 50 (define wrapped3 (make-box p3)) 51 (if (equal? wrapped1 wrapped2) 0 (sys-exit 10)) 52 (if (not (equal? wrapped1 wrapped3)) 0 (sys-exit 11)) 53 54 (sys-exit 0)