place a trap inside the hex-transformed nlabel-transform-one

this will be used to cause it to apply a tilde alternate, but the lexing code for that needs to be refactored first

also, this has an implementation of nexit, a new flow-control word for a scary style of metaprogramming

Force-Push: yes
Change-Id: Ic7fe2d50a8ee21cf9fa5fef1fef4408c2935bb4c

3 files changed, 97 insertions, 0 deletions

diff --git a/README.txt b/README.txt
index 71ff62c..1e1094d 100644
--- a/README.txt
+++ b/README.txt
@@ -133,6 +133,32 @@ takes care not to encourage programming habits that would burn through memory
 space.
 
 
+ ~~~~~~~~~~~~~~~~~~~~~
+~~ Advanced features ~~
+ ~~~~~~~~~~~~~~~~~~~~~
+
+TODO where should this go? should there be an interactive tutorial?
+
+: baz ." baz baz baz!" newline 1 nexit ;
+: bar ." bar start" newline baz baz baz ." bar end" newline ;
+: foo ." foo start" newline bar ." foo end" newline ;
+foo
+foo start
+bar start
+baz baz baz!
+baz baz baz!
+baz baz baz!
+bar end
+foo end
+: baz ." baz baz baz!" newline 2 nexit ;
+: bar ." bar start" newline baz baz baz ." bar end" newline ;
+: foo ." foo start" newline bar ." foo end" newline ;
+foo
+foo start
+bar start
+baz baz baz!
+
+
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ~~ Reading Evocation's source code ~~
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/flow-control.e b/flow-control.e
index bee5038..25a1931 100644
--- a/flow-control.e
+++ b/flow-control.e
@@ -127,3 +127,25 @@
   6 8 * + swap drop + swap drop -1 * ,
   ; make-immediate
 
+
+~   This is a helper which does non-local exit by directly overwriting the
+~ control stack, then calling regular "exit" (implicitly as part of its own
+~ semicolon). The name "nexit" is short for n-exit, meaning that it takes a
+~ parameter which tells it how many times to exit.
+~
+~   1 nexit is equivalent to regular "exit". 2 nexit is equivalent to asking
+~ your own caller to exit. 0 nexit does nothing.
+~
+~   This style of programming isn't encouraged, but may be useful when doing
+~ code that transforms other code.
+~
+~   This is much lower-level than the other flow-control stuff, but it isn't
+~ compatible with the label transform due to relying on r0, so it needs to go
+~ somewhere other than core.e, and this was the closest fit.
+~
+~   Anecdotally, this feature is traditionally called "shunt", and sometimes
+~ "rdrop".
+~
+~ (count --)
+: nexit 8 * control@ + r0 @ min control! ;
+
diff --git a/transform.e b/transform.e
index 1d6d830..6d5907c 100644
--- a/transform.e
+++ b/transform.e
@@ -5279,6 +5279,54 @@ allocate-transformation-state s" transformation-state" variable
     } while drop ;
 
 
+: hex-label-word-replacement
+  word
+
+  value@
+  dup s" ~" stringcmp 0 = {
+    ~ We won't be going back to label-transform-one; clear away its state.
+    drop dropstring
+
+    ~   TODO we would very much like to run hex-tilde-alternate here, but it
+    ~ needs to be refactored first.
+    transformation-state transformation-state-saved-latest @
+    s" ~" find-in
+    entry-to-execution-token execute
+
+    ~   Return directly to label-transform, faking the "not done" return value
+    ~ from label-transform-one.
+    0
+    2 nexit
+  } if
+  drop ;
+
+
+~   Just as hex-allocate-alternate has the job of installing
+~ hex-allocate-replacement in only one single spot, so hex-word-alternate has
+~ the job of installing hex-label-word-replacement. It gets installed when
+~ "word" is called from lexically within label-transform-one, and at no other
+~ time.
+~
+~   Its structure is highly similar to that of hex-allocate-alternate.
+: hex-word-alternate
+  interpreter-flags @ 0x01 & {
+    ~ Compile mode.
+    latest @ entry-to-name dup s" label-transform-one" stringcmp 0 = {
+      ~ In label-transform-one.
+      drop
+      ' hex-label-word-replacement entry-to-execution-token ,
+    } {
+      ~ Not in label-transform-one.
+      drop
+      s" word" find entry-to-execution-token ,
+    } if-else
+  } {
+    ~ Immediate mode.
+    s" word" find
+    dup { entry-to-execution-token execute } { drop allocate } if-else
+  } if-else ; make-immediate
+
+
 ~   This implements the hex transform for a single word. It is directly
 ~ analogous to "interpret", and reading interpret.e may help in understanding
 ~ it, though it's meant to still make sense on its own.
@@ -5352,6 +5400,7 @@ allocate-transformation-state s" transformation-state" variable
   dup s" bye" stringcmp 0 = { swap drop ' hex-bye-alternate swap } if
   dup s" allocate" stringcmp 0 = {
     swap drop ' hex-allocate-alternate swap } if
+  dup s" word" stringcmp 0 = { swap drop ' hex-word-alternate swap } if
   dup s" ~" stringcmp 0 = { swap drop ' hex-tilde-alternate swap } if
   ~ (name as stack string, 0 or alternate entry pointer, name pointer)