* src/main/clojure/clojure/core/logic/dcg.clj: support for preventing…

… DCG transform

src/main/clojure/clojure/core/logic/dcg.clj

@@ -10,10 +10,6 @@
 (defn lsym [n]
   (gensym (str "l" n "_")))
 
-;; this is not going to work, will need to put some more thought on how
-;; to do the lookup logic, it doesn't work because we need 1 more than
-;; what is required
-
 (defn !dcg? [clause]
   (and (sequential? clause)
        (let [f (first clause)]
@@ -26,28 +22,42 @@
      (let [m (if quoted `(quote ~m) m)]
        `(== ~(env (dec i)) (lcons ~m ~(env i))))))
 
-(defn handle-clause [env c i]
+(defn mark-clauses
+  ([clauses] (mark-clauses clauses 0))
+  ([clauses start]
+     (let [i (atom start)]
+       (map (fn [clause]
+              (if (!dcg? clause)
+                clause
+                (with-meta clause
+                  {:index (swap! i clojure.core/inc)})))
+            clauses))))
+
+(defn handle-clause [env c]
   (cond
-   (!dcg? c) (first c)
-   (vector? c) (->lcons env c i)
+   (!dcg? c) (second c)
+   (vector? c) (->lcons env c (-> c meta :index))
    (and (seq? c)
         (= (first c) `quote)
-        (vector? (second c))) (->lcons env (second c) i true)
-   :else (let [c (if (seq? c) c (list c))]
+        (vector? (second c))) (->lcons env (second c) (-> c meta :index) true)
+   :else (let [i (-> c meta :index)
+               c (if (seq? c) c (list c))]
            (concat c [(env (dec i)) (env i)]))))
 
 (defmacro --> [name & clauses]
   (let [r (range 1 (+ (count clauses) 2))
         lsyms (into [] (map lsym r))
-        clauses (map (partial handle-clause lsyms) clauses r)]
+        clauses (mark-clauses clauses)
+        clauses (map (partial handle-clause lsyms) clauses)]
     `(defn ~name [~(first lsyms) ~(last lsyms)]
        (exist [~@(butlast (rest lsyms))]
          ~@clauses))))
 
 (defmacro def--> [name args & clauses]
   (let [r (range 1 (+ (count clauses) 2))
         lsyms (map lsym r)
-        clauses (map (partial handle-clause lsyms) clauses r)]
+        clauses (mark-clauses clauses)
+        clauses (map (partial handle-clause lsyms) clauses)]
    `(defn ~name [~@args ~(first lsyms) ~(last lsyms)]
       (exist [~@(butlast (rest lsyms))]
         ~@clauses))))
@@ -56,7 +66,8 @@
   (let [c (count cclause)
         r (range 2 (clojure.core/inc c))
         lsyms (conj (into [fsym] (map lsym r)) osym)
-        clauses (map (partial handle-clause lsyms) cclause (range 1 (+ c 2)))]
+        clauses (mark-clauses cclause)
+        clauses (map (partial handle-clause lsyms) clauses)]
     `(exist [~@(butlast (rest lsyms))]
        ~@clauses)))
 
@@ -91,6 +102,9 @@
   (--> vp v np)
   (--> s np vp)
 
+  ;; we can stop the dcg transform
+  (--> s np (!dcg (== 1 1)) vp)
+
   ;; success
   (run* [q]
     (np '[the witch] []))
@@ -119,15 +133,15 @@
   (def-->e sentence [s]
     ([[:s ?np ?vp]] (noun-phrase ?np) (verb-phrase ?vp)))
 
-  (run* [parse-tree]
+  (run 1 [parse-tree]
     (sentence parse-tree '[the bat eats a cat] []))
 
   ;; ([:s [:np [:d the] [:n bat]] [:vp [:v eats] [:np [:d a] [:n cat]]]])
 
-  ;; ~70ms
+  ;; ~90-100ms
   (dotimes [_ 10]
     (time
-     (dotimes [_ 1e3]
-       (run* [parse-tree]
+     (dotimes [_ 1e4]
+       (run 1 [parse-tree]
          (sentence parse-tree '[the bat eats a cat] [])))))
   )