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

[WIP] Things are still broken

Browse Source
This commit is contained in:
Jeremy Dormitzer 2019-07-19 23:46:56 -04:00
parent 1d37d9d9e0
commit ade32d5bb9
2 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/sicp_logic/db/memory.clj
View File

@ -6,6 +6,12 @@
(defn get-indexed-assertions [db query] (defn get-indexed-assertions [db query]
(get @(:assertion-index db) (first 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] (defn index-assertion! [db assertion]
(swap! (swap!
(:assertion-index db) (:assertion-index db)
@ -13,6 +19,12 @@
(let [index-value (or (get index (first assertion)) [])] (let [index-value (or (get index (first assertion)) [])]
(assoc index (first assertion) (conj index-value 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] (defn get-indexed-rules [db query]
(concat (concat
(get @(:rule-index db) (first query)) (get @(:rule-index db) (first query))
@ -28,11 +40,13 @@
index-value (or (get index index-key) [])] index-value (or (get index index-key) [])]
(assoc index index-key (conj index-value rule)))))) (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 FactDB
(fetch-assertions [db query frame] (fetch-assertions [db query frame]
(let [instantiated (instantiate query frame (fn [v f] v))] (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] (add-assertion [db assertion]
(index-assertion! db assertion)) (index-assertion! db assertion))
(fetch-rules [db query frame] (fetch-rules [db query frame]
@ -41,4 +55,4 @@
(index-rule! db rule))) (index-rule! db rule)))
(defn new-db [] (defn new-db []
(->InMemoryDB (atom {}) (atom {}))) (->InMemoryDB (atom {}) (atom {}) (atom []) (atom [])))

8
tests/sicp_logic/tests.clj
View File

@ -71,7 +71,13 @@
'[(job (Bitdiddle Ben) (computer wizard)) '[(job (Bitdiddle Ben) (computer wizard))
(job (Hacker Alyssa P) (computer programmer)) (job (Hacker Alyssa P) (computer programmer))
(job (Fect Cy D) (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 (deftest compound-queries
(let [db (memdb/new-db)] (let [db (memdb/new-db)]