c-statements: Use semi-opaque stmt & match handles, not bare indices

I want the extra bit of type safety to help me debug with-all. Also
fixes up cffi/tcl array support a bit

3 files changed, 76 insertions, 61 deletions

diff --git a/lib/c.tcl b/lib/c.tcl
index 039e6d25..9e155502 100644
--- a/lib/c.tcl
+++ b/lib/c.tcl
@@ -241,15 +241,16 @@ namespace eval c {
                 }]
 
                 variable argtypes
-                set argscripts [list] ;# TODO: return a dictionary
+                set argscripts [list {$argtype $argname;}]
                 foreach {fieldtype fieldname} $fields {
                     lappend argscripts [csubst {
                         Tcl_Obj* obj_$fieldname;
                         Tcl_DictObjGet(interp, \$obj, Tcl_ObjPrintf("%s", "$fieldname"), &obj_$fieldname);
                     }]
-                    lappend argscripts [arg $fieldtype \$argname.$fieldname obj_$fieldname]
+                    lappend argscripts [arg $fieldtype \${argname}_$fieldname obj_$fieldname]
+                    lappend argscripts [subst {\$argname.$fieldname = \${argname}_$fieldname;}]
                 }
-                argtype $type [list expr [list [join $argscripts "\n"]]]
+                argtype $type [join $argscripts "\n"]
 
                 variable rtypes
                 rtype $type {
diff --git a/play/c-statements.tcl b/play/c-statements.tcl
index 86d3de4e..64fc34c5 100644
--- a/play/c-statements.tcl
+++ b/play/c-statements.tcl
@@ -6,10 +6,8 @@ namespace eval statement {
     $cc include <stdlib.h>
     $cc include <assert.h>
 
-    # $cc struct statement_handle_t { uint16_t idx; uint16_t generation; }
-    # $cc struct match_handle_t { uint16_t idx; uint16_t generation; }
-    $cc typedef int statement_handle_t
-    $cc typedef int match_handle_t
+    $cc struct statement_handle_t { int idx; }
+    $cc struct match_handle_t { int idx; }
 
     $cc enum edge_type_t { NONE, PARENT, CHILD }
 
@@ -33,6 +31,7 @@ namespace eval statement {
         edge_to_match_t edges[32];
     }
 
+    $cc include <stdbool.h>
     $cc code {
         statement_t statementCreate(Tcl_Obj* clause,
                                     size_t n_parents, match_handle_t parents[],
@@ -48,14 +47,20 @@ namespace eval statement {
             }
             return ret;
         }
+        bool matchHandleIsEqual(match_handle_t a, match_handle_t b) {
+            return a.idx == b.idx;
+        }
+        bool statementHandleIsEqual(statement_handle_t a, statement_handle_t b) {
+            return a.idx == b.idx;
+        }
 
         void statementRemoveEdgeToMatch(statement_t* stmt,
                                         edge_type_t type, match_handle_t matchId) {
             for (size_t i = 0; i < stmt->n_edges; i++) {
                 if (stmt->edges[i].type == type &&
-                    stmt->edges[i].match == matchId) {
+                    matchHandleIsEqual(stmt->edges[i].match, matchId)) {
                     stmt->edges[i].type = NONE;
-                    stmt->edges[i].match = 0;
+                    stmt->edges[i].match = (match_handle_t) {0};
                 }
             }
         }
@@ -63,9 +68,9 @@ namespace eval statement {
                                         edge_type_t type, statement_handle_t statementId) {
             for (size_t i = 0; i < match->n_edges; i++) {
                 if (match->edges[i].type == type &&
-                    match->edges[i].statement == statementId) {
+                    statementHandleIsEqual(match->edges[i].statement, statementId)) {
                     match->edges[i].type = NONE;
-                    match->edges[i].statement = 0;
+                    match->edges[i].statement = (statement_handle_t) {0};
                 }
             }
         }
@@ -98,7 +103,6 @@ namespace eval Statements { ;# singleton Statement store
     variable cc $::statement::cc
     namespace import ::statement::$cc
 
-    $cc include <stdbool.h>
     $cc code [csubst {
         typedef struct trie trie_t;
 
@@ -108,17 +112,31 @@ namespace eval Statements { ;# singleton Statement store
 
         match_t matches[32768];
         uint16_t nextMatchIdx = 1;
-
-        void matchRemove(match_handle_t matchId) {
-            matches[matchId].n_edges = 0;
-        }
     }]
-    $cc proc matchGet {match_handle_t matchId} match_t {
-        return matches[matchId];
+    $cc proc matchGet {match_handle_t matchId} match_t* {
+        return &matches[matchId.idx];
+    }
+    $cc proc matchRemove {match_handle_t matchId} void {
+        matchGet(matchId)->n_edges = 0;
     }
     $cc proc matchExists {match_handle_t matchId} bool {
-        return matches[matchId].n_edges > 0;
+        return matchGet(matchId)->n_edges > 0;
+    }
+
+    $cc proc get {statement_handle_t id} statement_t* {
+        return &statements[id.idx];
+    }
+    $cc proc deref {statement_t* ptr} statement_t { return *ptr; }
+    $cc proc exists {statement_handle_t id} int {
+        return get(id)->clause != NULL;
+    }
+    $cc proc remove_ {statement_handle_t id} void {
+        Tcl_Obj* clause = get(id)->clause;
+        memset(get(id), 0, sizeof(*get(id)));
+        trieRemove(NULL, statementClauseToId, clause);
+        Tcl_DecrRefCount(clause);
     }
+    # $cc proc size {} size_t {}
 
     $cc import ::ctrie::cc create as trieCreate
     $cc import ::ctrie::cc lookup as trieLookup
@@ -130,15 +148,15 @@ namespace eval Statements { ;# singleton Statement store
     }
 
     $cc proc addMatchImpl {size_t n_parents statement_handle_t parents[]} match_handle_t {
-        match_handle_t matchId = nextMatchIdx++;
+        match_handle_t matchId = { .idx = nextMatchIdx++ };
 
-        match_t* match = &matches[matchId];
+        match_t* match = matchGet(matchId);
         match->n_edges = n_parents;
         assert(match->n_edges < sizeof(match->edges)/sizeof(match->edges[0]));
         for (int i = 0; i < n_parents; i++) {
             match->edges[i] = (edge_to_statement_t) { .type = PARENT, .statement = parents[i] };
 
-            statement_t* parent = &statements[parents[i]];
+            statement_t* parent = get(parents[i]);
             parent->edges[parent->n_edges++] = (edge_to_match_t) { .type = CHILD, .match = matchId };
             assert(parent->n_edges < sizeof(parent->edges)/sizeof(parent->edges[0]));
         }
@@ -146,7 +164,7 @@ namespace eval Statements { ;# singleton Statement store
         return matchId;
     }
     proc addMatch {parentMatchIds} {
-        addMatchImpl [llength $parentMatchIds] $parentMatchIds
+        addMatchImpl [llength $parentMatchIds] [lmap id $parentMatchIds {list idx $id}]
     }
 
     $cc proc addImpl {Tcl_Interp* interp
@@ -158,10 +176,10 @@ namespace eval Statements { ;# singleton Statement store
         statement_handle_t id;
         if (idslen == 1) {
             Tcl_Obj* idobj; Tcl_ListObjIndex(interp, ids, 0, &idobj);
-            id = Tcl_GetIntFromObj(interp, idobj, &id);
+            Tcl_GetIntFromObj(interp, idobj, &id.idx);
 
         } else if (idslen == 0) {
-            id = -1;
+            id.idx = -1;
 
         } else {
             // error WTF
@@ -169,27 +187,28 @@ namespace eval Statements { ;# singleton Statement store
             exit(1);
         }
 
-        bool isNewStatement = (id == -1);
+        bool isNewStatement = (id.idx == -1);
         if (isNewStatement) {
-            id = nextStatementIdx++;
-            assert(id < sizeof(statements)/sizeof(statements[0]));
+            id.idx = nextStatementIdx++;
+            assert(id.idx < sizeof(statements)/sizeof(statements[0]));
 
-            statements[id] = statementCreate(clause, n_parents, parents, 0, NULL);
-            trieAdd(interp, &statementClauseToId, clause, id);
+            *get(id) = statementCreate(clause, n_parents, parents, 0, NULL);
+            trieAdd(interp, &statementClauseToId, clause, id.idx);
 
         } else {
+            statement_t* stmt = get(id);
             for (size_t i = 0; i < n_parents; i++) {
-                size_t edgeIdx = statements[id].n_edges++;
-                assert(edgeIdx < sizeof(statements[id].edges)/sizeof(statements[id].edges[0]));
-                statements[id].edges[edgeIdx].type = PARENT;
-                statements[id].edges[edgeIdx].match = parents[i];
+                size_t edgeIdx = stmt->n_edges++;
+                assert(edgeIdx < sizeof(stmt->edges)/sizeof(stmt->edges[0]));
+                stmt->edges[edgeIdx].type = PARENT;
+                stmt->edges[edgeIdx].match = parents[i];
             }
         }
 
         for (size_t i = 0; i < n_parents; i++) {
-            if (parents[i] == 0) { continue; } // ?
+            if (parents[i].idx == 0) { continue; } // ?
 
-            match_t* match = &matches[parents[i]];
+            match_t* match = matchGet(parents[i]);
             size_t edgeIdx = match->n_edges++;
             assert(edgeIdx < sizeof(match->edges)/sizeof(match->edges[0]));
             match->edges[edgeIdx].type = CHILD;
@@ -197,27 +216,14 @@ namespace eval Statements { ;# singleton Statement store
         }
 
         // return {id, isNewStatement};
-        Tcl_Obj* ret[] = {Tcl_NewIntObj(id), Tcl_NewIntObj(isNewStatement)};
+        Tcl_Obj* ret[] = {Tcl_NewIntObj(id.idx), Tcl_NewIntObj(isNewStatement)};
         return Tcl_NewListObj(sizeof(ret)/sizeof(ret[0]), ret);
     }
     proc add {clause {parents {{} true}}} {
         addImpl $clause [dict size $parents] [lmap parent [dict keys $parents] {
-            expr {$parent eq {} ? 0 : $parent}
+            expr {$parent eq {} ? {idx 0} : {idx $parent}}
         }]
     }
-    $cc proc exists {statement_handle_t id} int {
-        return statements[id].clause != NULL;
-    }
-    $cc proc get {statement_handle_t id} statement_t {
-        return statements[id];
-    }
-    $cc proc remove_ {statement_handle_t id} void {
-        Tcl_Obj* clause = statements[id].clause;
-        memset(&statements[id], 0, sizeof(statements[id]));
-        trieRemove(NULL, statementClauseToId, clause);
-        Tcl_DecrRefCount(clause);
-    }
-    # $cc proc size {} size_t {}
 
     $cc proc unifyImpl {Tcl_Interp* interp Tcl_Obj* a Tcl_Obj* b} Tcl_Obj* {
         int alen; Tcl_Obj** awords;
@@ -264,14 +270,15 @@ namespace eval Statements { ;# singleton Statement store
         return Tcl_NewListObj(matchcount, matches);
     }
 
-    $cc proc reactToStatementRemoval {statement_handle_t id} void {
+    $cc proc reactToStatementRemovalImpl {statement_handle_t id} void {
         // unset all things downstream of statement
-        for (int i = 0; i < statements[id].n_edges; i++) {
-            if (statements[id].edges[i].type != CHILD) continue;
-            match_handle_t matchId = statements[id].edges[i].match;
+        statement_t *stmt = get(id);
+        for (int i = 0; i < stmt->n_edges; i++) {
+            if (stmt->edges[i].type != CHILD) continue;
+            match_handle_t matchId = stmt->edges[i].match;
 
             if (!matchExists(matchId)) continue; // if was removed earlier
-            match_t* match = &matches[matchId];
+            match_t* match = matchGet(matchId);
 
             for (int j = 0; j < match->n_edges; j++) {
                 // this match will be dead, so remove the match from the
@@ -280,17 +287,17 @@ namespace eval Statements { ;# singleton Statement store
                     statement_handle_t parentId = match->edges[j].statement;
                     if (!exists(parentId)) { continue; }
 
-                    statementRemoveEdgeToMatch(&statements[parentId], CHILD, matchId);
+                    statementRemoveEdgeToMatch(get(parentId), CHILD, matchId);
 
                 } else if (match->edges[j].type == CHILD) {
                     statement_handle_t childId = match->edges[j].statement;
                     if (!exists(childId)) { continue; }
 
-                    statementRemoveEdgeToMatch(&statements[childId], PARENT, matchId);
+                    statementRemoveEdgeToMatch(get(childId), PARENT, matchId);
 
                     // is this child statement out of parent matches? => it's dead
-                    if (statements[childId].n_edges == 0) {
-                        reactToStatementRemoval(childId);
+                    if (get(childId)->n_edges == 0) {
+                        reactToStatementRemovalImpl(childId);
                         remove_(childId);
                         matchRemoveEdgeToStatement(match, CHILD, childId);
                     }
@@ -346,8 +353,13 @@ namespace eval Statements { ;# singleton Statement store
     $cc compile
     init        
 
-    rename remove_ remove
+    # compatibility with older Tcl statements module interface
+    # (they pass in unwrapped integer handles, among other things)
+    proc reactToStatementRemoval {idx} { reactToStatementRemovalImpl [list idx $idx] }
+    proc remove {idx} { remove_ [list idx $idx] }
     rename findStatementsMatching findMatches
+    rename get getImpl
+    proc get {id} { deref [getImpl [list idx $id]] }
 }
 
 if {[info exists ::argv0] && $::argv0 eq [info script]} {
diff --git a/test/with-all.tcl b/test/with-all.tcl
index b4d2238b..f7661366 100644
--- a/test/with-all.tcl
+++ b/test/with-all.tcl
@@ -30,8 +30,10 @@ proc countCollectedMatches {clause} {
 assert {[countCollectedMatches [list Omar lives in /place/]] == 2}
 assert {[llength [Statements::findMatches [list /someone/ claims there are 2 matches]]] == 1}
 
+exec dot -Tpdf >preretract.pdf <<[Statements::dot]
 Retract programOakland has program code /something/
 Step
+exec dot -Tpdf >postretract.pdf <<[Statements::dot]
 
 assert {[countCollectedMatches [list Omar lives in /place/]] == 1}
 assert {[llength [Statements::findMatches [list /someone/ claims there are 1 matches]]] == 1}