diff --git a/README.md b/README.md
index 9b212f8..2bbf818 100644
--- a/README.md
+++ b/README.md
@@ -1 +1,9 @@
# κανών
+
+A simple rule system in Janet using unification.
+
+Based on the one found in [Fogus’ Read-Eval-Print-Love 4](https://leanpub.com/readevalprintlove004/).
+
+
+
+Have fun!
diff --git a/kanon.janet b/kanon.janet
index 0caa9a9..09bb612 100644
--- a/kanon.janet
+++ b/kanon.janet
@@ -1,20 +1,7 @@
(use unify)
-(defn rand-nth [e] (math/floor (* (math/random) (length e))))
-
-(def rules
- '[{:antecedent [[?id :emergency/type :emergency.type/fire]]
- :consequent [[-1000 :response/type :response.type/activate-sprinklers]
- [-1000 :response/to ?id]]}
- {:antecedent [[?id :emergency/type :emergency.type/flood]]
- :consequent [[-1002 :response/type :response.type/kill-electricity]
- [-1002 :response/to ?id]]}])
-
-(def all-facts @[[-50 :emergency/type :emergency.type/fire]
- [-51 :emergency/type :emergency.type/flood]])
-
-(def KB {:rules rules
- :facts all-facts})
+(defn rand-nth [e]
+ (get e (math/floor (* (math/random) (length e)))))
(defn unifications [clause facts context]
(if (> (length clause) 0)
@@ -22,19 +9,26 @@
(mapcat |(unifications (slice clause 1) facts $) bindings))
[context]))
-# TODO
-(defn union [a b] a)
+(defn union [a b]
+ (reduce |(if (find (fn [x] (deep= x $1)) $0) $0 (array/push $0 $1)) a b))
(defn select-rule [selection-strategy rules facts]
(let [possibilities
(map |(let [bindings (unifications ($ :antecedent) facts {})]
- [$ bindings])
+ [$ (apply merge bindings)])
rules)]
(selection-strategy possibilities)))
(defn apply-rule [rule facts context]
- (let [new-facts (map |(apply-subst $ context) (rule :consequent))]
+ (let [new-facts (map |(apply-subst context $) (rule :consequent))]
(union new-facts facts)))
-(printf "%j" (let [[rule binds] (select-rule first (KB :rules) (KB :facts))]
- (apply-rule rule (KB :facts) binds)))
+(defn step [rules facts]
+ (when-let [[rule binds] (select-rule rand-nth rules facts)]
+ (apply-rule rule facts binds)))
+
+(defn cycle [pred rules facts]
+ (var res @[(step rules facts)])
+ (while (pred res)
+ (set res (array/push res (step rules facts))))
+ res)