Working

src/peano/blank_filling.clj

@@ -25,6 +25,13 @@
         (symbol? form) :presupplied-lvar
         (map? form) :blank-with-properties))
 
+(defn generate-run-form
+  ([guidance tree]
+     (let [q (gensym "q")]
+       `(l/run false [~q]
+               (l/fresh [~@(guidance :lvars-needed)]
+                        (l/== ~tree ~q)
+                        ~@(guidance :narrowers))))))
 
 
 (comment 

src/peano/guidance.clj

@@ -30,8 +30,11 @@
          (with-lvar new-symbol))
      new-symbol)))
 
+(defn typecast-lvar [lvar relation]
+  `(~(query-symbol relation) ~lvar))
+
 (defn property-narrower [[relation property] lvar required-value]
-  `(l/== (~(query-symbol relation property) ~lvar ~required-value)))
+  `(~(query-symbol relation property) ~lvar ~required-value))
 
 (defn with-narrower [guidance narrower]
   (assoc-into-vector guidance :narrowers narrower))

src/peano/selectors.clj

@@ -10,7 +10,8 @@
 ;; --
 
 ;; TODO: These `generate` functions are similar enough that an
-;; abstraction should be abstracted from them. 
+;; abstraction should be abstracted from them. See also
+;; `generate-run-form` in blank-filling.
 
 (defn generate-did-run-form
   ([run-count relation kvs]

test/peano/t_blank_filling.clj

@@ -54,6 +54,7 @@
 
 
 
+
 (comment
 
 (fact "trivial case produces no change"

test/peano/t_guidance.clj

@@ -39,10 +39,12 @@
 
 (fact "you can write a logic clause that forces an lvar to associate with a property"
   (property-narrower [:animal :name] 'animal-0 "bessy")
-  => '(clojure.core.logic/== (animal-name?? animal-0 "bessy")))
+  => '(animal-name?? animal-0 "bessy"))
 
 (fact "narrowers can be added into the guidance"
   (with-narrower {:key 1} '(a narrower)) => {:key 1, :narrowers '[(a narrower)]})
 
-
+(fact "you can 'typecast' a variable to a relation"
+  (typecast-lvar 'animal-0 :animal)
+  => '(animal?? animal-0))
 

test/peano/t_reservation_example.clj

@@ -2,9 +2,10 @@
   (:require [clojure.core.logic :as l])
   (:use midje.sweet
         clojure.pprint
+        [clojure.math.combinatorics :only [combinations]]
         peano.core
         peano.guidance
-        [peano.blank-filling :only [suggested-classifier]]))
+        [peano.blank-filling :only [suggested-classifier generate-run-form]]))
 
 (defmulti processor
   (fn [guidance blank & _] ((:classifier guidance) blank)))
@@ -42,11 +43,35 @@
 
 (defn simplify-and-process [guidance blank _ count-to-left]
   (processor guidance blank
-                   (if (= 0 count-to-left) :procedure :animal)))
+             (if (= 0 count-to-left) :procedure :animal)))
+
+(defn permitted-pairs-narrowers [guidance]
+  (map (fn [procedure animal] `(permitted?? ~procedure ~animal))
+       (guidance :procedure)
+       (guidance :animal)))
+
+(defn no-duplicate-groups-narrowers [uses]
+  (map (fn [[one two]] `(l/!= ~one ~two))
+       (combinations uses 2)))
+
+(fact "remove duplicate groups"
+  (no-duplicate-groups-narrowers [ [1 1] ]) => []
+  (no-duplicate-groups-narrowers [ [1 1] [2 2] [3 3]])
+  => (just '(clojure.core.logic/!= [1 1] [2 2])
+           '(clojure.core.logic/!= [1 1] [3 3])
+           '(clojure.core.logic/!= [2 2] [3 3])
+           :in-any-order))
+
+(defn postprocessor [guidance tree]
+  (let [narrowers (concat (permitted-pairs-narrowers guidance)
+                          (no-duplicate-groups-narrowers tree))
+        ]
+    (vector (merge-with concat guidance {:narrowers narrowers})
+            tree)))
 
 (def guidance {:classifier suggested-classifier
                :processor simplify-and-process
-               :postprocessor (fn [x y] [x y])})
+               :postprocessor postprocessor})
 
 ;;; About processing
 
@@ -94,4 +119,36 @@
                                :narrowers [narrower]})))
 
 
-(prn (fill-in-the-blanks guidance '[[_ "hank"] [myproc {:legs 4}]]))
+
+(data [animal :by :name]
+      {:name "betty" :species :bovine :legs 4}
+      {:name "julie" :species :bovine :legs 4}
+      {:name "jeff" :species :equine :legs 4}
+      {:name "hank" :species :equine :legs 3}) ; poor hank
+
+(data [procedure :by :name]
+      {:name "hoof trim" :species :equine :days-delay 0}
+      {:name "casting teeth" :species :equine :days-delay 0}
+      {:name "superovulation" :species :bovine :days-delay 90})
+
+(defn permitted?? [procedure animal]
+  (l/fresh [species]
+         (procedure-species?? procedure species)
+         (animal-species?? animal species)))
+
+(defmacro reservations [& tree]
+  (apply generate-run-form (fill-in-the-blanks guidance (vec tree))))
+
+(println "============== SIMPLE")
+(pprint (reservations [- -]))
+
+
+(println "============== BIG")
+(pprint (reservations [- "hank"] [- {:legs 3}]))
+
+
+
+
+; (pprint (apply generate-run-form (fill-in-the-blanks guidance '[[- "hank"] [- {:legs 3}]])))
+
+