Improved SEE

ueforth/common/boot.fs

@@ -189,10 +189,23 @@ variable hld
 ( Examine Dictionary )
 : see. ( xt -- ) >name type space ;
 : see-one ( xt -- xt+1 )
-   dup @ dup ['] DOLIT = if drop cell+ dup @ . else see. then cell+ ;
+   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 see-one dup @ exit= until ;
-: see   cr ['] : see.  ' dup see.  space see-loop drop  ['] ; see.  cr ;
+: 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 ;
 75 value line-width
 : onlines ( n xt -- n xt )
    swap dup line-width > if drop 0 cr then over >name nip + 1+ swap ;

ueforth/common/testing.fs

@@ -20,6 +20,7 @@ variable expect-used   variable result-used
 : result-type ( a n -- ) for aft dup c@ result-emit 1+ then next drop ;
 : expected ( -- a n ) expect-buffer expect-used @ ;
 : resulted ( -- a n ) result-buffer result-used @ ;
+: out:cr   nl expect-emit ;
 : out: ( "line" -- ) nl parse expect-type nl expect-emit ;
 : out:\ ( "line" -- ) nl parse expect-type ;
 variable confirm-old-type

ueforth/common/utils.fs

@@ -1,4 +1,6 @@
 ( Words built after boot )
+
+( For tests and asserts )
 : assert ( f -- ) 0= throw ;
 
 internals definitions
@@ -8,6 +10,7 @@ forth definitions also internals
 : str= ( a n a n -- f) >r swap r@ <> if rdrop 2drop 0 exit then r> mem= ;
 : startswith? ( a n a n -- f ) >r swap r@ < if rdrop 2drop 0 exit then r> mem= ;
 : .s   ." <" depth n. ." > " raw.s cr ;
+: see-all   0 context @ @ begin dup while onlines dup see-xt >link repeat 2drop cr ;
 only forth definitions
 
 : forget ( "name" ) ' dup >link current @ !  >name drop here - allot ;

ueforth/common/utils_tests.fs

@@ -26,3 +26,38 @@ e: test-forget
   current @ = assert
   context @ @ = assert
 ;e
+
+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