Make trie use ? for wildcard. More bugfixes of new match evaluator

3 files changed, 19 insertions, 18 deletions

diff --git a/lib/trie.tcl b/lib/trie.tcl
index a9f53216..ce580ae4 100644
--- a/lib/trie.tcl
+++ b/lib/trie.tcl
@@ -146,8 +146,8 @@ namespace eval ctrie {
             } else {
                 const char *keyString = Tcl_GetString(trie->branches[j]->key);
                 const char *wordString = Tcl_GetString(wordv[0]);
-                if ((keyString[0] == '/') ||
-                    (wordString[0] == '/') ||
+                if ((keyString[0] == '?' && keyString[1] == '\0') ||
+                    (wordString[0] == '?' && wordString[1] == '\0') ||
                     (strcmp(keyString, wordString) == 0)) {
                     lookupImpl(interp, results, trie->branches[j], wordc - 1, wordv + 1);
                 }
diff --git a/main.tcl b/main.tcl
index b937a90d..e20f06bc 100644
--- a/main.tcl
+++ b/main.tcl
@@ -18,6 +18,9 @@ namespace eval trie {
     namespace export *
     namespace ensemble create
 }
+proc triefy {clause} {
+    lmap word $clause {expr { [regexp {^/([^/ ]+)/$} $word] ? "?" : $word }}
+}
 
 namespace eval statement { ;# statement record type
     namespace export create
@@ -93,7 +96,7 @@ namespace eval Statements { ;# singleton Statement store
         variable statementClauseToId
 
         # is this clause already present in the existing statement set?
-        set ids [trie lookup $statementClauseToId $clause]
+        set ids [trie lookup $statementClauseToId [triefy $clause]]
         if {[llength $ids] == 1} {
             set id [lindex $ids 0]
         } elseif {[llength $ids] == 0} {
@@ -107,7 +110,7 @@ namespace eval Statements { ;# singleton Statement store
             set id [incr nextStatementId]
             set stmt [statement create $clause $newParentMatchIds]
             dict set statements $id $stmt
-            trie add statementClauseToId $clause $id
+            trie add statementClauseToId [triefy $clause] $id
         } else {
             dict with statements $id {
                 set parentMatchIds [dict merge $parentMatchIds $newParentMatchIds]
@@ -130,7 +133,7 @@ namespace eval Statements { ;# singleton Statement store
         variable statementClauseToId
         set clause [statement clause [get $id]]
         dict unset statements $id
-        trie remove statementClauseToId $clause
+        trie remove statementClauseToId [triefy $clause]
     }
     proc size {} { variable statements; return [dict size $statements] }
     proc countMatches {} {
@@ -149,9 +152,9 @@ namespace eval Statements { ;# singleton Statement store
         for {set i 0} {$i < [llength $a]} {incr i} {
             set aWord [lindex $a $i]
             set bWord [lindex $b $i]
-            if {[regexp {^/([^/]+)/$} $aWord -> aVarName]} {
+            if {[regexp {^/([^/ ]+)/$} $aWord -> aVarName]} {
                 dict set match $aVarName $bWord
-            } elseif {[regexp {^/([^/]+)/$} $bWord -> bVarName]} {
+            } elseif {[regexp {^/([^/ ]+)/$} $bWord -> bVarName]} {
                 dict set match $bVarName $aWord
             } elseif {$aWord != $bWord} {
                 return false
@@ -166,7 +169,7 @@ namespace eval Statements { ;# singleton Statement store
         # {{name Bob age 27 __matcheeId 6} {name Omar age 28 __matcheeId 7}}
 
         set matches [list]
-        foreach id [trie lookup $statementClauseToId $pattern] {
+        foreach id [trie lookup $statementClauseToId [triefy $pattern]] {
             set match [unify $pattern [statement clause [get $id]]]
             if {$match != false} {
                 dict set match __matcheeId $id
@@ -250,8 +253,6 @@ proc StepImpl {} {
     # should this do reduction of assert/retract ?
 
     proc runWhen {__env __body} {
-        # FIXME: create a match
-        
         if {[catch {dict with __env $__body} err]} {
             puts "$::nodename: Error: $err\n$::errorInfo"
         }
@@ -305,14 +306,14 @@ proc StepImpl {} {
                 # this match will be dead, so remove the match from the
                 # other parents of the match
                 foreach parentStatementId $parentStatementIds {
-                    if {[Statements::exists $parentStatementId]} {
-                        dict with Statements::statements $parentStatementId {
-                            dict unset childMatchIds $matchId
-                        }
+                    if {![Statements::exists $parentStatementId]} { continue }
+                    dict with Statements::statements $parentStatementId {
+                        dict unset childMatchIds $matchId
                     }
                 }
 
                 foreach childStatementId $childStatementIds {
+                    if {![Statements::exists $childStatementId]} { continue }
                     dict with Statements::statements $childStatementId {
                         dict unset parentMatchIds $matchId
 
diff --git a/test/trie.tcl b/test/trie.tcl
index 859de701..0e277329 100644
--- a/test/trie.tcl
+++ b/test/trie.tcl
@@ -1,6 +1,6 @@
 set t [trie create]
 trie add t {Omar is a person} 1
-trie add t {Generic is a /species/} 2
+trie add t {Generic is a ?} 2
 
 proc assert condition {
    set s "{$condition}"
@@ -10,7 +10,7 @@ proc assert condition {
 }
 
 assert {[trie lookup $t {Omar is a person}] == {1}}
-assert {[trie lookup $t {/someone/ is a person}] == {1 2}}
-assert {[trie lookup $t {Omar is a /species/}] == {1}}
+assert {[trie lookup $t {? is a person}] == {1 2}}
+assert {[trie lookup $t {Omar is a ?}] == {1}}
 assert {[trie lookup $t {Generic is a dog}] == {2}}
-exec dot -Tpdf <<[ctrie dot [ctrie tclify $t]] >ctrie.pdf
+exec dot -Tpdf <<[ctrie dot $t] >ctrie.pdf