diff --git a/src/sicp_logic/db.clj b/src/sicp_logic/db.clj index e285df6..d744282 100644 --- a/src/sicp_logic/db.clj +++ b/src/sicp_logic/db.clj @@ -3,5 +3,11 @@ (defprotocol FactDB "The FactDB protocol specifies methods to store and retrieve assertions (facts) and rules." - (fetch-assertions [db query frame] "Fetches assertions that may match the given query and frame.") - (add-assertion [db assertion] "Stores an assertion (a fact) in the database.")) + (fetch-assertions [db query frame] + "Fetches assertions that may match the given query and frame.") + (add-assertion [db assertion] + "Stores an assertion (a fact) in the database.") + (fetch-rules [db query frame] + "Fetches rules whose conditions may unify with the given query and frame") + (add-rules [db rule] + "Adds a new rule to the database")) diff --git a/src/sicp_logic/match.clj b/src/sicp_logic/match.clj index 70dd212..16aafb6 100644 --- a/src/sicp_logic/match.clj +++ b/src/sicp_logic/match.clj @@ -34,3 +34,5 @@ frame)) ;; Otherwise we can't match this pattern :else :failed)) + +(defn unify-match [pattern data frame]) diff --git a/src/sicp_logic/rules.clj b/src/sicp_logic/rules.clj index 5604123..6779bcf 100644 --- a/src/sicp_logic/rules.clj +++ b/src/sicp_logic/rules.clj @@ -1,3 +1,56 @@ -(ns sicp-logic.rules) +(ns sicp-logic.rules + (:require [sicp-logic.binding :refer [var?]] + [sicp-logic.db :as db] + [sicp-logic.evaluator :refer [qeval]] + [sicp-logic.match :refer [unify-match]])) -(defn apply-rules [db query frame]) +(defn rename-variables-in [rule] + "Gives all the variables in the rule globally unique names + to prevent name collisions during unification." + (let [bindings (atom {}) + rename-var (fn [var] + (let [var-name (second var) + binding (get @bindings var-name)] + (if binding + binding + (let [new-binding (gensym var-name)] + (swap! bindings (fn [m] (assoc m var-name new-binding))) + new-binding)))) + rename-vars (fn rename-vars [exp] + (cond + (var? exp) (rename-var exp) + (and (sequential? exp) (not (empty? exp))) + (cons (rename-vars (first exp)) + (rename-vars (rest exp))) + :else exp))] + (rename-vars rule))) + + +(defn conclusion [rule] + "Selects the rule's conclusion") + +(defn rule-body [rule] + "Selects the rule's body") + +(defn apply-a-rule [rule query frame] + "Applies the `rule` to the `query` in the + `frame` by unifying the query with the rule to + produce a new frame then evaluating the body + of the rule in that new frame." + (let [clean-rule (rename-variables-in rule) + unify-result (unify-match query + (conclusion clean-rule) + frame)] + (if (= unify-result :failed) + [] + (qeval (rule-body clean-rule) + [unify-result])))) + +(defn fetch-rules [db query frame] + (db/fetch-rules db query frame)) + +(defn apply-rules [db query frame] + (mapcat + (fn [rule] + (apply-a-rule rule query frame)) + (fetch-rules db query frame)))