Merge branch 'main' into ac/editor

4 files changed, 78 insertions, 21 deletions

diff --git a/lib/c.tcl b/lib/c.tcl
index 5117840f..1b78cf40 100644
--- a/lib/c.tcl
+++ b/lib/c.tcl
@@ -309,6 +309,18 @@ namespace eval c {
                     \$argtype \$argname;
                     \$argname = *(($type *)\$obj->internalRep.ptrAndLongRep.ptr);
                 }]
+                argtype $type* [csubst {
+                    \$argtype \$argname;
+                    if (\$obj->bytes != NULL && \$obj->bytes[0] == '(') {
+                        // If it has a string repr and starts with (.
+                        __ENSURE(sscanf(Tcl_GetString(\$obj), "(\$argtype) 0x%p", &\$argname) == 1);
+
+                    } else {
+                        // Otherwise, try to coerce from struct.
+                        __ENSURE_OK(Tcl_ConvertToType(interp, \$obj, &$[set type]_ObjType));
+                        \$argname = ($type *)\$obj->internalRep.ptrAndLongRep.ptr;
+                    }
+                }]
 
                 rtype $type {
                     $robj = Tcl_NewObj();
diff --git a/lib/evaluator.tcl b/lib/evaluator.tcl
index 8eae0ca6..bbcb9257 100644
--- a/lib/evaluator.tcl
+++ b/lib/evaluator.tcl
@@ -218,9 +218,11 @@ namespace eval statement {
     }
 
     # Converts a pattern from base form like `the time is /t/` to
-    # claimized form, `/someone/ claims the time is /t/`. The returned
-    # pattern is a new heap-allocated Tcl_Obj and should be freed by
-    # the caller.
+    # claimized form, `/someone/ claims the time is /t/`. Returns NULL
+    # if the pattern already has a verb like `claims` or `wishes` in
+    # second position and shouldn't be claimized. The returned pattern
+    # is a new heap-allocated Tcl_Obj and should be freed by the
+    # caller.
     $cc proc claimizePattern {Tcl_Obj* pattern} Tcl_Obj* {
         static Tcl_Obj* someoneClaims[2] = {0};
         if (someoneClaims[0] == NULL) {
@@ -230,6 +232,15 @@ namespace eval statement {
             Tcl_IncrRefCount(someoneClaims[1]);
         }
 
+        Tcl_Obj* secondWord;
+        if (Tcl_ListObjIndex(NULL, pattern, 1, &secondWord) == TCL_OK) {
+            if (secondWord != NULL &&
+                (strcmp(Tcl_GetString(secondWord), "claims") == 0 ||
+                 strcmp(Tcl_GetString(secondWord), "wishes") == 0)) {
+                return NULL;
+            }
+        }
+
         // the time is /t/ -> /someone/ claims the time is /t/
         Tcl_Obj* ret = Tcl_DuplicateObj(pattern);
         Tcl_ListObjReplace(NULL, ret, 0, 0, 2, someoneClaims);
@@ -655,10 +666,13 @@ namespace eval Statements { ;# singleton Statement store
         int resultsForFirstPatternCount = searchByPattern(substitutedFirstPattern,
                                                           maxResultsCount, resultsForFirstPattern);
         Tcl_Obj* claimizedSubstitutedFirstPattern = claimizePattern(substitutedFirstPattern);
-        resultsForFirstPatternCount += searchByPattern(claimizedSubstitutedFirstPattern,
-                                                       maxResultsCount - resultsForFirstPatternCount, &resultsForFirstPattern[resultsForFirstPatternCount]);
         Tcl_DecrRefCount(substitutedFirstPattern);
-        Tcl_DecrRefCount(claimizedSubstitutedFirstPattern);
+        if (claimizedSubstitutedFirstPattern != NULL) {
+            resultsForFirstPatternCount += searchByPattern(claimizedSubstitutedFirstPattern,
+                                                           maxResultsCount - resultsForFirstPatternCount,
+                                                           &resultsForFirstPattern[resultsForFirstPatternCount]);
+            Tcl_DecrRefCount(claimizedSubstitutedFirstPattern);
+        }
         for (int i = 0; i < resultsForFirstPatternCount; i++) {
             environment_t* result = resultsForFirstPattern[i];
             if (env != NULL) {
@@ -954,7 +968,10 @@ namespace eval Evaluator {
             for (int i = 0; i < subpatternsCount; i++) {
                 Tcl_Obj* subpattern = subpatterns[i];
                 addReaction(subpattern, id, reactToStatementAdditionThatMatchesCollect);
-                addReaction(claimizePattern(subpattern), id, reactToStatementAdditionThatMatchesCollect);
+                Tcl_Obj* claimizedSubpattern = claimizePattern(subpattern);
+                if (claimizedSubpattern != NULL) {
+                    addReaction(claimizedSubpattern, id, reactToStatementAdditionThatMatchesCollect);
+                }
             }
 
             get(id)->collectNeedsRecollect = true;
@@ -967,7 +984,9 @@ namespace eval Evaluator {
             Tcl_ListObjReplace(interp, pattern, 0, 1, 0, NULL);
             addReaction(pattern, id, reactToStatementAdditionThatMatchesWhen);
             Tcl_Obj* claimizedPattern = claimizePattern(pattern);
-            addReaction(claimizedPattern, id, reactToStatementAdditionThatMatchesWhen);
+            if (claimizedPattern != NULL) {
+                addReaction(claimizedPattern, id, reactToStatementAdditionThatMatchesWhen);
+            }
 
             // Scan the existing statement set for any
             // already-existing matching statements.
@@ -978,11 +997,13 @@ namespace eval Evaluator {
                 statement_handle_t alreadyMatchingStatementId = *(statement_handle_t *)&alreadyMatchingStatementIds[i];
                 reactToStatementAdditionThatMatchesWhen(interp, id, pattern, alreadyMatchingStatementId);
             }
-            alreadyMatchingStatementIdsCount = trieLookup(interp, alreadyMatchingStatementIds, 1000,
-                                                          statementClauseToId, claimizedPattern);
-            for (int i = 0; i < alreadyMatchingStatementIdsCount; i++) {
-                statement_handle_t alreadyMatchingStatementId = *(statement_handle_t *)&alreadyMatchingStatementIds[i];
-                reactToStatementAdditionThatMatchesWhen(interp, id, claimizedPattern, alreadyMatchingStatementId);
+            if (claimizedPattern != NULL) {
+                alreadyMatchingStatementIdsCount = trieLookup(interp, alreadyMatchingStatementIds, 1000,
+                                                              statementClauseToId, claimizedPattern);
+                for (int i = 0; i < alreadyMatchingStatementIdsCount; i++) {
+                    statement_handle_t alreadyMatchingStatementId = *(statement_handle_t *)&alreadyMatchingStatementIds[i];
+                    reactToStatementAdditionThatMatchesWhen(interp, id, claimizedPattern, alreadyMatchingStatementId);
+                }
             }
         }
 
diff --git a/lib/language.tcl b/lib/language.tcl
index ae3e4ae7..2977933d 100644
--- a/lib/language.tcl
+++ b/lib/language.tcl
@@ -77,6 +77,16 @@ proc lenumerate {l} {
     set ret
 }
 
+# Create `dict getdef` / `dict getwithdefault`
+# Backported from https://core.tcl-lang.org/tips/doc/trunk/tip/342.md
+proc dict_getdef {D args} {
+    if {[dict exists $D {*}[lrange $args 0 end-1]]} then {
+        dict get $D {*}[lrange $args 0 end-1]
+    } else {
+        lindex $args end
+    }
+}
+
 proc python3 {args} {
     exec python3 << [undent [join $args " "]]
 }
diff --git a/lib/process.tcl b/lib/process.tcl
index 059c0b89..faaa5e84 100644
--- a/lib/process.tcl
+++ b/lib/process.tcl
@@ -56,21 +56,35 @@ namespace eval ::Zygote {
     }
 }
 
-proc On-process {name body} {
+proc Start-process {name body} {
+    if {[namespace exists ::Peers::$name]} {
+        error "Process $name already exists"
+        return
+    }
+
     set this [uplevel {expr {[info exists this] ? $this : "<unknown>"}}]
     set processCode [list apply {{__parentProcess __name __body} {
         set ::thisProcess $__name
 
-        Assert <lib/process.tcl> wishes $::thisProcess shares all wishes
-        Assert <lib/process.tcl> wishes $::thisProcess shares all claims
-
         ::peer $__parentProcess true
 
+        Assert <lib/process.tcl> wishes $::thisProcess shares statements like \
+            [list /someone/ claims $::thisProcess has pid /something/]
+        Assert <lib/process.tcl> wishes $::thisProcess receives statements like \
+            [list /someone/ wishes program code /code/ runs on $::thisProcess]
+        Assert <lib/process.tcl> wishes $::thisProcess shares statements like \
+            [list /someone/ wishes $::thisProcess receives statements like /pattern/]
+
         Assert <lib/process.tcl> claims $::thisProcess has pid [pid]
-        Assert when $::thisProcess has pid /something/ [list {} $__body]
-        while true {
-            Step
-        }
+        # Run __body one Step before running any other program code.
+        Assert when $::thisProcess has pid /something/ [list {__body} {
+            When /someone/ wishes program code /__code/ runs on $::thisProcess {
+                eval $__code
+            }
+            eval $__body
+        }] with environment [list $__body]
+
+        while true { Step }
     }} $::thisProcess $name $body]
 
     ::peer $name false