From 979e01b917589395c869739d4e1840d29edcdd6e Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Fri, 12 Feb 2021 21:16:06 -0800
Subject: [PATCH] Moved see into utils.

---
 ueforth/Makefile              |  5 ++++-
 ueforth/common/boot.fs        | 21 ---------------------
 ueforth/common/utils.fs       | 28 +++++++++++++++++++++++++++-
 ueforth/common/utils_tests.fs |  5 -----
 ueforth/common/vocabulary.fs  |  4 +---
 5 files changed, 32 insertions(+), 31 deletions(-)

diff --git a/ueforth/Makefile b/ueforth/Makefile
index 119b004..5ad9147 100644
--- a/ueforth/Makefile
+++ b/ueforth/Makefile
@@ -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):
diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs
index 6dcd657..533c2b3 100644
--- a/ueforth/common/boot.fs
+++ b/ueforth/common/boot.fs
@@ -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 !
diff --git a/ueforth/common/utils.fs b/ueforth/common/utils.fs
index 0dc7d12..a469adb 100644
--- a/ueforth/common/utils.fs
+++ b/ueforth/common/utils.fs
@@ -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
diff --git a/ueforth/common/utils_tests.fs b/ueforth/common/utils_tests.fs
index e5e9eec..f1dbb2c 100644
--- a/ueforth/common/utils_tests.fs
+++ b/ueforth/common/utils_tests.fs
@@ -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
diff --git a/ueforth/common/vocabulary.fs b/ueforth/common/vocabulary.fs
index 0f19455..adade5a 100644
--- a/ueforth/common/vocabulary.fs
+++ b/ueforth/common/vocabulary.fs
@@ -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