From 35ce18eb976f2f369b4cf2e2fceba62649ab0d7d Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 24 Apr 2026 20:12:31 +0000 Subject: [PATCH] forth: CHAR/[CHAR]/KEY/ACCEPT (+7; Hayes 174/590) --- lib/forth/compiler.sx | 50 ++++++++++++++++++++++++++++++++++ lib/forth/scoreboard.json | 8 +++--- lib/forth/scoreboard.md | 8 +++--- lib/forth/tests/test-phase4.sx | 30 ++++++++++++++++++++ plans/forth-on-sx.md | 11 +++++++- 5 files changed, 98 insertions(+), 9 deletions(-) diff --git a/lib/forth/compiler.sx b/lib/forth/compiler.sx index 6806c4ae..6083c7dc 100644 --- a/lib/forth/compiler.sx +++ b/lib/forth/compiler.sx @@ -457,6 +457,56 @@ (for-each (fn (t) (dict-set! t "v" exit-pc)) (get marker "leaves")))))) + (forth-def-prim! + state + "CHAR" + (fn + (s) + (let + ((tok (forth-next-token! s))) + (when (nil? tok) (forth-error s "CHAR expects a word")) + (forth-push s (char-code (substr tok 0 1)))))) + (forth-def-prim-imm! + state + "[CHAR]" + (fn + (s) + (let + ((tok (forth-next-token! s))) + (when (nil? tok) (forth-error s "[CHAR] expects a word")) + (let + ((c (char-code (substr tok 0 1)))) + (if + (get s "compiling") + (forth-def-append! s (fn (ss) (forth-push ss c))) + (forth-push s c)))))) + (forth-def-prim! + state + "KEY" + (fn + (s) + (let + ((kb (or (get s "keybuf") ""))) + (if + (= (len kb) 0) + (forth-error s "KEY: no input available") + (begin + (forth-push s (char-code (substr kb 0 1))) + (dict-set! s "keybuf" (substr kb 1 (- (len kb) 1)))))))) + (forth-def-prim! + state + "ACCEPT" + (fn + (s) + (let + ((n1 (forth-pop s)) (addr (forth-pop s))) + (let + ((kb (or (get s "keybuf") ""))) + (let + ((n (if (< n1 (len kb)) n1 (len kb)))) + (forth-mem-write-string! s addr (substr kb 0 n)) + (dict-set! s "keybuf" (substr kb n (- (len kb) n))) + (forth-push s n)))))) (forth-def-prim-imm! state "S\"" diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json index bc7449e5..452083a3 100644 --- a/lib/forth/scoreboard.json +++ b/lib/forth/scoreboard.json @@ -1,12 +1,12 @@ { "source": "gerryjackson/forth2012-test-suite src/core.fr", - "generated_at": "2026-04-24T19:45:15Z", + "generated_at": "2026-04-24T20:12:09Z", "chunks_available": 638, "chunks_fed": 590, "total": 590, - "pass": 168, + "pass": 174, "fail": 0, - "error": 422, - "percent": 28, + "error": 416, + "percent": 29, "note": "completed" } diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md index 5cd55b41..989c08f6 100644 --- a/lib/forth/scoreboard.md +++ b/lib/forth/scoreboard.md @@ -5,13 +5,13 @@ | chunks available | 638 | | chunks fed | 590 | | total | 590 | -| pass | 168 | +| pass | 174 | | fail | 0 | -| error | 422 | -| percent | 28% | +| error | 416 | +| percent | 29% | - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr` -- **Generated**: 2026-04-24T19:45:15Z +- **Generated**: 2026-04-24T20:12:09Z - **Note**: completed A "chunk" is any preprocessed segment ending at a `}T` (every Hayes test diff --git a/lib/forth/tests/test-phase4.sx b/lib/forth/tests/test-phase4.sx index 0c9816cd..5bdcce97 100644 --- a/lib/forth/tests/test-phase4.sx +++ b/lib/forth/tests/test-phase4.sx @@ -143,6 +143,34 @@ "5 CHAR+" 6))) +(define + forth-p4-char-tests + (fn + () + (forth-p4-check-top "CHAR A -> 65" "CHAR A" 65) + (forth-p4-check-top "CHAR x -> 120" "CHAR x" 120) + (forth-p4-check-top "CHAR takes only first char" "CHAR HELLO" 72) + (forth-p4-check-top + "[CHAR] compiles literal" + ": AA [CHAR] A ; AA" + 65) + (forth-p4-check-top + "[CHAR] reads past IMMEDIATE" + ": ZZ [CHAR] Z ; ZZ" + 90) + (forth-p4-check-stack-size + "[CHAR] doesn't leak at compile time" + ": FOO [CHAR] A ; " + 0))) + +(define + forth-p4-key-accept-tests + (fn + () + (let + ((r (forth-run "1000 2 ACCEPT"))) + (let ((stk (nth r 2))) (forth-p4-assert "ACCEPT empty buf -> 0" (list 0) stk))))) + (define forth-p4-run-all (fn @@ -155,6 +183,8 @@ (forth-p4-fill-tests) (forth-p4-cmove-tests) (forth-p4-charplus-tests) + (forth-p4-char-tests) + (forth-p4-key-accept-tests) (dict "passed" forth-p4-passed diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index 4539fbb3..850ea9e7 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -79,7 +79,7 @@ Representation: ### Phase 4 — strings + more Core - [x] `S"`, `C"`, `."`, `TYPE`, `COUNT`, `CMOVE`, `FILL`, `BLANK` -- [ ] `CHAR`, `[CHAR]`, `KEY`, `ACCEPT` +- [x] `CHAR`, `[CHAR]`, `KEY`, `ACCEPT` - [ ] `BASE` manipulation: `DECIMAL`, `HEX` - [ ] `DEPTH`, `SP@`, `SP!` - [ ] Drive Hayes Core pass-rate up @@ -99,6 +99,15 @@ Representation: _Newest first._ +- **Phase 4 — `CHAR`/`[CHAR]`/`KEY`/`ACCEPT` (+7 / Hayes 168→174).** + `CHAR` parses the next token and pushes the first-char code. `[CHAR]` + is IMMEDIATE: in compile mode it embeds the code as a compiled push + op, in interpret mode it pushes inline. `KEY`/`ACCEPT` read from an + optional `state.keybuf` string — empty buffer makes `KEY` raise + `"no input available"` (matches ANS when stdin is closed) and + `ACCEPT` returns `0`. Enough for Hayes to get past CHAR-gated + clusters; real interactive IO lands later. + - **Phase 4 — strings: `S"`/`C"`/`."`/`TYPE`/`COUNT`/`CMOVE`/`CMOVE>`/`MOVE`/`FILL`/`BLANK`/`C@`/`C!`/`CHAR+`/`CHARS` (+16 / Hayes 165→168).** Added a byte-addressable memory model to state: `mem` (dict keyed by stringified address → integer byte) and `here` (next-free integer