jdormit/sicp-logic
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Move rules ns to evaluator to avoid circular dependency

Browse Source
This commit is contained in:
Jeremy Dormitzer 2019-07-17 22:44:11 -04:00
parent d5cc3922e5
commit 9f501dcd09
2 changed files with 56 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
src/sicp_logic/evaluator.clj
View File

@ -1,7 +1,8 @@
(ns sicp-logic.evaluator (ns sicp-logic.evaluator
(:require [sicp-logic.binding :refer [instantiate]] (:require [sicp-logic.assertions :refer [find-assertions]]
[sicp-logic.assertions :refer [find-assertions]] [sicp-logic.binding :refer [instantiate]]
[sicp-logic.rules :refer [apply-rules]])) [sicp-logic.db :refer [fetch-rules]]
[sicp-logic.match :refer [unify-match]]))
(declare qeval) (declare qeval)
@ -47,6 +48,58 @@
[])) []))
input-frames)) input-frames))
;; Rule functions need to be in the same namespace as qeval to avoid
;; a circular dependency, even though it would be more elegant to
;; put them in a separate namespace.
(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 apply-rules [db query frame]
(mapcat
(fn [rule]
(apply-a-rule rule query frame))
(fetch-rules db query frame)))
(defn simple-query [db q input-frames] (defn simple-query [db q input-frames]
"Processes a simple query, producing a sequence of frames with "Processes a simple query, producing a sequence of frames with
bindings for the variables in `q`." bindings for the variables in `q`."

56
src/sicp_logic/rules.clj
View File

@ -1,56 +0,0 @@
(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 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)))