coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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
Details

Browse Source
This commit is contained in:
giles
2026-04-25 00:55:34 +00:00
parent 47f66ad1be
commit 89a879799a
6 changed files with 164 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

107
lib/forth/compiler.sx
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<"

6
lib/forth/runtime.sx
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

10
lib/forth/scoreboard.json
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"
}

10
lib/forth/scoreboard.md
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

26
lib/forth/tests/test-phase5.sx
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