From 89a879799a54c1582f101ba70f1911aad4c6b144 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 00:55:34 +0000 Subject: [PATCH] forth: parsing/dictionary '/[']/EXECUTE/LITERAL/POSTPONE/WORD/FIND/>BODY (Hayes 463/638, 72%) --- lib/forth/compiler.sx | 107 ++++++++++++++++++++++++++++++++- lib/forth/runtime.sx | 6 +- lib/forth/scoreboard.json | 10 +-- lib/forth/scoreboard.md | 10 +-- lib/forth/tests/test-phase5.sx | 26 ++++++++ plans/forth-on-sx.md | 19 +++++- 6 files changed, 164 insertions(+), 14 deletions(-) diff --git a/lib/forth/compiler.sx b/lib/forth/compiler.sx index 92593e7c..1f4718b5 100644 --- a/lib/forth/compiler.sx +++ b/lib/forth/compiler.sx @@ -285,6 +285,7 @@ (get s "dict") (downcase (get def "name")) (forth-make-word "colon-def" body-fn false)) + (dict-set! s "last-defined" (get def "name")) (dict-set! s "current-def" nil) (dict-set! s "compiling" false)))))) (forth-def-prim-imm! @@ -711,11 +712,115 @@ (when (nil? name) (forth-error s "CREATE expects name")) (let ((addr (get s "here"))) - (forth-def-prim! s name (fn (ss) (forth-push ss addr))))))) + (forth-def-prim! s name (fn (ss) (forth-push ss addr))) + (let + ((w (forth-lookup s name))) + (dict-set! w "body-addr" addr)))))) (forth-def-prim! state "CELL+" (fn (s) (forth-push s (+ (forth-pop s) 1)))) (forth-def-prim! state "CELLS" (fn (s) nil)) (forth-def-prim! state "ALIGN" (fn (s) nil)) (forth-def-prim! state "ALIGNED" (fn (s) nil)) + (forth-def-prim! + state + "EXECUTE" + (fn (s) (let ((w (forth-pop s))) (forth-execute-word s w)))) + (forth-def-prim! + state + "'" + (fn + (s) + (let + ((name (forth-next-token! s))) + (when (nil? name) (forth-error s "' expects name")) + (let + ((w (forth-lookup s name))) + (when (nil? w) (forth-error s (str name " ?"))) + (forth-push s w))))) + (forth-def-prim-imm! + state + "[']" + (fn + (s) + (let + ((name (forth-next-token! s))) + (when (nil? name) (forth-error s "['] expects name")) + (let + ((w (forth-lookup s name))) + (when (nil? w) (forth-error s (str name " ?"))) + (if + (get s "compiling") + (forth-def-append! s (fn (ss) (forth-push ss w))) + (forth-push s w)))))) + (forth-def-prim-imm! + state + "LITERAL" + (fn + (s) + (let + ((v (forth-pop s))) + (when + (not (get s "compiling")) + (forth-error s "LITERAL outside compile mode")) + (forth-def-append! s (fn (ss) (forth-push ss v)))))) + (forth-def-prim-imm! + state + "POSTPONE" + (fn + (s) + (let + ((name (forth-next-token! s))) + (when (nil? name) (forth-error s "POSTPONE expects name")) + (let + ((w (forth-lookup s name))) + (when (nil? w) (forth-error s (str name " ?"))) + (forth-def-append! + s + (fn + (ss) + (forth-def-append! + ss + (fn (sss) (forth-execute-word sss w))))))))) + (forth-def-prim! + state + ">BODY" + (fn + (s) + (let + ((w (forth-pop s))) + (forth-push s (or (get w "body-addr") 0))))) + (forth-def-prim! + state + "WORD" + (fn + (s) + (let + ((delim (forth-pop s)) (tok (forth-next-token! s))) + (let + ((str-out (or tok ""))) + (let + ((addr (forth-alloc-bytes! s (+ 1 (len str-out))))) + (forth-mem-write! s addr (len str-out)) + (forth-mem-write-string! s (+ addr 1) str-out) + (forth-push s addr)))))) + (forth-def-prim! + state + "FIND" + (fn + (s) + (let + ((c-addr (forth-pop s))) + (let + ((u (forth-mem-read s c-addr))) + (let + ((str-name (forth-mem-read-string s (+ c-addr 1) u))) + (let + ((w (forth-lookup s str-name))) + (if + (nil? w) + (begin (forth-push s c-addr) (forth-push s 0)) + (begin + (forth-push s w) + (forth-push s (if (get w "immediate?") 1 -1)))))))))) (forth-def-prim! state "U<" diff --git a/lib/forth/runtime.sx b/lib/forth/runtime.sx index 3e92eb97..1914e2a7 100644 --- a/lib/forth/runtime.sx +++ b/lib/forth/runtime.sx @@ -208,7 +208,8 @@ (dict-set! (get state "dict") (downcase name) - (forth-make-word "primitive" body false)))) + (forth-make-word "primitive" body false)) + (dict-set! state "last-defined" name))) (define forth-def-prim-imm! @@ -217,7 +218,8 @@ (dict-set! (get state "dict") (downcase name) - (forth-make-word "primitive" body true)))) + (forth-make-word "primitive" body true)) + (dict-set! state "last-defined" name))) (define forth-lookup diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json index 0f3f391c..f1021a6f 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-25T00:22:42Z", + "generated_at": "2026-04-25T00:54:55Z", "chunks_available": 638, "chunks_fed": 638, "total": 638, - "pass": 448, - "fail": 8, - "error": 182, - "percent": 70, + "pass": 463, + "fail": 10, + "error": 165, + "percent": 72, "note": "completed" } diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md index 8fec6650..db0e6443 100644 --- a/lib/forth/scoreboard.md +++ b/lib/forth/scoreboard.md @@ -5,13 +5,13 @@ | chunks available | 638 | | chunks fed | 638 | | total | 638 | -| pass | 448 | -| fail | 8 | -| error | 182 | -| percent | 70% | +| pass | 463 | +| fail | 10 | +| error | 165 | +| percent | 72% | - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr` -- **Generated**: 2026-04-25T00:22:42Z +- **Generated**: 2026-04-25T00:54:55Z - **Note**: completed A "chunk" is any preprocessed segment ending at a `}T` (every Hayes test diff --git a/lib/forth/tests/test-phase5.sx b/lib/forth/tests/test-phase5.sx index 70cc26a8..1469cd65 100644 --- a/lib/forth/tests/test-phase5.sx +++ b/lib/forth/tests/test-phase5.sx @@ -176,6 +176,31 @@ "<# 0 0 65 HOLD #> TYPE" "A"))) +(define + forth-p5-dict-tests + (fn + () + (forth-p5-check-top + "EXECUTE via tick" + ": INC 1+ ; 9 ' INC EXECUTE" + 10) + (forth-p5-check-top + "['] inside def" + ": DUB 2* ; : APPLY ['] DUB EXECUTE ; 5 APPLY" + 10) + (forth-p5-check-top + ">BODY of CREATE word" + "CREATE C 99 , ' C >BODY @" + 99) + (forth-p5-check-stack + "WORD parses next token to counted-string" + ": A 5 ; BL WORD A COUNT TYPE" + (list)) + (forth-p5-check-top + "FIND on known word -> non-zero" + ": A 5 ; BL WORD A FIND SWAP DROP" + -1))) + (define forth-p4-check-output-passthrough (fn @@ -195,6 +220,7 @@ (forth-p5-mixed-tests) (forth-p5-double-tests) (forth-p5-format-tests) + (forth-p5-dict-tests) (dict "passed" forth-p5-passed diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index 4a26c02e..4bd5d73a 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -90,7 +90,7 @@ Representation: - [x] Mixed/double-cell math: `S>D`, `M*`, `UM*`, `UM/MOD`, `FM/MOD`, `SM/REM`, `*/`, `*/MOD` - [x] Double-cell ops: `D+`, `D-`, `D=`, `D<`, `D0=`, `2DUP`, `2DROP`, `2OVER`, `2SWAP` (already), plus `D>S`, `DABS`, `DNEGATE` - [x] Number formatting: `<#`, `#`, `#S`, `#>`, `HOLD`, `SIGN`, `.R`, `U.`, `U.R` -- [ ] Parsing/dictionary: `WORD`, `FIND`, `EXECUTE`, `'`, `[']`, `LITERAL`, `POSTPONE`, `>BODY`, `DOES>` +- [x] Parsing/dictionary: `WORD`, `FIND`, `EXECUTE`, `'`, `[']`, `LITERAL`, `POSTPONE`, `>BODY` (DOES> deferred — needs runtime-rebind of last CREATE) - [ ] Source/state: `SOURCE`, `>IN`, `EVALUATE`, `STATE`, `[`, `]` - [ ] Misc Core: `WITHIN`, `MAX`/`MIN` (already), `ABORT`, `ABORT"`, `EXIT`, `UNLOOP` - [ ] File Access word set (via SX IO) @@ -106,6 +106,23 @@ Representation: _Newest first._ +- **Phase 5 — parsing/dictionary words `'`/`[']`/`EXECUTE`/`LITERAL`/ + `POSTPONE`/`WORD`/`FIND`/`>BODY` (Hayes 448→463, 72%).** xt is + represented as the SX dict reference of the word record, so + `'`/`[']` push the looked-up record and `EXECUTE` calls + `forth-execute-word` on the popped value. `LITERAL` (IMMEDIATE) + pops a value at compile time and emits a push-op. `POSTPONE` + (IMMEDIATE) compiles into the *outer* def an op that, when run + during a *later* compile, appends a call-w op to whatever def is + current — the standard two-tier compile semantic. Added + `state.last-defined` tracked by every primitive/colon definition + so `IMMEDIATE` can target the most-recent word even after `;` + closes the def. CREATE now stashes its data-field address on the + word record so `>BODY` can recover it. `WORD`/`FIND` use the byte + memory and counted-string layout already in place. + `DOES>` is deferred — needs a runtime mechanism to rebind the + last-CREATE'd word's action. + - **Phase 5 — pictured numeric output: `<#`/`#`/`#S`/`#>`/`HOLD`/`SIGN` + `U.`/`U.R`/`.R` (+9; Hayes 446→448, 70%).** Added a `state.hold` list of single-character strings — `<#` resets it, `HOLD` and