Optimized TO.

ueforth/common/boot.fs

@@ -98,7 +98,9 @@ variable handler
 ( Values )
 : value ( n -- ) constant ;
 : value-bind ( xt-val xt )
-   >r >body state @ if aliteral r> , else r> execute then ;
+   >r >body state @ if
+     r@ ['] ! = if rdrop ['] doset , , else aliteral r> , then
+   else r> execute then ;
 : to ( n -- ) ' ['] ! value-bind ; immediate
 : +to ( n -- ) ' ['] +! value-bind ; immediate
 

ueforth/common/forth_namespace_tests.fs

@@ -93,7 +93,6 @@ e: check-boot
   out: defer 
   out: +to 
   out: to 
-  out: value-bind 
   out: value 
   out: throw 
   out: catch 

ueforth/common/opcodes.h

@@ -112,6 +112,7 @@ typedef struct {
   YV(internals, 0BRANCH, if (!tos) ip = (cell_t *) *ip; else ++ip; DROP) \
   YV(internals, DONEXT, *rp = *rp - 1; if (~*rp) ip = (cell_t *) *ip; else (--rp, ++ip)) \
   YV(internals, DOLIT, DUP; tos = *ip++) \
+  YV(internals, DOSET, *((cell_t *) *ip++) = tos; DROP) \
   YV(internals, DOCOL, ++rp; *rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t))) \
   YV(internals, DOCON, DUP; tos = *(cell_t *) (w + sizeof(cell_t))) \
   YV(internals, DOVAR, DUP; tos = w + sizeof(cell_t)) \

ueforth/common/utils.fs

@@ -44,6 +44,7 @@ internals definitions
 : see-one ( xt -- xt+1 )
    dup cell+ swap @
    dup ['] DOLIT = if drop dup @ . cell+ exit then
+   dup ['] DOSET = if drop ." TO " dup @ cell - see. cell+ exit then
    dup ['] DOFLIT = if drop dup sf@ <# [char] e hold #fs #> type space cell+ exit then
    dup ['] $@ = if drop ['] s" see.
                    dup @ dup >r >r dup cell+ r> type cell+ r> 1+ aligned +

ueforth/common/utils_tests.fs

@@ -71,7 +71,7 @@ e: test-see-fornext
   out: : test  >R DONEXT ; 
 ;e
 
-e: test-string-strides
+e: test-see-string-strides
   : test0 1 if ." " then ;
   : test1 1 if ." >" then ;
   : test2 1 if ." ->" then ;
@@ -108,3 +108,31 @@ e: test-noname
   . cr
   out: 16 
 ;e
+
+e: test-see-variable
+  variable foo
+  : bar foo @ . ;
+  see bar
+  out: : bar  foo @ . ; 
+;e
+
+e: test-see-create
+  create foo
+  : bar foo @ . ;
+  see bar
+  out: : bar  foo @ . ; 
+;e
+
+e: test-see-value
+  0 value foo
+  : bar foo . ;
+  see bar
+  out: : bar  foo . ; 
+;e
+
+e: test-see-to
+  0 value foo
+  : bar 123 to foo ;
+  see bar
+  out: : bar  123 TO foo ; 
+;e

ueforth/common/vocabulary.fs

@@ -54,7 +54,7 @@ transfer{
   xt-find& xt-hide xt-transfer
   voc-stack-end last-vocabulary notfound
   immediate? input-buffer ?echo ?arrow. arrow
-  evaluate-buffer aliteral
+  evaluate-buffer aliteral value-bind
   leaving( )leaving leaving leaving,
   (do) (?do) (+loop) 
   parse-quote digit $@ raw.s