Merge pull request #3 from k13labs/upstream-update

chore: upstream update from clara-rules 0.24.0

.gitignore

@@ -18,3 +18,4 @@ figwheel_server.log
 .clj-kondo
 .lsp
 .cpcache
+node_modules/*

CHANGELOG.md

@@ -75,38 +75,44 @@ This is a history of changes to k13labs/clara-rules.
 
 This is a history of changes to clara-rules prior to forking to k13labs/clara-rules.
 
-# 0.23.0
+### 0.24.0
+* uplift to cljs 1.11.132
+* uplift to clj 1.11.2
+* remove atom usage in LHS functions
+* remove redundant TestNode evaluations
+
+### 0.23.0
 * extract clara.rules.compiler/compile-test-handler from clara.rules.compiler/compile-test
 * add support for `env` inside of test expressions
 * use `.clj_kondo` extension for clj-kondo hook code for better tool compatibility (clj-kondo support now requires clj-kondo 2022.04.25 or higher)
 * Include the invalid constraint in the exception thrown at session compilation time when negations have multiple children.  See [Issue 284](https://github.com/cerner/clara-rules/issues/284).
 
-# 0.22.1
+### 0.22.1
 * fix incorrent lint warning triggered when this binding is not used in clj-kondo hooks
 
-# 0.22.0
+### 0.22.0
 * add built-in clj-kondo support for clara-rules as hooks. Importing should be automatic if using clojure-lsp; for detailed instructions see clj-kondo's documentation on [how to import clj-kondo configuration](https://github.com/clj-kondo/clj-kondo/blob/master/doc/config.md#importing)
 * use correct arity calling `->RuleOrderedActivation` constructor during serialization if clara session; this change should have the same effective behavior as before.
 
-# 0.21.2
+### 0.21.2
 * Try and catch TestNode expression evaluation so that exceptions thrown are re-thrown wrapped in a condition exception which includes production name and bindings information. See [PR 471](https://github.com/cerner/clara-rules/pull/471).
 
-# 0.21.1
+### 0.21.1
 * Add support to specify query binding arguments as symbols instead of only keywords so that defquery syntax looks closer to function definition syntax. See [PR 463](https://github.com/cerner/clara-rules/pull/463).
 
-# 0.21.0
+### 0.21.0
 * Add names to anonymous functions generated by rule compilation; these names will be in the class names of the generated objects. [Issue 261](https://github.com/cerner/clara-rules/issues/261) and [issue 291](https://github.com/cerner/clara-rules/issues/291)
 * Add types information to alpha nodes. [Issue 237](https://github.com/cerner/clara-rules/issues/237)
 * Fix a bug related to Java object facts with IndexedPropertyDescriptor fields. [Issue 446](https://github.com/cerner/clara-rules/issues/446)
 * Validate that parameters provided to queries exist on the query at compilation and throw an exception if queries on a session don't specify the required parameters. [Issue 454](https://github.com/cerner/clara-rules/issues/454)
 * Add an optional listener that reports suspected infinite loops of rules.  [Issue 275](https://github.com/cerner/clara-rules/issues/275)
 
-# 0.20.0
+### 0.20.0
 * Add a flag to omit compilation context (used by the durability layer) after Session compilation to save space when not needed. Defaults to true. [issue 422](https://github.com/cerner/clara-rules/issues/422)
 * Correct duplicate bindings within the same condition. See [issue 417](https://github.com/cerner/clara-rules/issues/417)
 * Correct sharing of nodes with different parents. See [issue 433](https://github.com/cerner/clara-rules/issues/433)
 
-# 0.19.1
+### 0.19.1
 * Added a new field to the clara.rules.engine/Accumulator record.  This could be a breaking change for any user durability implementations with low-level performance optimizations.  See [PR 410](https://github.com/cerner/clara-rules/pull/410) for details.
 * Performance improvements for :exists conditions.  See [issue 298](https://github.com/cerner/clara-rules/issues/298).
 * Decrease memory usage post deserialization (Durability). See [Issue 419](https://github.com/cerner/clara-rules/issues/419)

src/main/clojure/clara/rules/compiler.clj

@@ -219,7 +219,7 @@
   ([exp-seq equality-only-variables]
 
    (if (empty? exp-seq)
-     `(deref ~'?__bindings__)
+     '?__bindings__
      (let [[exp & rest-exp] exp-seq
            variables (into #{}
                            (filter (fn [item]
@@ -256,11 +256,11 @@
          ;; First assign each value in a let, so it is visible to subsequent expressions.
          `(let [~@(for [variable variables
                         let-expression [variable (first expression-values)]]
-                    let-expression)]
-
-            ;; Update the bindings produced by this expression.
-            ~@(for [variable variables]
-                `(swap! ~'?__bindings__ assoc ~(keyword variable) ~variable))
+                    let-expression)
+                ;; Update the bindings produced by this expression.
+                ;; intentional shadowing here of the ?__bindings__ variable with each newly
+                ;; bound variables associated.
+                ~'?__bindings__ (assoc ~'?__bindings__ ~@(mapcat (juxt keyword identity) variables))]
 
             ;; If there is more than one expression value, we need to ensure they are
             ;; equal as well as doing the bind. This ensures that value-1 and value-2 are
@@ -371,18 +371,11 @@
     `(fn ~fn-name [~(add-meta '?__fact__ type)
                    ~destructured-env]
        (let [~@assignments
-             ~'?__bindings__ (atom ~initial-bindings)]
+             ~'?__bindings__ ~initial-bindings]
          ~(compile-constraints constraints)))))
 
-(defn build-token-assignment
-  "A helper function to build variable assignment forms for tokens."
-  [binding-key]
-  (list (symbol (name binding-key))
-        (list `-> '?__token__ :bindings binding-key)))
-
 (defn compile-test-handler [node-id constraints env]
   (let [binding-keys (variables-as-keywords constraints)
-        assignments (mapcat build-token-assignment binding-keys)
 
         ;; The destructured environment, if any
         destructured-env (if (> (count env) 0)
@@ -392,38 +385,42 @@
         ;; Hardcoding the node-type and fn-type as we would only ever expect 'compile-test' to be used for this scenario
         fn-name (mk-node-fn-name "TestNode" node-id "TE")]
     `(fn ~fn-name [~'?__token__ ~destructured-env]
-       (let [~@assignments]
-         (and ~@constraints)))))
+       ;; exceedingly unlikely that we'd have a test node without bound variables to be tested,
+       ;; however since the contract is that of arbitrary clojure there is nothing preventing users
+       ;; from defining tests that look outside the Session here. In such event, those without bound variables,
+       ;; we can avoid the bindings entirely.
+       ~(if (seq binding-keys)
+          `(let [{:keys [~@(map (comp symbol name) binding-keys)]} (:bindings ~'?__token__)]
+             (and ~@constraints))
+          `(and ~@constraints)))))
 
 (defn compile-test [node-id constraints env]
-  (let [test-handler (compile-test-handler node-id constraints env)]
-    `(array-map :handler ~test-handler
-                :constraints '~constraints)))
+  (compile-test-handler node-id constraints env))
 
 (defn compile-action-handler
-  [action-name bindings-keys rhs env]
+  [action-name binding-keys rhs env]
   (let [;; Avoid creating let bindings in the compile code that aren't actually used in the body.
         ;; The bindings only exist in the scope of the RHS body, not in any code called by it,
         ;; so this scanning strategy will detect all possible uses of binding variables in the RHS.
         ;; Note that some strategies with macros could introduce bindings, but these aren't something
         ;; we're trying to support.  If necessary a user could macroexpand their RHS code manually before
         ;; providing it to Clara.
         rhs-bindings-used (variables-as-keywords rhs)
-
-        assignments (sequence
-                     (comp
-                      (filter rhs-bindings-used)
-                      (mapcat build-token-assignment))
-                     bindings-keys)
+        token-binding-keys (sequence
+                            (filter rhs-bindings-used)
+                            binding-keys)
 
         ;; The destructured environment, if any.
         destructured-env (if (> (count env) 0)
-                           {:keys (mapv (comp symbol name) (keys env))}
+                           {:keys (mapv #(symbol (name %)) (keys env))}
                            '?__env__)]
-    `(fn ~action-name
-       [~'?__token__  ~destructured-env]
-       (let [~@assignments]
-         ~rhs))))
+    `(fn ~action-name [~'?__token__ ~destructured-env]
+       ;; similar to test nodes, nothing in the contract of an RHS enforces that bound variables must be used.
+       ;; similarly we will not bind anything in this event, and thus the let block would be superfluous.
+       ~(if (seq token-binding-keys)
+          `(let [{:keys [~@(map (comp symbol name) token-binding-keys)]} (:bindings ~'?__token__)]
+             ~rhs)
+          rhs))))
 
 (defn compile-action
   "Compile the right-hand-side action of a rule, returning a function to execute it."
@@ -448,14 +445,14 @@
 
 (defn compile-join-filter
   "Compiles to a predicate function that ensures the given items can be unified. Returns a ready-to-eval
-   function that accepts the following:
+  function that accepts the following:
 
-   * a token from the parent node
-   * the fact
-   * a map of bindings from the fact, which was typically computed on the alpha side
-   * an environment
+  * a token from the parent node
+  * the fact
+  * a map of bindings from the fact, which was typically computed on the alpha side
+  * an environment
 
-   The function created here returns truthy if the given fact satisfies the criteria."
+  The function created here returns truthy if the given fact satisfies the criteria."
   [node-id node-type {:keys [type constraints args] :as unification-condition} ancestor-bindings element-bindings env]
   (let [accessors (field-name->accessors-used type constraints)
 
@@ -479,17 +476,6 @@
         ;; created element bindings for this condition removed.
         token-binding-keys (remove element-bindings (variables-as-keywords constraints))
 
-        token-assignments (mapcat build-token-assignment token-binding-keys)
-
-        new-binding-assignments (mapcat #(list (symbol (name %))
-                                               (list 'get '?__element-bindings__ %))
-                                        element-bindings)
-
-        assignments (concat
-                     fact-assignments
-                     token-assignments
-                     new-binding-assignments)
-
         equality-only-variables (into #{} (for [binding ancestor-bindings]
                                             (symbol (name (keyword binding)))))
 
@@ -500,8 +486,14 @@
         ~(add-meta '?__fact__ type)
         ~'?__element-bindings__
         ~destructured-env]
-       (let [~@assignments
-             ~'?__bindings__ (atom {})]
+       (let [~@fact-assignments
+             ;; We should always have some form of bound variables here, however in the event that we ever didn't
+             ;; there would be no need to generate non-existent bindings.
+             ~@(when (seq element-bindings)
+                 [{:keys (mapv (comp symbol name) element-bindings)} '?__element-bindings__])
+             ~@(when (seq token-binding-keys)
+                 [{:keys (mapv (comp symbol name) token-binding-keys)} (list :bindings '?__token__)])
+             ~'?__bindings__ {}]
          ~(compile-constraints constraints equality-only-variables)))))
 
 (defn- expr-type [expression]
@@ -1613,7 +1605,7 @@
 
 (sc/defn ^:private compile-node
   "Compiles a given node description into a node usable in the network with the
-   given children."
+  given children."
   [beta-node :- (sc/conditional
                  (comp #{:production :query} :node-type) schema/ProductionNode
                  :else schema/ConditionNode)
@@ -1677,6 +1669,7 @@
       (eng/->TestNode
        id
        env
+       (:constraints condition)
        (compiled-expr-fn id :test-expr)
        children)
 
@@ -1696,10 +1689,10 @@
         (if (:join-filter-expressions beta-node)
           (eng/->AccumulateWithJoinFilterNode
            id
-            ;; Create an accumulator structure for use when examining the node or the tokens
-            ;; it produces.
+           ;; Create an accumulator structure for use when examining the node or the tokens
+           ;; it produces.
            {:accumulator (:accumulator beta-node)
-             ;; Include the original filter expressions in the constraints for inspection tooling.
+            ;; Include the original filter expressions in the constraints for inspection tooling.
             :from (update-in condition [:constraints]
                              into (-> beta-node :join-filter-expressions :constraints))}
            compiled-accum
@@ -1712,8 +1705,8 @@
           ;; All unification is based on equality, so just use the simple accumulate node.
           (eng/->AccumulateNode
            id
-            ;; Create an accumulator structure for use when examining the node or the tokens
-            ;; it produces.
+           ;; Create an accumulator structure for use when examining the node or the tokens
+           ;; it produces.
            {:accumulator (:accumulator beta-node)
             :from condition}
            compiled-accum

src/main/clojure/clara/rules/engine.clj

@@ -949,7 +949,7 @@
 ;; The test node represents a Rete extension in which an arbitrary test condition is run
 ;; against bindings from ancestor nodes. Since this node
 ;; performs no joins it does not accept right activations or retractions.
-(defrecord TestNode [id env test children]
+(defrecord TestNode [id env constraints test children]
   ILeftActivate
   (left-activate [node join-bindings tokens memory transport listener]
     (l/left-activate! listener node tokens)
@@ -960,7 +960,7 @@
      children
      (platform/compute-for
       [token tokens]
-      (test-node-match->Token node (:handler test) env token))))
+      (test-node-match->Token node test env token))))
 
   (left-retract [node join-bindings tokens memory transport listener]
     (l/left-retract! listener node tokens)
@@ -972,7 +972,7 @@
 
   IConditionNode
   (get-condition-description [this]
-    (into [:test] (:constraints test))))
+    (into [:test] constraints)))
 
 (defn- do-accumulate
   "Runs the actual accumulation.  Returns the accumulated value."

src/main/clojure/clara/tools/testing_utils.clj

@@ -71,11 +71,9 @@
   [node-id binding-keys rhs env]
   (let [rhs-bindings-used (com/variables-as-keywords rhs)
 
-        assignments (sequence
-                     (comp
-                      (filter rhs-bindings-used)
-                      (mapcat com/build-token-assignment))
-                     binding-keys)
+        token-binding-keys (sequence
+                            (filter rhs-bindings-used)
+                            binding-keys)
 
         ;; The destructured environment, if any.
         destructured-env (if (> (count env) 0)
@@ -84,10 +82,14 @@
 
         ;; Hardcoding the node-type and fn-type as we would only ever expect 'compile-action' to be used for this scenario
         fn-name (com/mk-node-fn-name "ProductionNode" node-id "AE")]
-    `(fn ~fn-name [~'?__token__  ~destructured-env]
+    `(fn ~fn-name [~'?__token__ ~destructured-env]
+       ;; similar to test nodes, nothing in the contract of an RHS enforces that bound variables must be used.
+       ;; similarly we will not bind anything in this event, and thus the let block would be superfluous.
        (async
-        (let [~@assignments]
-          ~rhs)))))
+        ~(if (seq token-binding-keys)
+           `(let [{:keys [~@(map (comp symbol name) token-binding-keys)]} (:bindings ~'?__token__)]
+              ~rhs)
+           rhs)))))
 
 (defn test-fire-rules-async
   ([session]

src/test/clojure/clara/test_compiler.clj

@@ -43,7 +43,7 @@
   (let [get-node-fns (fn [node]
                        (condp instance? node
                          AlphaNode [(:activation node)]
-                         TestNode [(-> node :test :handler)]
+                         TestNode [(:test node)]
                          AccumulateNode []
                          AccumulateWithJoinFilterNode [(:join-filter-fn node)]
                          ProductionNode [(:rhs node)]