From c0d98d33603c1bac3187bdcaf8b35a3c83fe8e27 Mon Sep 17 00:00:00 2001
From: Jeremy Dormitzer <jeremy.dormitzer@gmail.com>
Date: Mon, 8 Jul 2019 22:01:55 -0400
Subject: [PATCH] Initial commit

---
 .gitignore              |  2 +
 deps.edn                |  1 +
 src/sicp-logic/core.clj | 96 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 99 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 deps.edn
 create mode 100644 src/sicp-logic/core.clj

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..6192c3c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+.cpcache
+.nrepl-port
\ No newline at end of file
diff --git a/deps.edn b/deps.edn
new file mode 100644
index 0000000..0967ef4
--- /dev/null
+++ b/deps.edn
@@ -0,0 +1 @@
+{}
diff --git a/src/sicp-logic/core.clj b/src/sicp-logic/core.clj
new file mode 100644
index 0000000..2b8b14e
--- /dev/null
+++ b/src/sicp-logic/core.clj
@@ -0,0 +1,96 @@
+(ns sicp-logic.core)
+
+(declare qeval)
+
+(defn var? [exp])
+
+(defn binding-in-frame [var frame]
+  "Returns the value the `var` is bound to in `frame`, or nil."
+  (frame (second var)))
+
+
+(defn instantiate [q frame unbound-var-handler]
+  "Instantiates the query `q` with the variables bound in `frame`."
+  (letfn [(copy (fn [exp])
+               (cond (var? exp) (let [binding-value (binding-in-frame exp frame)]
+                                  (if binding-value
+                                    (copy binding-value)
+                                    (unbound-var-handler exp frame)))
+                     (seq? exp) (cons (copy (first exp)) (copy (rest exp)))
+                     :else exp))]
+    (copy q)))
+
+(defn conjoin [conjuncts input-frames]
+  (if (empty? conjuncts)
+    input-frames
+    (conjoin (rest conjuncts)
+             (qeval (first conjuncts) input-frames))))
+
+(defn disjoin [disjuncts input-frames]
+  (if (empty? disjuncts)
+    nil
+    (concat (qeval (first disjuncts) input-frames)
+            (disjoin (rest disjuncts) input-frames))))
+
+
+(defn negate [operands input-frames]
+  (filter
+   (fn [frame]
+     (empty? (qeval operands [frame])))
+   input-frames))
+
+(defn execute [exp]
+  (let [predicate (first exp)
+        args (rest exp)]
+    (apply (eval predicate) args)))
+
+(defn lisp-value [call input-frames]
+  (mapcat
+   (fn [frame]
+     (if (execute
+          (instantiate
+           call
+           frame
+           (fn [v f]
+             (throw (java.lang.IllegalArgumentException. (str "Unknown pattern variable -- LISP-VALUE: " v))))))
+       [frame]
+       []))
+   input-frames))
+
+(defn find-assertions [query frame])
+
+(defn apply-rules [query frame])
+
+(defn simple-query [q input-frames]
+  "Processes a simple query, producing a sequence of frames with bindings for the variables in `q`."
+  (mapcat
+   (fn [frame]
+     (concat
+      (find-assertions q frame)
+      (apply-rules q frame)))
+   input-frames))
+
+(defn qeval [q input-frames]
+  "Evaluates the query `q` in the context of the `input-frames`."
+  (let [q-type (first q)]
+    (cond
+      (= q-type 'and) (conjoin (rest q) input-frames)
+      (= q-type 'or) (disjoin (rest q) input-frames)
+      (= q-type 'not) (negate (rest q) input-frames)
+      (= q-type 'lisp-value (list-value (rest q) input-frames))
+      :else (simple-query q input-frames))))
+
+(defn contract-question-mark [v])
+
+(defmacro query [q]
+  "Queries the database for assertions that match the query."
+  `(map (fn [frame]
+          (instantiate (quote ~q) frame (fn [v f] (contract-question-mark v))))
+        ;; TODO expand variable names into [? var]
+    (qeval (quote ~q) [{}])))
+
+(defmacro assert! []
+  "Adds a new assertion to the database.")
+
+(defmacro defrule []
+  "Adds a new rule to the database.")