commit 55aff4595c1c22c2a6a3bd402153a547a57ad516
parent 9666d50f74fff919f734d35670d133c66cdc8847
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sat, 25 Apr 2026 13:53:45 -0700
scheme1: equal?, bytevector=?; shell+fileio e2e test
Add structural equality primitives and a test that exercises the
prelude's process-management plus port wrappers end-to-end.
equal? identity-short-circuits, gates on tag equality, recurses
through pair structure, and dispatches HEAP via hdr_type: HDR.BV
goes to bv_equal_check (length-then-byte compare); HDR.REC goes to
rec_equal_check (TD identity then field-walk back through
equal_recurse); CLOSURE/PRIM/TD stay identity-only per R7RS.
bytevector=? type-checks both args before reusing bv_equal_check.
The shell-fileio test runs `/bin/sh -c "echo … > /tmp/…"` via
prelude run/wait, then reads the file back through open-input /
read-all and compares with bytevector=?.
All 59 tests green on amd64, aarch64, riscv64.
Diffstat:
11 files changed, 409 insertions(+), 67 deletions(-)
diff --git a/docs/scheme-shell-todo.md b/docs/scheme-shell-todo.md
@@ -55,11 +55,10 @@ Per LISP.md and LISP-C.md, but not implemented:
`=>` arrow form. `pmatch` is called out by LISP-C.md as a built-in
special form needed by the self-hosted compiler.
- [ ] **Primitives missing** (LISP.md lists them as required):
- - Equality: `eqv?`, `equal?` (we only have `eq?`)
- Predicates: `boolean?`, `integer?`, `string?`, `procedure?`,
`record?`, `record-type?`
- - Numeric: `quotient`, `remainder`, `modulo`, `<=`, `>=`, `>`,
- `positive?`, `negative?`, `abs`, `min`, `max`, `bit-xor`,
+ - Numeric: `quotient`, `remainder`, `modulo`,
+ `negative?`, `abs`, `min`, `max`, `bit-xor`,
`bit-not`, `number->string`, `string->number`
- Pair / list: `set-car!`, `set-cdr!`, `length`, `list-ref`, `map`,
`for-each` as primitives (we provide them via the prelude only)
@@ -73,19 +72,40 @@ Per LISP.md and LISP-C.md, but not implemented:
`record-type-of`, no way to inspect a TD from user code. Spec is
ambiguous on this; LISP-C.md's example uses a generated `<point-td>`
binding.
-- [ ] **shell.scm's port record-type, `stdin`/`stdout`/`stderr` ports,
- `open-input` / `open-output` / `read-line` / `read-bytes` /
- `read-all` / `bv-concat-reverse` / `write-bytes` / `write-line` are
- NOT in the prelude.** Only the process-management half of shell.scm
- is ported.
-- [ ] **`scheme1/prelude.scm` is a strict subset of `lisp/prelude.scm`.**
- Active set: `<=`, `>=`, `negative?`, `abs`, `caar/cadr/cdar/cddr/caddr`,
- `list?`, `assoc`, `member`, `filter`, `fold`, plus the inherited
- list/shell helpers. Commented-out placeholders for `positive?`
- (needs `>`), `vector->list` / `list->vector` (need `make-vector` /
- `vector-ref` / `vector-set!` / `vector-length`), and `equal?` (needs
- `string?` / `vector?` plus their ref/length) wait on the
- corresponding primitives.
+- [ ] **`scheme1/prelude.scm` carries both the language prelude and
+ the shell.scm library.**
+ Missing: `vector->list` / `list->vector` (need `make-vector` /
+ `vector-ref` / `vector-set!` / `vector-length`),
+ Each re-enables when its underlying primitives land.
+
+## Prelude scope (deliberately wider than `lisp/prelude.scm`)
+
+scheme1 keeps the shell.scm library inside `prelude.scm` rather than
+mirroring the `lisp/` two-file split. The boot script catm's a single
+file in front of the user script, so process / file-I/O / port
+wrappers are always in scope.
+
+What lives in `prelude.scm` today, grouped:
+
+- **Language helpers** (subset of `lisp/prelude.scm`): see the bullet
+ in "Spec features still missing" above for the active set and what
+ remains commented out pending primitives.
+- **Process management**: `sys-wait` (Scheme adapter over `sys-waitid`
+ returning a wait4-style raw wstatus), `decode-wait-status`, `wait`,
+ `exit`, `argv`, `spawn`, `run`.
+- **File-I/O constants**: `BUFSIZE`, `AT_FDCWD`, `O_RDONLY`, `O_WRONLY`,
+ `O_CREAT`, `O_TRUNC`, `O_APPEND`, `MODE_644`, `NL-BYTE`, `NL-BV`.
+- **Port record + handles**: `port` (via `define-record-type`) plus
+ `stdin` / `stdout` / `stderr`.
+- **Buffered I/O**: `open-input` / `open-output` / `open-append` /
+ `close`, `refill!`, `read-bytes`, `read-line`, `read-all`,
+ `bv-concat-reverse`, `write-bytes`, `write-string`, `write-line`.
+
+Items to add as the underlying primitives land:
+
+- [ ] Re-enable `vector->list` / `list->vector` once
+ `make-vector` / `vector-ref` / `vector-set!` / `vector-length`
+ are primitives.
## Hacks and fragile invariants
@@ -228,10 +248,10 @@ In rough priority order:
1. Track down and fix the prelude `spawn`-via-`run` bug; remove the
workaround in test 45.
-4. Fill in the spec-required primitives (`equal?`, `eqv?`, `set-car!`,
+2. Fill in the spec-required primitives (`eqv?`, `set-car!`,
`set-cdr!`, the comparison family, the bytevector family, the
- number/string converters).
-5. `set!`, `pmatch`.
-7. Port shell.scm's port record + I/O wrappers.
-8. Replace the 1024-slot linear-scan symtab with an open-addressing
+ number/string converters) — many of these unblock the
+ commented-out helpers in `prelude.scm` (`vector->list` / `list->vector`).
+3. `set!`, `pmatch`.
+4. Replace the 1024-slot linear-scan symtab with an open-addressing
hash per LISP-C.md.
diff --git a/scheme1/prelude.scm b/scheme1/prelude.scm
@@ -7,17 +7,10 @@
; vector-* family, the string-* family) stay here as commented
; placeholders for re-enabling once those primitives land.
-;; --- Boolean / logical ----------------------------------------------
-; not is a primitive (prim_not_entry); redefining would shadow it.
-; (define (not x) (if x #f #t))
-
;; --- Arithmetic helpers (derivable from <, =, -) --------------------
(define (<= x y) (if (< y x) #f #t))
(define (>= x y) (if (< x y) #f #t))
-; zero? is a primitive (prim_zeroq_entry).
-; (define (zero? x) (= x 0))
-
(define (negative? x) (< x 0))
; positive? needs `>`, which is not yet a primitive.
@@ -112,45 +105,6 @@
; (define (list->vector xs)
; (list->vector-helper (make-vector (length xs) 0) xs 0))
-;; --- Structural equality -- needs string?/vector? plus their ref /
-;; length, none of which are yet primitives. ------------------------
-; (define (equal?-string a b i n)
-; (if (= i n)
-; #t
-; (if (= (string-ref a i) (string-ref b i))
-; (equal?-string a b (+ i 1) n)
-; #f)))
-;
-; (define (equal?-vector a b i n)
-; (if (= i n)
-; #t
-; (if (equal? (vector-ref a i) (vector-ref b i))
-; (equal?-vector a b (+ i 1) n)
-; #f)))
-;
-; (define (equal? a b)
-; (if (eq? a b)
-; #t
-; (if (pair? a)
-; (if (pair? b)
-; (if (equal? (car a) (car b))
-; (equal? (cdr a) (cdr b))
-; #f)
-; #f)
-; (if (string? a)
-; (if (string? b)
-; (if (= (string-length a) (string-length b))
-; (equal?-string a b 0 (string-length a))
-; #f)
-; #f)
-; (if (vector? a)
-; (if (vector? b)
-; (if (= (vector-length a) (vector-length b))
-; (equal?-vector a b 0 (vector-length a))
-; #f)
-; #f)
-; #f)))))
-
;; --- shell.scm port: process-management wrappers built on top of the
;; syscall primitives. sys-wait is a Scheme adapter over sys-waitid
;; that returns a wait4-style raw wstatus so decode-wait-status can
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -2671,6 +2671,199 @@
%die(msg_bv_oob)
})
+# bv_equal_check(a=a0, b=a1) -> a0 (IMM.TRUE / IMM.FALSE). Leaf. Both
+# arguments are assumed to be HEAP-tagged HDR.BV values; callers do the
+# type check (either bytevector=?'s prim entry or equal_recurse's BV
+# branch). Compares lengths first, then walks bytes; %lb is zero-extending
+# on every backend, so a single %bne is enough for the byte test.
+:bv_equal_check
+%scope bv_equal_check
+ %ld(t0, a0, -3)
+ %shri(t0, t0, 8) ; len_a
+ %ld(t1, a1, -3)
+ %shri(t1, t1, 8) ; len_b
+ %bne(t0, t1, &::false)
+
+ %ld(a2, a0, 5) ; data ptr a
+ %ld(a3, a1, 5) ; data ptr b
+
+ ::loop
+ %beqz(t0, &::true)
+ %lb(t1, a2, 0)
+ %lb(t2, a3, 0)
+ %bne(t1, t2, &::false)
+ %addi(a2, a2, 1)
+ %addi(a3, a3, 1)
+ %addi(t0, t0, -1)
+ %b(&::loop)
+
+ ::true
+ %li(a0, %imm_val(%IMM.TRUE))
+ %ret
+
+ ::false
+ %li(a0, %imm_val(%IMM.FALSE))
+ %ret
+%endscope
+
+# (bytevector=? a b) -- structural equality on bytevectors. Non-bv
+# inputs return #f rather than aborting, matching the lax stance the
+# other predicates take until LISP.md pins a stricter policy.
+:prim_bytevector_eq_entry
+%scope prim_bytevector_eq
+ %args2(t0, t1, a0)
+ %tagof(t2, t0)
+ %li(a0, %TAG.HEAP)
+ %bne(t2, a0, &::false)
+ %tagof(t2, t1)
+ %bne(t2, a0, &::false)
+ %hdr_type(t2, t0)
+ %li(a0, %HDR.BV)
+ %bne(t2, a0, &::false)
+ %hdr_type(t2, t1)
+ %bne(t2, a0, &::false)
+ %mov(a0, t0)
+ %mov(a1, t1)
+ %b(&bv_equal_check)
+ ::false
+ %li(a0, %imm_val(%IMM.FALSE))
+ %ret
+%endscope
+
+# equal_recurse(a=a0, b=a1) -> a0 (IMM.TRUE / IMM.FALSE). Identity covers
+# fixnums, symbols, immediates, and any case where both arguments are the
+# same heap or pair pointer. For non-identical pair pointers we recurse
+# into car then cdr; for non-identical heap pointers we structural-equal
+# only when both are HDR.BV (closures, prims, records, and TDs are
+# identity-only). Tail-calls the cdr-side recursion and the BV check.
+#
+# Frame: 16 bytes (a, b spilled across each %call).
+%fn(equal_recurse, 16, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+
+ %beq(a0, a1, &::true)
+
+ %tagof(t0, a0)
+ %tagof(t1, a1)
+ %bne(t0, t1, &::false)
+
+ %li(t1, %TAG.PAIR)
+ %beq(t0, t1, &::pair)
+ %li(t1, %TAG.HEAP)
+ %beq(t0, t1, &::heap)
+ %b(&::false)
+
+ ::pair
+ %ld(t0, sp, 0)
+ %ld(t1, sp, 8)
+ %car(a0, t0)
+ %car(a1, t1)
+ %call(&equal_recurse)
+ %li(t0, %imm_val(%IMM.FALSE))
+ %beq(a0, t0, &::done)
+ %ld(t0, sp, 0)
+ %ld(t1, sp, 8)
+ %cdr(a0, t0)
+ %cdr(a1, t1)
+ %tail(&equal_recurse)
+
+ ::heap
+ %ld(t0, sp, 0)
+ %ld(t1, sp, 8)
+ %hdr_type(t2, t0)
+ %hdr_type(a0, t1)
+ %bne(t2, a0, &::false) ; differing heap classes -> #f
+ %li(a0, %HDR.BV)
+ %beq(t2, a0, &::heap_bv)
+ %li(a0, %HDR.REC)
+ %beq(t2, a0, &::heap_rec)
+ %b(&::false) ; CLOSURE/PRIM/TD: identity-only
+
+ ::heap_bv
+ %mov(a0, t0)
+ %mov(a1, t1)
+ %tail(&bv_equal_check)
+
+ ::heap_rec
+ %mov(a0, t0)
+ %mov(a1, t1)
+ %tail(&rec_equal_check)
+
+ ::true
+ %li(a0, %imm_val(%IMM.TRUE))
+ %b(&::done)
+
+ ::false
+ %li(a0, %imm_val(%IMM.FALSE))
+
+ ::done
+})
+
+# rec_equal_check(a=a0, b=a1) -> a0 (IMM.TRUE / IMM.FALSE). Both args
+# are HEAP-tagged HDR.REC. Records are equal iff their TDs are eq? and
+# every field is equal? (recursing through equal_recurse). Field i sits
+# at tagged + 13 + 8*i; nfields lives at the TD's offset 13 (raw).
+#
+# Frame: 32 bytes
+# +0 a (rec, tagged)
+# +8 b (rec, tagged)
+# +16 i (raw counter)
+# +24 nfields (raw)
+%fn(rec_equal_check, 32, {
+ %st(a0, sp, 0)
+ %st(a1, sp, 8)
+
+ %ld(t0, a0, 5) ; td_a
+ %ld(t1, a1, 5) ; td_b
+ %bne(t0, t1, &::false)
+
+ %ld(t1, t0, 13) ; nfields (raw)
+ %st(t1, sp, 24)
+ %li(t0, 0)
+ %st(t0, sp, 16) ; i = 0
+
+ ::loop
+ %ld(t0, sp, 16)
+ %ld(t1, sp, 24)
+ %beq(t0, t1, &::true)
+
+ %shli(t2, t0, 3)
+ %addi(t2, t2, 13) ; field offset = 13 + 8*i
+ %ld(t1, sp, 0)
+ %add(t1, t1, t2)
+ %ld(a0, t1, 0) ; a's field i
+ %ld(t1, sp, 8)
+ %add(t1, t1, t2)
+ %ld(a1, t1, 0) ; b's field i
+ %call(&equal_recurse)
+ %li(t0, %imm_val(%IMM.FALSE))
+ %beq(a0, t0, &::done)
+
+ %ld(t0, sp, 16)
+ %addi(t0, t0, 1)
+ %st(t0, sp, 16)
+ %b(&::loop)
+
+ ::true
+ %li(a0, %imm_val(%IMM.TRUE))
+ %b(&::done)
+
+ ::false
+ %li(a0, %imm_val(%IMM.FALSE))
+
+ ::done
+})
+
+# (equal? a b) -- thin prim wrapper that unpacks the args list and falls
+# into equal_recurse. equal_recurse owns the frame; this entry stays a
+# leaf so the prim-dispatch tailr lands directly into the frame setup.
+:prim_equal_entry
+ %args2(t0, t1, a0)
+ %mov(a0, t0)
+ %mov(a1, t1)
+ %b(&equal_recurse)
+
# (apply fn rest...) -- the trailing element of `rest` is a list; any
# leading elements get prepended to it. apply_build_args walks `rest` and
# returns the assembled args list; prim_apply_entry then tail-calls apply.
@@ -3944,6 +4137,7 @@
:name_zeroq "zero?"
:name_not "not"
:name_eqq "eq?"
+:name_equal "equal?"
:name_plus "+"
:name_minus "-"
:name_mult "*"
@@ -3960,6 +4154,7 @@
:name_bv_copy "bytevector-copy"
:name_bv_copy_b "bytevector-copy!"
:name_bv_grow "bytevector-grow!"
+:name_bv_eq "bytevector=?"
:name_make_rt "%make-record-td"
:name_make_rec "%make-record"
:name_record_ref "%record-ref"
@@ -4010,6 +4205,7 @@
&name_zeroq %(0) $(5) &prim_zeroq_entry %(0)
&name_not %(0) $(3) &prim_not_entry %(0)
&name_eqq %(0) $(3) &prim_eqq_entry %(0)
+&name_equal %(0) $(6) &prim_equal_entry %(0)
&name_plus %(0) $(1) &prim_plus_entry %(0)
&name_minus %(0) $(1) &prim_minus_entry %(0)
&name_mult %(0) $(1) &prim_mult_entry %(0)
@@ -4026,6 +4222,7 @@
&name_bv_copy %(0) $(15) &prim_bv_copy_entry %(0)
&name_bv_copy_b %(0) $(16) &prim_bv_copy_bang_entry %(0)
&name_bv_grow %(0) $(16) &prim_bv_grow_entry %(0)
+&name_bv_eq %(0) $(12) &prim_bytevector_eq_entry %(0)
&name_make_rt %(0) $(15) &prim_make_record_td_entry %(0)
&name_make_rec %(0) $(12) &prim_make_record_entry %(0)
&name_record_ref %(0) $(11) &prim_record_ref_entry %(0)
diff --git a/tests/scheme1/56-shell-fileio.expected-exit b/tests/scheme1/56-shell-fileio.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/56-shell-fileio.scm b/tests/scheme1/56-shell-fileio.scm
@@ -0,0 +1,25 @@
+; End-to-end shell + file-IO smoke test for the prelude. Covers the
+; full process-management path (run -> spawn -> sys-clone/sys-execve,
+; sys-wait/decode-wait-status) AND the port abstraction
+; (open-input/refill!/read-all/bv-concat-reverse/close), with string
+; literals carrying paths and argv into the syscall layer.
+;
+; Plan: shell-out a one-line `echo` that writes a known payload to
+; /tmp; wait for the child; reopen the file via the prelude's port API;
+; read the contents back and compare with bytevector=?.
+(define path "/tmp/scheme1-shell-fileio.txt")
+(define expected "hello, scheme1!\n")
+
+(define rc (run "/bin/sh" "-c" "echo 'hello, scheme1!' > /tmp/scheme1-shell-fileio.txt"))
+(if (not (car rc)) (sys-exit 10) 0)
+(if (not (= (cdr rc) 0)) (sys-exit 20) 0)
+
+(define op (open-input path))
+(if (not (car op)) (sys-exit 30) 0)
+(define rd (read-all (cdr op)))
+(close (cdr op))
+(if (not (car rd)) (sys-exit 40) 0)
+
+(if (bytevector=? (cdr rd) expected)
+ (sys-exit 0)
+ (sys-exit 50))
diff --git a/tests/scheme1/57-bytevector-eq.expected-exit b/tests/scheme1/57-bytevector-eq.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/57-bytevector-eq.scm b/tests/scheme1/57-bytevector-eq.scm
@@ -0,0 +1,32 @@
+; (bytevector=? a b) -> #t iff a and b are bytevectors of equal length
+; with the same bytes. Only structural; non-bytevector inputs are #f
+; rather than an error (kept lax until LISP.md pins the policy).
+
+; Self-equal.
+(if (bytevector=? "abc" "abc") 0 (sys-exit 1))
+
+; Empty bytevectors.
+(if (bytevector=? "" "") 0 (sys-exit 2))
+
+; Distinct identity, same bytes.
+(define a (make-bytevector 3 65))
+(define b (make-bytevector 3 65))
+(if (bytevector=? a b) 0 (sys-exit 3))
+
+; Same length, differing byte.
+(bytevector-u8-set! b 1 66)
+(if (not (bytevector=? a b)) 0 (sys-exit 4))
+
+; Different length (prefix match).
+(define c (make-bytevector 4 65))
+(if (not (bytevector=? a c)) 0 (sys-exit 5))
+
+; String literal vs handcrafted bv with identical bytes.
+(define s "AAA")
+(if (bytevector=? s a) 0 (sys-exit 6))
+
+; Non-bytevector inputs return #f rather than crashing.
+(if (not (bytevector=? '(1 2 3) "abc")) 0 (sys-exit 7))
+(if (not (bytevector=? "abc" 'foo)) 0 (sys-exit 8))
+
+(sys-exit 0)
diff --git a/tests/scheme1/58-equal.expected-exit b/tests/scheme1/58-equal.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/58-equal.scm b/tests/scheme1/58-equal.scm
@@ -0,0 +1,56 @@
+; (equal? a b) -- structural equality. Falls back to eq? for
+; fixnums/symbols/immediates/identical heap-or-pair pointers; recurses
+; into pair structure; uses bytevector=? for bytevector contents. Other
+; heap types (closures, prims, records, type descriptors) compare by
+; identity only.
+
+; eq? cases.
+(if (equal? 1 1) 0 (sys-exit 1))
+(if (equal? 'foo 'foo) 0 (sys-exit 2))
+(if (equal? '() '()) 0 (sys-exit 3))
+(if (equal? #t #t) 0 (sys-exit 4))
+(if (not (equal? #t #f)) 0 (sys-exit 5))
+
+; Tag mismatches -> #f.
+(if (not (equal? 1 'foo)) 0 (sys-exit 6))
+(if (not (equal? '() '(1))) 0 (sys-exit 7))
+(if (not (equal? "abc" 'foo)) 0 (sys-exit 8))
+
+; Pair recursion, distinct identities.
+(define p (cons 1 (cons 2 (cons 3 '()))))
+(define q (cons 1 (cons 2 (cons 3 '()))))
+(if (equal? p q) 0 (sys-exit 9))
+
+; Same head, different tail.
+(define r (cons 1 (cons 2 (cons 4 '()))))
+(if (not (equal? p r)) 0 (sys-exit 10))
+
+; Length mismatch (cdr-shape diverges).
+(define p2 (cons 1 (cons 2 '())))
+(if (not (equal? p p2)) 0 (sys-exit 11))
+
+; Dotted pairs.
+(if (equal? (cons 1 2) (cons 1 2)) 0 (sys-exit 12))
+(if (not (equal? (cons 1 2) (cons 1 3))) 0 (sys-exit 13))
+
+; Bytevectors compared structurally.
+(if (equal? "abc" "abc") 0 (sys-exit 14))
+(if (not (equal? "abc" "abd")) 0 (sys-exit 15))
+(if (not (equal? "abc" "ab")) 0 (sys-exit 16))
+(if (equal? "" "") 0 (sys-exit 17))
+
+; Nested: pair containing bytevector.
+(define x (cons 'tag (cons "abc" '())))
+(define y (cons 'tag (cons "abc" '())))
+(if (equal? x y) 0 (sys-exit 18))
+
+(define z (cons 'tag (cons "abd" '())))
+(if (not (equal? x z)) 0 (sys-exit 19))
+
+; Identity short-circuit on non-comparable heap types (closures,
+; primitives). Same prim-binding compares equal; different prims do
+; not. We don't recurse into closure structure.
+(if (equal? car car) 0 (sys-exit 20))
+(if (not (equal? car cdr)) 0 (sys-exit 21))
+
+(sys-exit 0)
diff --git a/tests/scheme1/59-record-equal.expected-exit b/tests/scheme1/59-record-equal.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/59-record-equal.scm b/tests/scheme1/59-record-equal.scm
@@ -0,0 +1,54 @@
+; equal? on records is structural: same TD (by identity) plus
+; field-by-field equal?. Different TDs are never equal even if their
+; shapes happen to match. Field comparison recurses through the same
+; equal? machinery, so nested records / pairs / bytevectors all work.
+
+(define-record-type point
+ (make-point x y)
+ point?
+ (x point-x)
+ (y point-y))
+
+(define-record-type box
+ (make-box v)
+ box?
+ (v box-v))
+
+; Distinct allocations, same TD, same fields -> equal.
+(define p1 (make-point 3 4))
+(define p2 (make-point 3 4))
+(if (equal? p1 p2) 0 (sys-exit 1))
+
+; eq? still distinguishes them.
+(if (not (eq? p1 p2)) 0 (sys-exit 2))
+
+; Same TD, differing field -> not equal.
+(define p3 (make-point 3 5))
+(if (not (equal? p1 p3)) 0 (sys-exit 3))
+
+; Different TDs but same arity / values -> not equal.
+(define b (make-box 3))
+(if (not (equal? b (make-point 3 0))) 0 (sys-exit 4))
+
+; Self -> equal (eq? short-circuit covers this).
+(if (equal? p1 p1) 0 (sys-exit 5))
+
+; Records nested in pairs.
+(if (equal? (cons p1 '()) (cons p2 '())) 0 (sys-exit 6))
+(if (not (equal? (cons p1 '()) (cons p3 '()))) 0 (sys-exit 7))
+
+; Records carrying bytevector fields are compared structurally.
+(define s1 (make-box "abc"))
+(define s2 (make-box "abc"))
+(define s3 (make-box "abd"))
+(if (equal? s1 s2) 0 (sys-exit 8))
+(if (not (equal? s1 s3)) 0 (sys-exit 9))
+
+; Records nested inside records.
+(define wrapped1 (make-box p1))
+(define wrapped2 (make-box p2))
+(define wrapped3 (make-box p3))
+(if (equal? wrapped1 wrapped2) 0 (sys-exit 10))
+(if (not (equal? wrapped1 wrapped3)) 0 (sys-exit 11))
+
+(sys-exit 0)
