diff --git a/src/sicp_logic/db/memory.clj b/src/sicp_logic/db/memory.clj index 6fdcc7d..feb073b 100644 --- a/src/sicp_logic/db/memory.clj +++ b/src/sicp_logic/db/memory.clj @@ -6,6 +6,12 @@ (defn get-indexed-assertions [db query] (get @(:assertion-index db) (first query))) +(defn get-all-assertions [db] + @(:assertion-store db)) + +(defn use-assertion-index? [query] + (not (var? (first query)))) + (defn index-assertion! [db assertion] (swap! (:assertion-index db) @@ -13,6 +19,12 @@ (let [index-value (or (get index (first assertion)) [])] (assoc index (first assertion) (conj index-value assertion)))))) +(defn store-assertion! [db assertion] + (swap! + (:assertion-store db) + (fn [store] + (conj store assertion)))) + (defn get-indexed-rules [db query] (concat (get @(:rule-index db) (first query)) @@ -28,11 +40,13 @@ index-value (or (get index index-key) [])] (assoc index index-key (conj index-value rule)))))) -(defrecord InMemoryDB [assertion-index rule-index] +(defrecord InMemoryDB [assertion-index rule-index assertion-store rule-store] FactDB (fetch-assertions [db query frame] (let [instantiated (instantiate query frame (fn [v f] v))] - (get-indexed-assertions db query))) + (if (use-asserttion-index? query) + (get-indexed-assertions db query) + (get-all-assertions db)))) (add-assertion [db assertion] (index-assertion! db assertion)) (fetch-rules [db query frame] @@ -41,4 +55,4 @@ (index-rule! db rule))) (defn new-db [] - (->InMemoryDB (atom {}) (atom {}))) + (->InMemoryDB (atom {}) (atom {}) (atom []) (atom []))) diff --git a/tests/sicp_logic/tests.clj b/tests/sicp_logic/tests.clj index 3d57894..e34a203 100644 --- a/tests/sicp_logic/tests.clj +++ b/tests/sicp_logic/tests.clj @@ -71,7 +71,13 @@ '[(job (Bitdiddle Ben) (computer wizard)) (job (Hacker Alyssa P) (computer programmer)) (job (Fect Cy D) (computer programmer)) - (job (Tweakit Lem E) (computer technician))])))) + (job (Tweakit Lem E) (computer technician))])) + (is (= (logic/query db [?key [Bitdiddle Ben] ?value]) + '[(address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)) + (job (Bitdiddle Ben) (computer wizard)) + (salary (Bitdiddle Ben) 60000) + (supervisor (Bitdiddle Ben) (Warbucks Oliver))])))) + (deftest compound-queries (let [db (memdb/new-db)]