From 0ebcd064d35d662adce1218bf03cff3535cdd786 Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Fri, 25 Feb 2022 21:38:29 -0800
Subject: [PATCH] Optimized TO.

---
 ueforth/common/boot.fs                  |  4 +++-
 ueforth/common/forth_namespace_tests.fs |  1 -
 ueforth/common/opcodes.h                |  1 +
 ueforth/common/utils.fs                 |  1 +
 ueforth/common/utils_tests.fs           | 30 ++++++++++++++++++++++++-
 ueforth/common/vocabulary.fs            |  2 +-
 6 files changed, 35 insertions(+), 4 deletions(-)

diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs
index 63ea390..510c380 100644
--- a/ueforth/common/boot.fs
+++ b/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
 
diff --git a/ueforth/common/forth_namespace_tests.fs b/ueforth/common/forth_namespace_tests.fs
index 14f7511..e88af7e 100644
--- a/ueforth/common/forth_namespace_tests.fs
+++ b/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 
diff --git a/ueforth/common/opcodes.h b/ueforth/common/opcodes.h
index 84dba4a..011ebfc 100644
--- a/ueforth/common/opcodes.h
+++ b/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)) \
diff --git a/ueforth/common/utils.fs b/ueforth/common/utils.fs
index 6daece4..fbabfb6 100644
--- a/ueforth/common/utils.fs
+++ b/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 +
diff --git a/ueforth/common/utils_tests.fs b/ueforth/common/utils_tests.fs
index f83cf8d..51b5a09 100644
--- a/ueforth/common/utils_tests.fs
+++ b/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
diff --git a/ueforth/common/vocabulary.fs b/ueforth/common/vocabulary.fs
index 7a58e32..63b7e40 100644
--- a/ueforth/common/vocabulary.fs
+++ b/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