058-equal.scm (1881B)
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; uses bytevector=? for bytevector contents. Other 4 ; heap types (closures, prims, records, type descriptors) compare by 5 ; identity only. 6 7 ; eq? cases. 8 (if (equal? 1 1) 0 (sys-exit 1)) 9 (if (equal? 'foo 'foo) 0 (sys-exit 2)) 10 (if (equal? '() '()) 0 (sys-exit 3)) 11 (if (equal? #t #t) 0 (sys-exit 4)) 12 (if (not (equal? #t #f)) 0 (sys-exit 5)) 13 14 ; Tag mismatches -> #f. 15 (if (not (equal? 1 'foo)) 0 (sys-exit 6)) 16 (if (not (equal? '() '(1))) 0 (sys-exit 7)) 17 (if (not (equal? "abc" 'foo)) 0 (sys-exit 8)) 18 19 ; Pair recursion, distinct identities. 20 (define p (cons 1 (cons 2 (cons 3 '())))) 21 (define q (cons 1 (cons 2 (cons 3 '())))) 22 (if (equal? p q) 0 (sys-exit 9)) 23 24 ; Same head, different tail. 25 (define r (cons 1 (cons 2 (cons 4 '())))) 26 (if (not (equal? p r)) 0 (sys-exit 10)) 27 28 ; Length mismatch (cdr-shape diverges). 29 (define p2 (cons 1 (cons 2 '()))) 30 (if (not (equal? p p2)) 0 (sys-exit 11)) 31 32 ; Dotted pairs. 33 (if (equal? (cons 1 2) (cons 1 2)) 0 (sys-exit 12)) 34 (if (not (equal? (cons 1 2) (cons 1 3))) 0 (sys-exit 13)) 35 36 ; Bytevectors compared structurally. 37 (if (equal? "abc" "abc") 0 (sys-exit 14)) 38 (if (not (equal? "abc" "abd")) 0 (sys-exit 15)) 39 (if (not (equal? "abc" "ab")) 0 (sys-exit 16)) 40 (if (equal? "" "") 0 (sys-exit 17)) 41 42 ; Nested: pair containing bytevector. 43 (define x (cons 'tag (cons "abc" '()))) 44 (define y (cons 'tag (cons "abc" '()))) 45 (if (equal? x y) 0 (sys-exit 18)) 46 47 (define z (cons 'tag (cons "abd" '()))) 48 (if (not (equal? x z)) 0 (sys-exit 19)) 49 50 ; Identity short-circuit on non-comparable heap types (closures, 51 ; primitives). Same prim-binding compares equal; different prims do 52 ; not. We don't recurse into closure structure. 53 (if (equal? car car) 0 (sys-exit 20)) 54 (if (not (equal? car cdr)) 0 (sys-exit 21)) 55 56 (sys-exit 0)