giles
55f3024743
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
81 lines
1.9 KiB
Plaintext
81 lines
1.9 KiB
Plaintext
;; Forth interpreter loop — interpret mode only (Phase 1).
|
|
;; Reads whitespace-delimited words, looks them up, executes.
|
|
;; Numbers (parsed via BASE) push onto the data stack.
|
|
;; Unknown words raise "?".
|
|
|
|
(define
|
|
forth-execute-word
|
|
(fn
|
|
(state word)
|
|
(dict-set! word "call-count" (+ 1 (or (get word "call-count") 0)))
|
|
(let ((body (get word "body"))) (body state))))
|
|
|
|
(define
|
|
forth-hot-words
|
|
(fn
|
|
(state threshold)
|
|
(forth-hot-walk
|
|
(keys (get state "dict"))
|
|
(get state "dict")
|
|
threshold
|
|
(list))))
|
|
|
|
(define
|
|
forth-hot-walk
|
|
(fn
|
|
(names dict threshold acc)
|
|
(if
|
|
(= (len names) 0)
|
|
acc
|
|
(let
|
|
((n (first names)))
|
|
(let
|
|
((w (get dict n)))
|
|
(let
|
|
((c (or (get w "call-count") 0)))
|
|
(forth-hot-walk
|
|
(rest names)
|
|
dict
|
|
threshold
|
|
(if (>= c threshold) (cons (list n c) acc) acc))))))))
|
|
|
|
(define
|
|
forth-interpret-token
|
|
(fn
|
|
(state tok)
|
|
(let
|
|
((w (forth-lookup state tok)))
|
|
(if
|
|
(not (nil? w))
|
|
(forth-execute-word state w)
|
|
(let
|
|
((n (forth-parse-number tok (get (get state "vars") "base"))))
|
|
(if
|
|
(not (nil? n))
|
|
(forth-push state n)
|
|
(forth-error state (str tok " ?"))))))))
|
|
|
|
(define
|
|
forth-interpret
|
|
(fn
|
|
(state src)
|
|
(for-each
|
|
(fn (tok) (forth-interpret-token state tok))
|
|
(forth-tokens src))
|
|
state))
|
|
|
|
;; Convenience: build a fresh state with primitives loaded.
|
|
(define
|
|
forth-boot
|
|
(fn () (let ((s (forth-make-state))) (forth-install-primitives! s) s)))
|
|
|
|
;; Run source on a fresh state and return (state, output, stack-top-to-bottom).
|
|
(define
|
|
forth-run
|
|
(fn
|
|
(src)
|
|
(let
|
|
((s (forth-boot)))
|
|
(forth-interpret s src)
|
|
(list s (get s "output") (reverse (get s "dstack"))))))
|