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

Fix compilation errors; implement variable parsing/printing

Browse Source
This commit is contained in:
Jeremy Dormitzer 2019-07-10 22:23:32 -04:00
parent c0d98d3360
commit f013c5a889
1 changed files with 25 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/sicp-logic/core.clj
View File

@ -11,12 +11,12 @@
(defn instantiate [q frame unbound-var-handler] (defn instantiate [q frame unbound-var-handler]
"Instantiates the query `q` with the variables bound in `frame`." "Instantiates the query `q` with the variables bound in `frame`."
(letfn [(copy (fn [exp]) (letfn [(copy [exp]
(cond (var? exp) (let [binding-value (binding-in-frame exp frame)] (cond (var? exp) (let [binding-value (binding-in-frame exp frame)]
(if binding-value (if binding-value
(copy binding-value) (copy binding-value)
(unbound-var-handler exp frame))) (unbound-var-handler exp frame)))
(seq? exp) (cons (copy (first exp)) (copy (rest exp))) (sequential? exp) (cons (copy (first exp)) (copy (rest exp)))
:else exp))] :else exp))]
(copy q))) (copy q)))
@ -77,17 +77,36 @@
(= q-type 'and) (conjoin (rest q) input-frames) (= q-type 'and) (conjoin (rest q) input-frames)
(= q-type 'or) (disjoin (rest q) input-frames) (= q-type 'or) (disjoin (rest q) input-frames)
(= q-type 'not) (negate (rest q) input-frames) (= q-type 'not) (negate (rest q) input-frames)
(= q-type 'lisp-value (list-value (rest q) input-frames)) (= q-type 'lisp-value) (lisp-value (rest q) input-frames)
:else (simple-query q input-frames)))) :else (simple-query q input-frames))))
(defn contract-question-mark [v]) (defn contract-question-mark [v]
(symbol
(str "?"
(second v))))
(defn map-over-symbols [proc exp]
(cond
(and (sequential? exp) (not (empty? exp)))
(cons (map-over-symbols proc (first exp))
(map-over-symbols proc (rest exp)))
(symbol? exp) (proc exp)
:else exp))
(defn expand-question-mark [sym]
(let [chars (str sym)]
(if (= "?" (subs chars 0 1))
['? (symbol (subs chars 1))]
sym)))
(defn query-syntax-process [q]
(map-over-symbols #'expand-question-mark q))
(defmacro query [q] (defmacro query [q]
"Queries the database for assertions that match the query." "Queries the database for assertions that match the query."
`(map (fn [frame] `(map (fn [frame]
(instantiate (quote ~q) frame (fn [v f] (contract-question-mark v)))) (instantiate (quote ~q) frame (fn [v f] (contract-question-mark v))))
;; TODO expand variable names into [? var] (qeval (query-syntax-process (quote ~q)) [{}])))
(qeval (quote ~q) [{}])))
(defmacro assert! [] (defmacro assert! []
"Adds a new assertion to the database.") "Adds a new assertion to the database.")