058-equal.scm (2016B)
1 ; (equal? a b) -- structural equality. Falls back to eq? for 2 ; fixnums/symbols/immediates/identical heap-or-pair pointers; recurses 3 ; into pair structure; compares strings and bytevectors within their own 4 ; disjoint types. Other 5 ; heap types (closures, prims, records, type descriptors) compare by 6 ; identity only. 7 8 ; eq? cases. 9 (if (equal? 1 1) 0 (sys-exit 1)) 10 (if (equal? 'foo 'foo) 0 (sys-exit 2)) 11 (if (equal? '() '()) 0 (sys-exit 3)) 12 (if (equal? #t #t) 0 (sys-exit 4)) 13 (if (not (equal? #t #f)) 0 (sys-exit 5)) 14 15 ; Tag mismatches -> #f. 16 (if (not (equal? 1 'foo)) 0 (sys-exit 6)) 17 (if (not (equal? '() '(1))) 0 (sys-exit 7)) 18 (if (not (equal? "abc" 'foo)) 0 (sys-exit 8)) 19 20 ; Pair recursion, distinct identities. 21 (define p (cons 1 (cons 2 (cons 3 '())))) 22 (define q (cons 1 (cons 2 (cons 3 '())))) 23 (if (equal? p q) 0 (sys-exit 9)) 24 25 ; Same head, different tail. 26 (define r (cons 1 (cons 2 (cons 4 '())))) 27 (if (not (equal? p r)) 0 (sys-exit 10)) 28 29 ; Length mismatch (cdr-shape diverges). 30 (define p2 (cons 1 (cons 2 '()))) 31 (if (not (equal? p p2)) 0 (sys-exit 11)) 32 33 ; Dotted pairs. 34 (if (equal? (cons 1 2) (cons 1 2)) 0 (sys-exit 12)) 35 (if (not (equal? (cons 1 2) (cons 1 3))) 0 (sys-exit 13)) 36 37 ; Strings compared structurally. 38 (if (equal? "abc" "abc") 0 (sys-exit 14)) 39 (if (not (equal? "abc" "abd")) 0 (sys-exit 15)) 40 (if (not (equal? "abc" "ab")) 0 (sys-exit 16)) 41 (if (equal? "" "") 0 (sys-exit 17)) 42 (if (not (equal? "abc" #u8(97 98 99))) 0 (sys-exit 22)) 43 (if (equal? #u8(97 98 99) #u8(97 98 99)) 0 (sys-exit 23)) 44 45 ; Nested: pair containing bytevector. 46 (define x (cons 'tag (cons "abc" '()))) 47 (define y (cons 'tag (cons "abc" '()))) 48 (if (equal? x y) 0 (sys-exit 18)) 49 50 (define z (cons 'tag (cons "abd" '()))) 51 (if (not (equal? x z)) 0 (sys-exit 19)) 52 53 ; Identity short-circuit on non-comparable heap types (closures, 54 ; primitives). Same prim-binding compares equal; different prims do 55 ; not. We don't recurse into closure structure. 56 (if (equal? car car) 0 (sys-exit 20)) 57 (if (not (equal? car cdr)) 0 (sys-exit 21)) 58 59 (sys-exit 0)