Moved see into utils.
This commit is contained in:
@ -106,11 +106,14 @@ clean:
|
||||
|
||||
# ---- TESTS ----
|
||||
|
||||
tests: unit_tests
|
||||
tests: unit_tests see_all_test
|
||||
|
||||
unit_tests: $(POSIX)/ueforth common/all_tests.fs
|
||||
$^
|
||||
|
||||
see_all_test: $(POSIX)/ueforth
|
||||
echo "internals see-all bye" | $< >/dev/null
|
||||
|
||||
# ---- GENERATED ----
|
||||
|
||||
$(GEN):
|
||||
|
||||
@ -186,27 +186,6 @@ variable hld
|
||||
if cr ." ERROR: " type ." NOT FOUND!" cr -1 throw then ;
|
||||
' notfound 'notfound !
|
||||
|
||||
( Examine Dictionary )
|
||||
: see. ( xt -- ) >name type space ;
|
||||
: see-one ( xt -- xt+1 )
|
||||
dup cell+ swap @
|
||||
dup ['] DOLIT = if drop dup @ . cell+ exit then
|
||||
dup ['] $@ = if drop ['] s" see.
|
||||
dup @ dup >r >r dup cell+ r> type cell+ r> aligned +
|
||||
[char] " emit space exit then
|
||||
dup ['] BRANCH =
|
||||
over ['] 0BRANCH = or
|
||||
over ['] DONEXT = or
|
||||
if see. cell+ exit then
|
||||
see. ;
|
||||
: exit= ( xt -- ) ['] exit = ;
|
||||
: see-loop >body begin dup @ exit= 0= while see-one repeat drop ;
|
||||
: see-xt ( xt -- )
|
||||
cr dup @ ['] see-loop @ <>
|
||||
if ." Unsupported word type: " see. cr exit then
|
||||
['] : see. dup see. space see-loop ['] ; see. cr ;
|
||||
: see ' see-xt ;
|
||||
|
||||
( Input )
|
||||
: raw.s depth 0 max for aft sp@ r@ cells - @ . then next ;
|
||||
variable echo -1 echo !
|
||||
|
||||
@ -19,6 +19,33 @@ forth definitions also internals
|
||||
: .s ." <" depth n. ." > " raw.s cr ;
|
||||
only forth definitions
|
||||
|
||||
( Definitions building to SEE and ORDER )
|
||||
internals definitions
|
||||
: see. ( xt -- ) >name type space ;
|
||||
: see-one ( xt -- xt+1 )
|
||||
dup cell+ swap @
|
||||
dup ['] DOLIT = if drop dup @ . cell+ exit then
|
||||
dup ['] $@ = if drop ['] s" see.
|
||||
dup @ dup >r >r dup cell+ r> type cell+ r> aligned +
|
||||
[char] " emit space exit then
|
||||
dup ['] BRANCH =
|
||||
over ['] 0BRANCH = or
|
||||
over ['] DONEXT = or
|
||||
if see. cell+ exit then
|
||||
see. ;
|
||||
: exit= ( xt -- ) ['] exit = ;
|
||||
: see-loop >body begin dup @ exit= 0= while see-one repeat drop ;
|
||||
: see-xt ( xt -- )
|
||||
dup @ ['] see-loop @ <>
|
||||
if ." Unsupported word type: " see. cr exit then
|
||||
['] : see. dup see. space see-loop ['] ; see. cr ;
|
||||
: see-all 0 context @ @ begin dup while dup see-xt >link repeat 2drop cr ;
|
||||
: voc. ( voc -- ) dup forth-wordlist = if ." FORTH " drop exit then 3 cells - see. ;
|
||||
forth definitions also internals
|
||||
: see ' see-xt ;
|
||||
: order context begin dup @ while dup @ voc. cell+ repeat drop cr ;
|
||||
only forth definitions
|
||||
|
||||
( List words in Dictionary / Vocabulary )
|
||||
internals definitions
|
||||
75 value line-width
|
||||
@ -28,5 +55,4 @@ internals definitions
|
||||
forth definitions also internals
|
||||
: vlist 0 context @ @ begin dup >name-length while onlines dup see. >link repeat 2drop cr ;
|
||||
: words 0 context @ @ begin dup while onlines dup see. >link repeat 2drop cr ;
|
||||
: see-all 0 context @ @ begin dup while onlines dup see-xt >link repeat 2drop cr ;
|
||||
only forth definitions
|
||||
|
||||
@ -30,34 +30,29 @@ e: test-forget
|
||||
e: test-see-number
|
||||
: test 123 456 ;
|
||||
see test
|
||||
out:cr
|
||||
out: : test 123 456 ;
|
||||
;e
|
||||
|
||||
e: test-see-string
|
||||
: test s" hello there" ;
|
||||
see test
|
||||
out:cr
|
||||
out: : test s" hello there" ;
|
||||
;e
|
||||
|
||||
e: test-see-branch
|
||||
: test begin again ;
|
||||
see test
|
||||
out:cr
|
||||
out: : test BRANCH ;
|
||||
;e
|
||||
|
||||
e: test-see-0branch
|
||||
: test begin until ;
|
||||
see test
|
||||
out:cr
|
||||
out: : test 0BRANCH ;
|
||||
;e
|
||||
|
||||
e: test-see-fornext
|
||||
: test for next ;
|
||||
see test
|
||||
out:cr
|
||||
out: : test >R DONEXT ;
|
||||
;e
|
||||
|
||||
@ -19,13 +19,11 @@ current @ constant forth-wordlist
|
||||
: voc-stack-end ( -- a ) context begin dup @ while cell+ repeat ;
|
||||
: also context context cell+ voc-stack-end over - 2 cells + cmove> ;
|
||||
: sealed 0 last-vocabulary @ >body cell+ ! ;
|
||||
: voc. ( voc -- ) dup forth-wordlist = if ." FORTH " drop exit then 3 cells - see. ;
|
||||
: order context begin dup @ while dup @ voc. cell+ repeat drop cr ;
|
||||
|
||||
( Hide some words in an internals vocabulary )
|
||||
vocabulary internals internals definitions
|
||||
transfer{
|
||||
transfer-xt voc-stack-end forth-wordlist voc.
|
||||
transfer-xt voc-stack-end forth-wordlist
|
||||
last-vocabulary
|
||||
branch 0branch donext dolit
|
||||
'context 'notfound notfound
|
||||
|
||||
Reference in New Issue
Block a user