Experiment: avoid shimmering in When words

2 files changed, 19 insertions, 3 deletions

diff --git a/lib/trie.tcl b/lib/trie.tcl
index 11798061..706d568b 100644
--- a/lib/trie.tcl
+++ b/lib/trie.tcl
@@ -60,6 +60,20 @@ namespace eval ctrie {
         if (outVarName) outVarName[i - 1] = '\0';
         return true;
     }
+    # These functions operate on the Tcl string representation of a
+    # value _without_ coercing the value into a pure string first, so
+    # they avoid shimmering / are more efficient than using Tcl
+    # builtin functions like `regexp` and `string index`.
+    $cc proc scanVariable_ {Tcl_Obj* wordobj} Tcl_Obj* {
+        char varName[100];
+        if (scanVariable(wordobj, varName, 100) == false) {
+            return Tcl_NewStringObj("false", -1);            
+        }
+        return Tcl_NewStringObj(varName, -1);
+    }
+    $cc proc startsWithDollarSign {Tcl_Obj* wordobj} bool {
+        return Tcl_GetString(wordobj)[0] == '$';
+    }
 
     $cc proc addImpl {trie_t** trie int wordc Tcl_Obj** wordv uint64_t value} void {
         if (wordc == 0) {
@@ -258,7 +272,9 @@ namespace eval ctrie {
     $cc compile
 
     rename remove_ remove
-    namespace export create add addWithVar remove removeWithVar lookup lookupTclObjs tclify dot
+    rename scanVariable scanVariableC
+    rename scanVariable_ scanVariable
+    namespace export *
     namespace ensemble create
 }
 
diff --git a/main.tcl b/main.tcl
index 6b134eaa..47b3e315 100644
--- a/main.tcl
+++ b/main.tcl
@@ -85,7 +85,7 @@ proc When {args} {
             set body [list When {*}$remainingPattern $body]
             break
 
-        } elseif {[regexp {^/([^/ ]+)/$} $word -> varName]} {
+        } elseif {[set varName [trie scanVariable $word]] != "false"} {
             if {$varName in $statement::blanks} {
             } elseif {$varName in $statement::negations} {
                 # Rewrite this entire clause to be negated.
@@ -95,7 +95,7 @@ proc When {args} {
                 # (in joined clauses) to be bound $x.
                 lappend varNamesWillBeBound $varName
             }
-        } elseif {[string index $word 0] eq "\$"} {
+        } elseif {[trie startsWithDollarSign $word]} {
             lset pattern $i [uplevel [list subst $word]]
         }
     }