diff --git a/clj-kondo/clj-kondo.exports/clara/rules/hooks/clara_rules.clj_kondo b/clj-kondo/clj-kondo.exports/clara/rules/hooks/clara_rules.clj_kondo index f9b2bbc5..4b34ba78 100644 --- a/clj-kondo/clj-kondo.exports/clara/rules/hooks/clara_rules.clj_kondo +++ b/clj-kondo/clj-kondo.exports/clara/rules/hooks/clara_rules.clj_kondo @@ -410,7 +410,7 @@ (api/token-node 'def) var-name (api/vector-node - children))) + children))) merge {:clj-kondo/ignore [:clojure-lsp/unused-public-var]})] {:node new-node})) diff --git a/src/main/clojure/clara/rules.clj b/src/main/clojure/clara/rules.clj index d1ae2f83..f6d80982 100644 --- a/src/main/clojure/clara/rules.clj +++ b/src/main/clojure/clara/rules.clj @@ -256,19 +256,23 @@ See the [rule authoring documentation](http://www.clara-rules.org/docs/rules/) for details." [rule-name & body] (let [doc (if (string? (first body)) (first body) nil) - rule (dsl/build-rule rule-name body (meta &form)) ;;; Full rule LHS + RHS - rule-action (dsl/build-rule-action rule-name body (meta &form)) ;;; Only the RHS + rule (dsl/build-rule rule-name body &env (meta &form)) ;;; Full rule LHS + RHS + rule-action (dsl/build-rule-action rule-name body &env (meta &form)) ;;; Only the RHS rule-node (com/build-rule-node rule-action) ;;; The Node of the RHS {:keys [bindings production]} rule-node rule-handler (com/compile-action-handler rule-name bindings (:rhs production) (:env production)) + [rule-args & rule-body] (drop 2 rule-handler) name-with-meta (vary-meta rule-name assoc :rule true :doc doc) handler-name (symbol (name (ns-name *ns*)) (name rule-name))] ;;; The compiled RHS `(defn ~name-with-meta ([] (assoc ~rule :handler '~handler-name)) - (~@(drop 2 rule-handler))))) + ([~@(take 1 rule-args)] + (~rule-name '?__token__ {})) + ([~@rule-args] + ~@rule-body)))) (defmacro defquery "Defines a query and stores it in the given var. For instance, a simple query that accepts no @@ -283,7 +287,7 @@ [name & body] (let [doc (if (string? (first body)) (first body) nil)] `(def ~(vary-meta name assoc :query true :doc doc) - ~(dsl/build-query name body (meta &form))))) + ~(dsl/build-query name body &env (meta &form))))) (defmacro defhierarchy "Defines a hierarchy and stores it in the given var. For instance, a simple hierarchy that adds diff --git a/src/main/clojure/clara/rules/compiler.clj b/src/main/clojure/clara/rules/compiler.clj index 8994177d..394d4f46 100644 --- a/src/main/clojure/clara/rules/compiler.clj +++ b/src/main/clojure/clara/rules/compiler.clj @@ -396,16 +396,17 @@ binding-keys) ;; The destructured environment, if any. - destructured-env (if (> (count env) 0) - {:keys (mapv #(symbol (name %)) (keys env))} - '?__env__)] - `(fn ~action-name [~'?__token__ ~destructured-env] + destructured-env (if (pos? (count env)) + {:keys (mapv (comp symbol name) (keys env)) :as '?__env__} + '?__env__) + destructured-bindings (if (pos? (count token-binding-keys)) + {{:keys (mapv (comp symbol name) token-binding-keys)} :bindings + :as '?__token__} + '?__token__)] + `(fn ~action-name [~destructured-bindings ~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)))) + ~rhs))) (defn compile-action "Compile the right-hand-side action of a rule, returning a function to execute it." diff --git a/src/main/clojure/clara/rules/dsl.clj b/src/main/clojure/clara/rules/dsl.clj index 856d9bfe..8fb13361 100644 --- a/src/main/clojure/clara/rules/dsl.clj +++ b/src/main/clojure/clara/rules/dsl.clj @@ -220,9 +220,7 @@ (defn parse-rule* "Creates a rule from the DSL syntax using the given environment map. *ns* should be bound to the namespace the rule is meant to be defined in." - ([lhs rhs properties env] - (parse-rule* lhs rhs properties env {})) - ([lhs rhs properties env rule-meta] + ([lhs rhs properties rule-env rule-meta] (let [conditions (into [] (for [expr lhs] (parse-expression expr rule-meta))) @@ -235,7 +233,7 @@ assoc :file *file*))} symbols (set (filter symbol? (com/flatten-expression (concat lhs rhs)))) - matching-env (into {} (for [sym (keys env) + matching-env (into {} (for [sym (keys rule-env) :when (symbols sym)] [(keyword (name sym)) sym]))] @@ -245,14 +243,12 @@ (seq properties) (assoc :props properties) ;; Add the environment, if given. - (seq env) (assoc :env matching-env))))) + (seq rule-env) (assoc :env matching-env))))) (defn parse-rule-action* "Creates a rule action from the DSL syntax using the given environment map. *ns* should be bound to the namespace the rule is meant to be defined in." - ([lhs rhs properties env] - (parse-rule-action* lhs rhs properties env {})) - ([lhs rhs properties env rule-meta] + ([lhs rhs properties rule-env rule-meta] (let [conditions (into [] (for [expr lhs] (parse-expression expr rule-meta))) @@ -262,7 +258,7 @@ :rhs (vary-meta rhs assoc :file *file*)} symbols (set (filter symbol? (com/flatten-expression (concat lhs rhs)))) - matching-env (into {} (for [sym (keys env) + matching-env (into {} (for [sym (keys rule-env) :when (symbols sym)] [(keyword (name sym)) sym]))] @@ -272,13 +268,11 @@ (seq properties) (assoc :props properties) ;; Add the environment, if given. - (seq env) (assoc :env matching-env))))) + (seq rule-env) (assoc :env matching-env))))) (defn parse-query* "Creates a query from the DSL syntax using the given environment map." - ([params lhs env] - (parse-query* params lhs env {})) - ([params lhs env query-meta] + ([params lhs query-env query-meta] (let [conditions (into [] (for [expr lhs] (parse-expression expr query-meta))) @@ -288,19 +282,19 @@ symbols (set (filter symbol? (com/flatten-expression lhs))) matching-env (into {} - (for [sym (keys env) + (for [sym (keys query-env) :when (symbols sym)] [(keyword (name sym)) sym]))] (cond-> query - (seq env) (assoc :env matching-env))))) + (seq query-env) (assoc :env matching-env))))) (defmacro parse-rule "Macro used to dynamically create a new rule using the DSL syntax." ([lhs rhs] - (parse-rule* lhs rhs nil &env)) + (parse-rule* lhs rhs nil &env (meta &form))) ([lhs rhs properties] - (parse-rule* lhs rhs properties &env))) + (parse-rule* lhs rhs properties &env (meta &form)))) ;;; added to clojure.core in 1.9 (defn- qualified-keyword? @@ -315,28 +309,26 @@ (defn build-rule "Function used to parse and build a rule using the DSL syntax." - ([name body] (build-rule name body {})) - ([name body form-meta] + ([name body rule-env rule-meta] (let [doc (if (string? (first body)) (first body) nil) body (if doc (rest body) body) properties (if (map? (first body)) (first body) nil) definition (if properties (rest body) body) {:keys [lhs rhs]} (split-lhs-rhs definition)] - (cond-> (parse-rule* lhs rhs properties {} form-meta) + (cond-> (parse-rule* lhs rhs properties rule-env rule-meta) name (assoc :name (production-name name)) doc (assoc :doc doc))))) (defn build-rule-action "Function used to parse and build a rule action using the DSL syntax." - ([name body] (build-rule-action name body {})) - ([name body form-meta] + ([name body rule-env rule-meta] (let [doc (if (string? (first body)) (first body) nil) body (if doc (rest body) body) properties (if (map? (first body)) (first body) nil) definition (if properties (rest body) body) {:keys [lhs rhs]} (split-lhs-rhs definition)] - (cond-> (parse-rule-action* lhs rhs properties {} form-meta) + (cond-> (parse-rule-action* lhs rhs properties rule-env rule-meta) name (assoc :name (production-name name)) doc (assoc :doc doc))))) @@ -344,15 +336,14 @@ (defmacro parse-query "Macro used to dynamically create a new rule using the DSL syntax." [params lhs] - (parse-query* params lhs &env)) + (parse-query* params lhs &env (meta &form))) (defn build-query "Function used to parse and build a query using the DSL syntax." - ([name body] (build-query name body {})) - ([name body form-meta] + ([name body env form-meta] (let [doc (if (string? (first body)) (first body) nil) binding (if doc (second body) (first body)) definition (if doc (drop 2 body) (rest body))] - (cond-> (parse-query* binding definition {} form-meta) + (cond-> (parse-query* binding definition env form-meta) name (assoc :name (production-name name)) doc (assoc :doc doc))))) diff --git a/src/main/clojure/clara/tools/testing_utils.clj b/src/main/clojure/clara/tools/testing_utils.clj index 588139b0..ac13c1d8 100644 --- a/src/main/clojure/clara/tools/testing_utils.clj +++ b/src/main/clojure/clara/tools/testing_utils.clj @@ -31,14 +31,14 @@ (partition 2) (into {} (map (fn [[rule-name [lhs rhs props]]] - [rule-name (assoc (dsl/parse-rule* lhs rhs props {}) :name (str rule-name))])))) + [rule-name (assoc (dsl/parse-rule* lhs rhs props &env (meta &form)) :name (str rule-name))])))) sym->query (->> params :queries (partition 2) (into {} (map (fn [[query-name [params lhs]]] - [query-name (assoc (dsl/parse-query* params lhs {}) :name (str query-name))])))) + [query-name (assoc (dsl/parse-query* params lhs &env (meta &form)) :name (str query-name))])))) production-syms->productions (fn [p-syms] (map (fn [s]