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]
(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 [])))

8
tests/sicp_logic/tests.clj
View File

@ -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)]