forth: parsing/dictionary '/[']/EXECUTE/LITERAL/POSTPONE/WORD/FIND/>BODY (Hayes 463/638, 72%)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-25 00:55:34 +00:00
parent 47f66ad1be
commit 89a879799a
6 changed files with 164 additions and 14 deletions

View File

@@ -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<"

View File

@@ -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

View File

@@ -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"
}

View File

@@ -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

View File

@@ -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

View File

@@ -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