commit 80d020d670c6ae7d9443d603301d7a989b1a7c7a
parent 55aff4595c1c22c2a6a3bd402153a547a57ad516
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Sat, 25 Apr 2026 13:58:21 -0700
scheme1: > primitive, positive? prelude entry, comparison test coverage
Adds prim_gt (mirrors prim_lt with swapped operands to %blt), uncomments
positive? in the prelude now that > is available, and extends
25-comparisons.scm with both directions of >, positive?, and negative?.
TODO doc trimmed: remove completed bug entries, drop already-implemented
helpers from the missing-primitives list, and add > to the 2-arg-only set.
Diffstat:
5 files changed, 50 insertions(+), 42 deletions(-)
diff --git a/docs/scheme-shell-todo.md b/docs/scheme-shell-todo.md
@@ -25,48 +25,22 @@ gap that must be addressed before calling scheme1 shippable.
redefining `spawn` at user level. Until this is understood, the
prelude's `spawn` and `run` are effectively unverified.
-- [x] **No heap-exhaustion check.** `cons`, `alloc_hdr`, and
- `alloc_bytes` now compare `heap_next + bytes` against `:heap_end`
- (initialized to `heap_buf_ptr + HEAP_CAP_BYTES` at startup) and abort
- via `runtime_error` on overflow. `load_source` and `eval_prelude`
- reject sources that would overrun `READBUF_CAP_BYTES`.
-
-- [x] **No symtab-name copy bound.** Name copies still go through
- `alloc_bytes`, but that path now errors cleanly when the heap arena
- is exhausted instead of silently scribbling into the symtab.
- `intern`'s 1024-slot count check remains and routes through the same
- `runtime_error`.
-
-- [x] **Bytevector-u8-set! / -ref / -copy / -copy! have no bounds
- check.** All four now check `0 <= idx < length` (or
- `0 <= start <= end <= length`, plus the dst-side range for
- `bytevector-copy!`) and abort via `runtime_error`. `make-bytevector`
- and `bytevector-grow!` reject negative arguments through the same
- path.
-
-- [ ] **`car` / `cdr` of non-pair, `quotient`/`remainder` of zero, etc.,
- are silent UB** — same policy as above, no abort path.
-
## Spec features still missing
Per LISP.md and LISP-C.md, but not implemented:
- [ ] **Special forms missing**: `set!`, `pmatch`, `cond`'s
- `=>` arrow form. `pmatch` is called out by LISP-C.md as a built-in
- special form needed by the self-hosted compiler.
+ `=>` arrow form.
- [ ] **Primitives missing** (LISP.md lists them as required):
- Predicates: `boolean?`, `integer?`, `string?`, `procedure?`,
`record?`, `record-type?`
- Numeric: `quotient`, `remainder`, `modulo`,
- `negative?`, `abs`, `min`, `max`, `bit-xor`,
+ `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)
+ - Pair / list: `set-car!`, `set-cdr!`, `length`,
- Bytevector: `bytevector-append`, `bytevector=?`, `string->symbol`,
`symbol->string`
-- [ ] **`+ - * = <` are 2-arg only.** R7RS allows any arity.
-- [ ] **`apply` is variadic on the trailing list** but otherwise
- unverified for arity edge cases.
+- [ ] **`+ - * = < >` are 2-arg only.** R7RS allows any arity.
- [ ] **Type names are not bound by `define-record-type`.** The TD is
reachable only via the parameterized prims that close over it; no
`record-type-of`, no way to inspect a TD from user code. Spec is
diff --git a/scheme1/prelude.scm b/scheme1/prelude.scm
@@ -12,9 +12,7 @@
(define (>= x y) (if (< x y) #f #t))
(define (negative? x) (< x 0))
-
-; positive? needs `>`, which is not yet a primitive.
-; (define (positive? x) (> x 0))
+(define (positive? x) (> x 0))
(define (abs x) (if (< x 0) (- 0 x) x))
diff --git a/scheme1/scheme1.P1pp b/scheme1/scheme1.P1pp
@@ -2272,6 +2272,18 @@
%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)
+ %li(a0, %imm_val(%IMM.FALSE))
+ ::end
+ %ret
+%endscope
+
:prim_bit_and_entry
%car(t0, a0)
%cdr(t1, a0)
@@ -4143,6 +4155,7 @@
:name_mult "*"
:name_eq "="
:name_lt "<"
+:name_gt ">"
:name_bit_and "bit-and"
:name_bit_or "bit-or"
:name_arith_shift "arithmetic-shift"
@@ -4211,6 +4224,7 @@
&name_mult %(0) $(1) &prim_mult_entry %(0)
&name_eq %(0) $(1) &prim_eq_entry %(0)
&name_lt %(0) $(1) &prim_lt_entry %(0)
+&name_gt %(0) $(1) &prim_gt_entry %(0)
&name_bit_and %(0) $(7) &prim_bit_and_entry %(0)
&name_bit_or %(0) $(6) &prim_bit_or_entry %(0)
&name_arith_shift %(0) $(16) &prim_arith_shift_entry %(0)
diff --git a/tests/scheme1/25-comparisons.expected-exit b/tests/scheme1/25-comparisons.expected-exit
@@ -1 +1 @@
-26
+33
diff --git a/tests/scheme1/25-comparisons.scm b/tests/scheme1/25-comparisons.scm
@@ -1,4 +1,6 @@
-; <, =, zero?, not, eq?, pair?, null? interact correctly with truthiness.
+; <, =, zero?, not, eq?, pair?, null?, >, positive?, negative? interact
+; correctly with truthiness. Failure at depth N exits N (1..16); full
+; success exits 33.
(sys-exit
(if (< 3 5)
(if (= 4 4)
@@ -6,10 +8,30 @@
(if (not (pair? '()))
(if (pair? (cons 1 2))
(if (null? '())
- (if (eq? 'a 'a) 26 1)
- 2)
- 3)
- 4)
- 5)
- 6)
- 7))
+ (if (eq? 'a 'a)
+ (if (> 5 3)
+ (if (not (> 3 5))
+ (if (not (> 4 4))
+ (if (positive? 7)
+ (if (not (positive? -5))
+ (if (not (positive? 0))
+ (if (negative? -3)
+ (if (not (negative? 3))
+ (if (not (negative? 0))
+ 33
+ 1)
+ 2)
+ 3)
+ 4)
+ 5)
+ 6)
+ 7)
+ 8)
+ 9)
+ 10)
+ 11)
+ 12)
+ 13)
+ 14)
+ 15)
+ 16))
