From aa92746992fa22e9a58f7a6afd8edb0234cca716 Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Mon, 15 Feb 2021 18:32:14 -0800
Subject: [PATCH] Refactor hiding, \ comments, still working on DOES> fix.

---
 ueforth/common/base_tests.fs       | 14 ++++++++++++
 ueforth/common/boot.fs             |  3 +++
 ueforth/common/source_to_string.js |  1 +
 ueforth/common/vocabulary.fs       | 34 +++++++++++++++++-------------
 ueforth/common/vocabulary_tests.fs | 14 ++++++++++++
 5 files changed, 51 insertions(+), 15 deletions(-)

diff --git a/ueforth/common/base_tests.fs b/ueforth/common/base_tests.fs
index a791e2c..6a45ed0 100644
--- a/ueforth/common/base_tests.fs
+++ b/ueforth/common/base_tests.fs
@@ -66,3 +66,17 @@ e: test-value-to
   bar foo . cr
   out: 99 
 ;e
+
+e: test-comments-interp
+  123 ( Interpretered comment ) 456
+  789 \ Interpretered comment )
+  789 = assert 456 = assert 123 = assert
+;e
+
+e: test-comments-compiled
+  : foo 123 ( Compiled comment ) 456
+        789 \ Interpretered comment )
+        999 ;
+  foo 999 = assert 789 = assert 456 = assert 123 = assert
+;e
+
diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs
index 79afc58..8cc7f49 100644
--- a/ueforth/common/boot.fs
+++ b/ueforth/common/boot.fs
@@ -26,6 +26,9 @@
 : 4* 4 * ;   : 4/ 4 / ;
 : +! ( n a -- ) swap over @ + swap ! ;
 
+( Line Comments )
+: \   nl parse drop drop ; immediate
+
 ( Cells )
 : cell+ ( n -- n ) cell + ;
 : cells ( n -- n ) cell * ;
diff --git a/ueforth/common/source_to_string.js b/ueforth/common/source_to_string.js
index 5846bf5..4d2e5f6 100755
--- a/ueforth/common/source_to_string.js
+++ b/ueforth/common/source_to_string.js
@@ -9,6 +9,7 @@ var revision = process.argv[4];
 
 source = source.replace('{{VERSION}}', version);
 source = source.replace('{{REVISION}}', revision);
+source = source.replace(/\\/g, '\\\\');
 source = source.replace(/["]/g, '\\"');
 source = '"' + source.split('\n').join('\\n"\n"') + '\\n"';
 source = source.replace(/["]  ["]/g, '');
diff --git a/ueforth/common/vocabulary.fs b/ueforth/common/vocabulary.fs
index be2592f..25aeb1d 100644
--- a/ueforth/common/vocabulary.fs
+++ b/ueforth/common/vocabulary.fs
@@ -7,12 +7,13 @@ current @ constant forth-wordlist
 : definitions   context @ current ! ;
 
 ( Make it easy to transfer words between vocabularies )
-: transfer-xt ( xt --  ) context @ begin 2dup @ <> while @ >link& repeat nip
-                         dup @ swap dup @ >link swap ! current @ @ over >link& !   current @ ! ;
-: transfer ( "name" ) ' transfer-xt ;
-: ?transfer ( "name" ) bl parse find dup if transfer-xt else drop then ;
+: xt-find& ( xt -- xt& ) context @ begin 2dup @ <> while @ >link& repeat nip ;
+: xt-hide ( xt -- ) xt-find& dup @ >link swap ! ;
+: xt-transfer ( xt --  ) dup xt-hide   current @ @ over >link& !   current @ ! ;
+: transfer ( "name" ) ' xt-transfer ;
+: ?transfer ( "name" ) bl parse find dup if xt-transfer else drop then ;
 : }transfer ;
-: transfer{ begin ' dup ['] }transfer = if drop exit then transfer-xt again ;
+: transfer{ begin ' dup ['] }transfer = if drop exit then xt-transfer again ;
 
 ( Watered down versions of these )
 : only   forth 0 context cell+ ! ;
@@ -26,17 +27,9 @@ vocabulary internals   internals definitions
 ( Vocabulary chain for current scope, place at the -1 position )
 variable scope   scope context cell - !
 
-( Make DOES> switch to compile mode when interpreted )
-(
-vocabulary partial-does   partial-does definitions
-transfer does>
-only forth definitions also partial-does
-: does>   postpone does> ; immediate
-only internals definitions
-)
-
 transfer{
-  transfer-xt voc-stack-end forth-wordlist
+  xt-find& xt-hide xt-transfer
+  voc-stack-end forth-wordlist
   last-vocabulary
   branch 0branch donext dolit
   'context 'notfound notfound
@@ -49,3 +42,14 @@ transfer{
   tib-setup input-limit
 }transfer
 forth definitions
+
+( Make DOES> switch to compile mode when interpreted )
+(
+forth definitions internals
+' does>
+: does>   state @ if postpone does> exit then
+          ['] constant @ current @ @ dup >r !
+          here r> cell+ ! postpone ] ; immediate
+xt-hide
+forth definitions
+)
diff --git a/ueforth/common/vocabulary_tests.fs b/ueforth/common/vocabulary_tests.fs
index 8a69e95..6206326 100644
--- a/ueforth/common/vocabulary_tests.fs
+++ b/ueforth/common/vocabulary_tests.fs
@@ -87,3 +87,17 @@ e: test-sealed
   out: b
   only forth definitions
 ;e
+
+e: test-fixed-does>-normal
+  : adder create , does> @ + ;
+  3 adder foo
+  4 foo 7 = assert
+  4 ' foo execute 7 = assert
+;e
+
+(
+e: test-fixed-does>-interp
+  create hi 123 , does> @ + ;
+  7 hi 130 = assert
+;e
+)