initial done

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/).
+
+<hr/>
+
+Have fun!

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)