commit 9d8abb8d6a2cd646c041021c86a3337af964f64c
parent 641a2e87e7b4efa2fe6f4589a65f2d6c3a4531d3
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Mon, 27 Apr 2026 14:02:08 -0700
scheme1: quasiquote, variadic prims
Diffstat:
8 files changed, 461 insertions(+), 56 deletions(-)
diff --git a/docs/LISP.md b/docs/LISP.md
@@ -142,6 +142,11 @@ Flat namespace — no library carving for v1.
is a pure op, not a syscall, so the normal `(ok . val)` convention
doesn't apply).
+Arities follow R7RS: `+ * bit-and bit-or bit-xor` accept 0+ args
+(identities `0 1 -1 0 0`); `-` accepts 1+ (`(- x)` is unary negate);
+`= < > <= >=` accept 2+ and chain pairwise. `quotient` / `remainder` /
+`modulo` / `arithmetic-shift` are binary; `bit-not` is unary.
+
Division rounding (R7RS semantics) — worth stating since target ISAs
differ at the instruction level:
diff --git a/docs/SCHEME1-R7RS-TODO.md b/docs/SCHEME1-R7RS-TODO.md
@@ -21,7 +21,7 @@ and rough implementation notes.
- [ ] **`let-values`, `let*-values`, `define-values`.** Depend on the
MV protocol.
-- [ ] **Flat (one-level) quasiquote.** `(quasiquote ...)`,
+- [x] **Flat (one-level) quasiquote.** `(quasiquote ...)`,
`(unquote x)`, `(unquote-splicing xs)` evaluated at the single
template depth. Nested quasiquote is unsupported. Works on
lists today; extend to vectors when those land.
diff --git a/scheme1/prelude.scm b/scheme1/prelude.scm
@@ -474,16 +474,14 @@
(cons #t (%port (cdr r) (make-bytevector BUFSIZE) 0 0))
r)))
-;; bit-or is 2-arg only in scheme1 today, so the 3-flag combinations
-;; are written as nested 2-arg calls.
(define (open-output path)
(let ((r (sys-openat AT_FDCWD path
- (bit-or O_WRONLY (bit-or O_CREAT O_TRUNC)) MODE_644)))
+ (bit-or O_WRONLY O_CREAT O_TRUNC) MODE_644)))
(if (car r) (cons #t (%port (cdr r) #f 0 0)) r)))
(define (open-append path)
(let ((r (sys-openat AT_FDCWD path
- (bit-or O_WRONLY (bit-or O_CREAT O_APPEND)) MODE_644)))
+ (bit-or O_WRONLY O_CREAT O_APPEND) MODE_644)))
(if (car r) (cons #t (%port (cdr r) #f 0 0)) r)))
(define (close p) (sys-close (port-fd p)))
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -309,6 +309,8 @@
%beqz(a1, &::quote)
%addi(a1, a0, -44) ; ','
%beqz(a1, &::comma)
+ %addi(a1, a0, -96) ; '`'
+ %beqz(a1, &::quasiquote)
%addi(a1, a0, -34) ; '"'
%beqz(a1, &::string)
@@ -413,15 +415,33 @@
%tail(&cons)
::comma
- # Mirror of ::quote: consume the leading ','; recurse into parse_one
- # for the inner datum; build (unquote <datum>). The comma sugar exists
- # purely so pmatch patterns can be written as `,ident`; there is no
- # quasiquote evaluator. Outside a pmatch pattern this list reaches
- # eval as an application of the (unbound) `unquote` and dies through
- # the standard unbound-variable path.
+ # Consume the leading ','. If the next byte is '@', this is `,@`
+ # (unquote-splicing); otherwise it's `,` (unquote). Recurse into
+ # parse_one for the inner datum and build the appropriate pair.
+ # The comma sugar predates quasiquote -- it was added so pmatch
+ # patterns could be written as `,ident`. Outside a quasiquote
+ # template (and outside pmatch) `(unquote x)` still reaches eval as
+ # an application of the unbound `unquote` and dies through the
+ # standard unbound-variable path.
%lda_global(t0, t2, &readbuf_pos)
%addi(t0, t0, 1)
%st(t0, t2, 0)
+ %ld_global(t1, &readbuf_len)
+ %beq(t0, t1, &::comma_atom)
+ %readbuf_byte(a0, t0)
+ %addi(a1, a0, -64) ; '@'
+ %bnez(a1, &::comma_atom)
+ %addi(t0, t0, 1)
+ %st(t0, t2, 0)
+ %call(&parse_one)
+ %li(a1, %imm_val(%IMM.NIL))
+ %call(&cons)
+ %ld_global(t0, &sym_unquote_splicing)
+ %mov(a1, a0)
+ %mov(a0, t0)
+ %tail(&cons)
+
+ ::comma_atom
%call(&parse_one)
%li(a1, %imm_val(%IMM.NIL))
%call(&cons)
@@ -430,6 +450,23 @@
%mov(a0, t0)
%tail(&cons)
+ ::quasiquote
+ # Consume the leading '`'; recurse into parse_one for the datum;
+ # build (quasiquote <datum>). The evaluator implements one-level
+ # template walking with `,` and `,@` substitution; nested
+ # quasiquote forms are preserved literally rather than recursed
+ # into.
+ %lda_global(t0, t2, &readbuf_pos)
+ %addi(t0, t0, 1)
+ %st(t0, t2, 0)
+ %call(&parse_one)
+ %li(a1, %imm_val(%IMM.NIL))
+ %call(&cons)
+ %ld_global(t0, &sym_quasiquote)
+ %mov(a1, a0)
+ %mov(a0, t0)
+ %tail(&cons)
+
::char_lit
# Cursor is already past '#\\'; parse_char scans the body and returns
# a tagged fixnum (the u8 char value).
@@ -1154,6 +1191,7 @@
%ldl(t0, expr)
%car(t0, t0) ; t0 = head
%dispatch_form(&sym_quote, &::do_quote)
+ %dispatch_form(&sym_quasiquote, &::do_quasiquote)
%dispatch_form(&sym_if, &::do_if)
%dispatch_form(&sym_lambda, &::do_lambda)
%dispatch_form(&sym_define, &::do_define)
@@ -1199,6 +1237,9 @@
%car(a0, a0)
%eret
+ ::do_quasiquote
+ %tail_to_handler(&eval_quasiquote)
+
::do_if
%tail_to_handler(&eval_if)
::do_lambda
@@ -1287,6 +1328,150 @@
%ldl(a0, head)
})
+# qq_walk(t=a0, env=a1) -> result (a0). One-level quasiquote walker
+# (R7RS §4.2.8 minus the nested-template recursion). Atoms and any
+# `(quasiquote ...)` form are returned literally; an `(unquote x)` head
+# evaluates x; otherwise we walk the spine, splicing `(unquote-splicing
+# xs)` elements and recursing on every other element. Improper tails
+# are qq'd and stitched back onto the result.
+#
+# Locals:
+# t the template
+# env evaluation environment for `,` and `,@`
+# head accumulator head (NIL until first cell appended)
+# tail most recently appended cell
+# walk spine cursor (advances)
+# spliced inner cursor used during `,@` expansion
+%fn2(qq_walk, {t env head tail walk spliced}, {
+ %stl(a0, t)
+ %stl(a1, env)
+ %li(t0, %imm_val(%IMM.NIL))
+ %stl(t0, head)
+ %stl(t0, tail)
+
+ # Atom -> return as-is.
+ %tagof(t0, a0)
+ %li(t1, %TAG.PAIR)
+ %bne(t0, t1, &::atom_ret)
+
+ # (unquote x) at the top -> tail eval(cadr t, env).
+ %ldl(t0, t)
+ %car(t1, t0)
+ %ld_global(t2, &sym_unquote)
+ %beq(t1, t2, &::do_unquote)
+ # Nested (quasiquote ...) -> literal; do not recurse.
+ %ld_global(t2, &sym_quasiquote)
+ %beq(t1, t2, &::atom_ret)
+
+ # Walk the spine.
+ %ldl(t0, t)
+ %stl(t0, walk)
+
+ ::loop
+ %ldl(t0, walk)
+ %if_nil(t1, t0, &::done)
+ %tagof(t1, t0)
+ %li(t2, %TAG.PAIR)
+ %bne(t1, t2, &::improper)
+
+ # elem = car(walk). Detect (unquote-splicing ...) shape.
+ %car(a0, t0)
+ %tagof(t1, a0)
+ %li(t2, %TAG.PAIR)
+ %bne(t1, t2, &::recurse_elem)
+ %car(t1, a0)
+ %ld_global(t2, &sym_unquote_splicing)
+ %bne(t1, t2, &::recurse_elem)
+
+ # spliced = eval(cadr elem, env)
+ %cdr(a0, a0)
+ %car(a0, a0)
+ %ldl(a1, env)
+ %call(&eval)
+ %stl(a0, spliced)
+
+ ::splice_loop
+ %ldl(t0, spliced)
+ %if_nil(t1, t0, &::splice_advance_walk)
+ %tagof(t1, t0)
+ %li(t2, %TAG.PAIR)
+ %bne(t1, t2, &::splice_advance_walk)
+ %car(a0, t0)
+ %li(a1, %imm_val(%IMM.NIL))
+ %call(&cons)
+ %ldl(t0, head)
+ %if_nil(t1, t0, &::splice_first)
+ %ldl(t0, tail)
+ %set_cdr(a0, t0)
+ %stl(a0, tail)
+ %b(&::splice_step)
+ ::splice_first
+ %stl(a0, head)
+ %stl(a0, tail)
+ ::splice_step
+ %ldl(t0, spliced)
+ %cdr(t0, t0)
+ %stl(t0, spliced)
+ %b(&::splice_loop)
+
+ ::splice_advance_walk
+ %ldl(t0, walk)
+ %cdr(t0, t0)
+ %stl(t0, walk)
+ %b(&::loop)
+
+ ::recurse_elem
+ # new_elem = qq_walk(elem, env); elem already in a0.
+ %ldl(a1, env)
+ %call(&qq_walk)
+ %li(a1, %imm_val(%IMM.NIL))
+ %call(&cons)
+ %ldl(t0, head)
+ %if_nil(t1, t0, &::elem_first)
+ %ldl(t0, tail)
+ %set_cdr(a0, t0)
+ %stl(a0, tail)
+ %b(&::elem_step)
+ ::elem_first
+ %stl(a0, head)
+ %stl(a0, tail)
+ ::elem_step
+ %ldl(t0, walk)
+ %cdr(t0, t0)
+ %stl(t0, walk)
+ %b(&::loop)
+
+ ::improper
+ # walk holds a non-pair non-NIL cdr; qq it and stitch onto tail.
+ %ldl(a0, walk)
+ %ldl(a1, env)
+ %call(&qq_walk)
+ %ldl(t0, tail)
+ %set_cdr(a0, t0)
+
+ ::done
+ %ldl(a0, head)
+ %eret
+
+ ::atom_ret
+ %ldl(a0, t)
+ %eret
+
+ ::do_unquote
+ %ldl(t0, t)
+ %cdr(t0, t0)
+ %car(a0, t0)
+ %ldl(a1, env)
+ %tail(&eval)
+})
+
+# eval_quasiquote(rest=a0, env=a1) -> result (a0). rest = (template . _);
+# tail-walks the template through qq_walk.
+%fn(eval_quasiquote, 0, {
+ %car(a0, a0)
+ %tail(&qq_walk)
+})
+
# apply(fn=a0, args=a1) -> result (a0)
#
# Locals:
@@ -1365,6 +1550,8 @@
%fn(intern_special_forms, 0, {
%intern_form(&name_quote, 5, &sym_quote)
+ %intern_form(&name_quasiquote, 10, &sym_quasiquote)
+ %intern_form(&name_unquote_splicing, 16, &sym_unquote_splicing)
%intern_form(&name_if, 2, &sym_if)
%intern_form(&name_lambda, 6, &sym_lambda)
%intern_form(&name_define, 6, &sym_define)
@@ -3266,10 +3453,11 @@
# and the result goes back in a0. Most use no frame at all; the few that
# need recursion (apply) carry a small one via %fn.
#
-# Two-arg arithmetic on tagged fixnums takes advantage of the (n << 3)
-# representation: + / - / signed compare / bit-and / bit-or all work
-# directly on the tagged words. Only * needs to untag one operand to
-# avoid a stray <<6.
+# Arithmetic / compare / bitwise primitives on tagged fixnums take
+# advantage of the (n << 3) representation: + / - / signed compare /
+# bit-and / bit-or / bit-xor all work directly on the tagged words, so
+# the variadic fold loop preserves the tag at every step. Only * has to
+# untag each incoming operand to avoid a stray <<6.
# (sys-exit code) -- libp1pp's sys_exit doesn't return; %b, not %call.
:prim_sys_exit_entry
@@ -3612,63 +3800,118 @@
%ret
%endscope
-# Two-arg arithmetic.
+# Variadic arithmetic. (+ ...) folds with identity 0; (* ...) folds with
+# identity 1; (- x) is unary negate, (- x y z ...) folds left.
:prim_plus_entry
- %car(t0, a0)
- %cdr(t1, a0)
- %car(t1, t1)
- %add(a0, t0, t1)
+%scope prim_plus
+ %li(t0, 0) ; tagged 0; tag bits stay 0 across %add
+ ::loop
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %add(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::done
+ %mov(a0, t0)
%ret
+%endscope
+# (- x) -> -x; (- x y ...) -> x - y - ... . (-) is undefined behavior
+# per the primitive-failure policy.
:prim_minus_entry
- %car(t0, a0)
- %cdr(t1, a0)
- %car(t1, t1)
- %sub(a0, t0, t1)
+%scope prim_minus
+ %car(t0, a0) ; seed = first arg (tagged)
+ %cdr(a0, a0)
+ %if_nil(t1, a0, &::neg)
+ ::loop
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %sub(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::neg
+ %li(t1, 0) ; unary: 0 - seed
+ %sub(t0, t1, t0)
+ ::done
+ %mov(a0, t0)
%ret
+%endscope
+# Multiply keeps the accumulator tagged and untags each incoming arg:
+# (a<<3) * b == (a*b)<<3, so the loop preserves the fixnum tag.
:prim_mult_entry
- %car(t0, a0)
- %cdr(t1, a0)
- %car(t1, t1)
+%scope prim_mult
+ %li(t0, 8) ; tagged 1 = mkfix(1)
+ ::loop
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
%untag_fix(t1, t1)
- %mul(a0, t0, t1)
+ %mul(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::done
+ %mov(a0, t0)
%ret
+%endscope
+# Variadic chained comparisons: (op a b c ...) ⇔ (a op b) ∧ (b op c) ∧ ...
+# Walks the tail with a single live `prev` register; a0 is reused as the
+# args cursor and finally as the result. <2 args is undefined behavior.
:prim_eq_entry
%scope prim_eq
- %car(t0, a0)
- %cdr(t1, a0)
- %car(t1, t1)
- %li(a0, %imm_val(%IMM.FALSE))
- %bne(t0, t1, &::end)
+ %car(t0, a0) ; prev = first
+ %cdr(a0, a0)
+ ::loop
+ %if_nil(t1, a0, &::true)
+ %car(t1, a0) ; curr
+ %bne(t0, t1, &::false)
+ %mov(t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::true
%li(a0, %imm_val(%IMM.TRUE))
- ::end
+ %ret
+ ::false
+ %li(a0, %imm_val(%IMM.FALSE))
%ret
%endscope
:prim_lt_entry
%scope prim_lt
%car(t0, a0)
- %cdr(t1, a0)
- %car(t1, t1)
- %li(a0, %imm_val(%IMM.TRUE))
- %blt(t0, t1, &::end)
+ %cdr(a0, a0)
+ ::loop
+ %if_nil(t1, a0, &::true)
+ %car(t1, a0)
+ %blt(t0, t1, &::ok) ; prev < curr -> continue
%li(a0, %imm_val(%IMM.FALSE))
- ::end
+ %ret
+ ::ok
+ %mov(t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::true
+ %li(a0, %imm_val(%IMM.TRUE))
%ret
%endscope
:prim_gt_entry
%scope prim_gt
%car(t0, a0)
- %cdr(t1, a0)
- %car(t1, t1)
- %li(a0, %imm_val(%IMM.TRUE))
- %blt(t1, t0, &::end)
+ %cdr(a0, a0)
+ ::loop
+ %if_nil(t1, a0, &::true)
+ %car(t1, a0)
+ %blt(t1, t0, &::ok) ; curr < prev <=> prev > curr -> continue
%li(a0, %imm_val(%IMM.FALSE))
- ::end
+ %ret
+ ::ok
+ %mov(t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::true
+ %li(a0, %imm_val(%IMM.TRUE))
%ret
%endscope
@@ -3688,26 +3931,50 @@
%rem(a0, t0, t1)
%ret
+# Variadic bitwise folds. Tagged fixnums have low 3 bits = 0, so AND/OR/
+# XOR with another tagged fixnum preserves the tag in the accumulator.
+# Identities: bit-and -> -1 (tagged -8), bit-or -> 0, bit-xor -> 0.
:prim_bit_and_entry
- %car(t0, a0)
- %cdr(t1, a0)
- %car(t1, t1)
- %and(a0, t0, t1)
+%scope prim_bit_and
+ %li(t0, -8) ; tagged -1; AND-identity preserves the tag
+ ::loop
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %and(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::done
+ %mov(a0, t0)
%ret
+%endscope
:prim_bit_or_entry
- %car(t0, a0)
- %cdr(t1, a0)
- %car(t1, t1)
- %or(a0, t0, t1)
+%scope prim_bit_or
+ %li(t0, 0)
+ ::loop
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %or(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::done
+ %mov(a0, t0)
%ret
+%endscope
-# (bit-xor x y) -- both operands have low 3 tag bits == 0 (fixnums), so
-# bitwise XOR preserves zero tag bits in the result.
:prim_bit_xor_entry
- %args2(t0, t1, a0)
- %xor(a0, t0, t1)
+%scope prim_bit_xor
+ %li(t0, 0)
+ ::loop
+ %if_nil(t1, a0, &::done)
+ %car(t1, a0)
+ %xor(t0, t0, t1)
+ %cdr(a0, a0)
+ %b(&::loop)
+ ::done
+ %mov(a0, t0)
%ret
+%endscope
# (bit-not n) -- bitwise complement. Untag, XOR with -1 (= ~n), retag.
# Can't XOR the tagged value directly: that would flip the low 3 tag bits.
@@ -5682,6 +5949,8 @@
:name_do "do" 00 00 00 00 00
:name_case_lambda "case-lambda" 00 00 00 00
:name_unquote "unquote"
+:name_quasiquote "quasiquote" 00 00 00 00 00
+:name_unquote_splicing "unquote-splicing" 00 00 00 00 00 00 00
:name_guard "guard" 00 00
:name_underscore "_" 00 00 00 00 00 00
:name_dollar "$" 00 00 00 00 00 00
@@ -5951,6 +6220,8 @@
:sym_do $(0)
:sym_case_lambda $(0)
:sym_unquote $(0)
+:sym_quasiquote $(0)
+:sym_unquote_splicing $(0)
:sym_guard $(0)
:sym_underscore $(0)
:sym_dollar $(0)
diff --git a/tests/scheme1/107-quasiquote.expected-exit b/tests/scheme1/107-quasiquote.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/107-quasiquote.scm b/tests/scheme1/107-quasiquote.scm
@@ -0,0 +1,56 @@
+; One-level quasiquote: backtick reads as (quasiquote ...); inside that
+; template, (unquote x) splices a single evaluated value, and
+; (unquote-splicing xs) splices the elements of xs in place. Atoms in
+; the template are returned literally; nested quasiquote forms are not
+; supported -- we don't recurse into them, so a `(quasiquote ...) form
+; sitting inside the template is preserved as-is.
+
+;; --- Atom template: returns the atom -------------------------------------
+(if (= 7 `7) 0 (sys-exit 1))
+(if (eq? 'foo `foo) 0 (sys-exit 2))
+(if (equal? '() `()) 0 (sys-exit 3))
+
+;; --- All-literal list template ------------------------------------------
+(if (equal? (list 1 2 3) `(1 2 3)) 0 (sys-exit 4))
+(if (equal? '(a b c) `(a b c)) 0 (sys-exit 5))
+
+;; --- ,x evaluates one element in place ----------------------------------
+(define x 10)
+(if (equal? (list 1 10 3) `(1 ,x 3)) 0 (sys-exit 6))
+(if (equal? (list 'a 11 'b) `(a ,(+ x 1) b)) 0 (sys-exit 7))
+
+;; --- ,x at head and tail positions --------------------------------------
+(if (equal? (list 10 'b) `(,x b)) 0 (sys-exit 8))
+(if (equal? (list 'a 10) `(a ,x)) 0 (sys-exit 9))
+
+;; --- ,@xs splices a list in place ---------------------------------------
+(define xs (list 2 3 4))
+(if (equal? (list 1 2 3 4 5) `(1 ,@xs 5)) 0 (sys-exit 10))
+
+;; --- ,@ at the head of the list -----------------------------------------
+(if (equal? (list 2 3 4 'tail) `(,@xs tail)) 0 (sys-exit 11))
+
+;; --- ,@ at the tail of the list -----------------------------------------
+(if (equal? (list 'head 2 3 4) `(head ,@xs)) 0 (sys-exit 12))
+
+;; --- ,@'() splices nothing ----------------------------------------------
+(if (equal? (list 'a 'b) `(a ,@'() b)) 0 (sys-exit 13))
+
+;; --- Mixed: literals, ,, ,@ in one template -----------------------------
+(if (equal? (list 'h 10 2 3 4 'mid 11 't)
+ `(h ,x ,@xs mid ,(+ x 1) t))
+ 0 (sys-exit 14))
+
+;; --- Nested-list template (no ,) is preserved literally -----------------
+(if (equal? '((a b) (c d)) `((a b) (c d))) 0 (sys-exit 15))
+
+;; --- , inside a nested list still evaluates at this depth ---------------
+(if (equal? (list (list 1 10) 'k) `((1 ,x) k)) 0 (sys-exit 16))
+
+;; --- ,@ inside a nested list splices into that nested list --------------
+(if (equal? (list (list 1 2 3 4) 'k) `((1 ,@xs) k)) 0 (sys-exit 17))
+
+;; --- (quasiquote x) prefix form parses identically to `x ----------------
+(if (equal? (list 1 10 3) (quasiquote (1 (unquote x) 3))) 0 (sys-exit 18))
+
+(sys-exit 0)
diff --git a/tests/scheme1/108-variadic-arith.expected-exit b/tests/scheme1/108-variadic-arith.expected-exit
@@ -0,0 +1 @@
+0
diff --git a/tests/scheme1/108-variadic-arith.scm b/tests/scheme1/108-variadic-arith.scm
@@ -0,0 +1,73 @@
+; Variadic arity for the arithmetic / comparison / bitwise primitives.
+; + * bit-and bit-or bit-xor accept 0+ args; - accepts 1+ (unary
+; negate); = < > accept 2+ args and chain pairwise.
+
+;; --- + (0+) -------------------------------------------------------------
+(if (= 0 (+)) 0 (sys-exit 1))
+(if (= 7 (+ 7)) 0 (sys-exit 2))
+(if (= 5 (+ 2 3)) 0 (sys-exit 3))
+(if (= 10 (+ 1 2 3 4)) 0 (sys-exit 4))
+(if (= 0 (+ 1 -1 2 -2)) 0 (sys-exit 5))
+
+;; --- - (1+) -------------------------------------------------------------
+(if (= -5 (- 5)) 0 (sys-exit 6))
+(if (= 5 (- -5)) 0 (sys-exit 7))
+(if (= 1 (- 3 2)) 0 (sys-exit 8))
+(if (= 4 (- 10 1 2 3)) 0 (sys-exit 9))
+(if (= -6 (- 0 1 2 3)) 0 (sys-exit 10))
+
+;; --- * (0+) -------------------------------------------------------------
+(if (= 1 (*)) 0 (sys-exit 11))
+(if (= 9 (* 9)) 0 (sys-exit 12))
+(if (= 6 (* 2 3)) 0 (sys-exit 13))
+(if (= 24 (* 2 3 4)) 0 (sys-exit 14))
+(if (= 0 (* 1 2 0 3)) 0 (sys-exit 15))
+(if (= -24 (* -1 2 3 4)) 0 (sys-exit 16))
+
+;; --- = (2+) -------------------------------------------------------------
+(if (= 1 1) 0 (sys-exit 17))
+(if (not (= 1 2)) 0 (sys-exit 18))
+(if (= 7 7 7) 0 (sys-exit 19))
+(if (not (= 7 7 8)) 0 (sys-exit 20))
+(if (not (= 7 8 7)) 0 (sys-exit 21))
+(if (= 0 0 0 0) 0 (sys-exit 22))
+
+;; --- < (2+) -------------------------------------------------------------
+(if (< 1 2) 0 (sys-exit 23))
+(if (not (< 2 1)) 0 (sys-exit 24))
+(if (not (< 1 1)) 0 (sys-exit 25))
+(if (< 1 2 3) 0 (sys-exit 26))
+(if (not (< 1 2 2)) 0 (sys-exit 27))
+(if (not (< 1 3 2)) 0 (sys-exit 28))
+(if (< -3 -2 -1 0 1) 0 (sys-exit 29))
+
+;; --- > (2+) -------------------------------------------------------------
+(if (> 2 1) 0 (sys-exit 30))
+(if (not (> 1 2)) 0 (sys-exit 31))
+(if (> 3 2 1) 0 (sys-exit 32))
+(if (not (> 3 2 2)) 0 (sys-exit 33))
+(if (not (> 3 1 2)) 0 (sys-exit 34))
+(if (> 5 4 3 2 1 0 -1) 0 (sys-exit 35))
+
+;; --- bit-and (0+, identity -1) ------------------------------------------
+(if (= -1 (bit-and)) 0 (sys-exit 36))
+(if (= #x33 (bit-and #x33)) 0 (sys-exit 37))
+(if (= #x03 (bit-and #x33 #x0f)) 0 (sys-exit 38))
+(if (= #x01 (bit-and #x33 #x0f #x05)) 0 (sys-exit 39))
+(if (= 0 (bit-and #x0f #xf0)) 0 (sys-exit 40))
+
+;; --- bit-or (0+, identity 0) --------------------------------------------
+(if (= 0 (bit-or)) 0 (sys-exit 41))
+(if (= #x21 (bit-or #x21)) 0 (sys-exit 42))
+(if (= #x3f (bit-or #x33 #x0f)) 0 (sys-exit 43))
+(if (= #x37 (bit-or #x33 #x04 #x10)) 0 (sys-exit 44))
+(if (= 7 (bit-or 1 2 4)) 0 (sys-exit 45))
+
+;; --- bit-xor (0+, identity 0) -------------------------------------------
+(if (= 0 (bit-xor)) 0 (sys-exit 46))
+(if (= #x55 (bit-xor #x55)) 0 (sys-exit 47))
+(if (= #x33 (bit-xor #x55 #x66)) 0 (sys-exit 48))
+(if (= 0 (bit-xor #x0f #x0f)) 0 (sys-exit 49))
+(if (= #x55 (bit-xor #x0f #x33 #x66 #x0f)) 0 (sys-exit 50))
+
+(sys-exit 0)
