two.clj

(ns two
  (:require [clojure.core :as clojure])
  (:refer-clojure :exclude [boolean
                            double
                            long
                            resolve])
  (:import (java.util SplittableRandom)))

(defn mix*
  "Helper function for mix."
  {:private true}
  [colls]
  (if (seq colls)
    (if (seq (first colls))
      (lazy-seq (cons (ffirst colls)
                      (mix* (conj (subvec colls 1)
                                  (rest (first colls))))))
      (recur (subvec colls 1)))
    ()))

(defn mix
  "Like clojure.core/interleave but exhausts each supplied
  collection.
    (interleave [1 2 3] [\"a\" \"b\"] [:w :x :y :z])
    ;; =>
    (1 \"a\" :w 2 \"b\" :x)
    (mix [1 2 3] [\"a\" \"b\"] [:w :x :y :z])
    ;; =>
    (1 \"a\" :w 2 \"b\" :x 3 :y :z)"
  {:arglists '([coll1 coll2 & more-colls])}
  ([coll1 coll2]
   (if (seq coll1)
     (lazy-seq (cons (first coll1) (mix coll2 (rest coll1))))
     coll2))
  ([coll1 coll2 coll3]
   (if (seq coll1)
     (lazy-seq (cons (first coll1) (mix coll2 coll3 (rest coll1))))
     (mix coll2 coll3)))
  ([coll1 coll2 coll3 coll4]
   (if (seq coll1)
     (lazy-seq (cons (first coll1) (mix coll2 coll3 coll4 (rest coll1))))
     (mix coll2 coll3 coll4)))
  ([coll1 coll2 coll3 coll4 & more-colls]
   (mix* (into [coll1 coll2 coll3 coll4] more-colls))))

;; Two
;; ---------------------------------------------------------------------

(def UNBOUND
  (gensym "U__"))

(defn unbound?
  "true if x is the special value `UNBOUND`, false otherwise."
  {:inline (fn [x] `(identical? ~x UNBOUND))}
  [x] (identical? x UNBOUND))

(defn unbound []
  UNBOUND)

(defprotocol ICellPut
  (-cell-put [this x y]))

(defprotocol ICellMerge
  (-cell-merge [this x y]))

(defn merge-bindings [bindings-a bindings-b]
  (reduce
   (fn [bindings-c entry-x]
     (let [key-x (key entry-x)]
       (if-some [entry-y (find bindings-c key-x)]
         (let [val-c (-cell-merge key-x (val entry-x) (val entry-y))]
           (assoc bindings-c key-x val-c))
         (conj bindings-c entry-x)))))
  {:random (get bindings-b :random)
   :seed (get bindings-b :seed)}
  (concat (dissoc bindings-a :random :seed)
          (dissoc bindings-b :random :seed)))

(defprotocol IQuery
  (-query [this x bindings]))

(defn query
  "Return a lazy sequence of results."
  [p x bindings]
  (-query p x bindings))

;; A pattern may have zero or more known instances with respect to
;; bindings. For example, the value sequence pattern
;;
;;   (|| ?x ?y)
;;
;; with bindings {?y 2} has the knowable value sequence (2)
;; because ?x is not known but ?y is.
(defprotocol IInstances
  (-instances [this bindings]))

(defn instances
  [x bindings]
  (if (satisfies? IInstances x)
    (-instances x bindings)
    ()))

(defprotocol IYield
  (-yield [this bindings]))

(defn yield
  "Return a lazy sequence of results."
  [p bindings]
  (-yield p bindings))

;;

(defrecord Pass [value pattern bindings-in bindings-out next])

(defn pass
  "Construct and return an instance of `Pass` using the values of
  :value, :pattern, :bindings-in, :bindings-out, and :next from the
  `map?` m."
  {:arglists '([{:keys [value pattern bindings-in bindings-out next] :as m}])}
  [{:keys [value pattern bindings-in bindings-out next]}]
  (map->Pass {:bindings-in bindings-in
              :bindings-out bindings-out
              :next next
              :pattern pattern
              :value value}))

(defn pass?
  "true if x is an instance of `Pass`, false otherwise."
  [x]
  (instance? Pass x))

(defrecord Fail [value pattern bindings-in bindings-out next])

(defn fail
  "Construct and return an instance of `Fail` using the values of
  :value, :pattern, :bindings-in, :bindings-out, and :next from the
  `map?` m."
  [{:keys [value pattern bindings-in bindings-out next]}]
  (map->Fail {:bindings-in bindings-in
              :bindings-out bindings-out
              :next next
              :pattern pattern
              :value value}))

(defn fail?
  "true if x is an instance of `Fail`, false otherwise."
  [x]
  (instance? Fail x))

(defn result
  {:arglists '([{:keys [value pattern bindings-in bindings-out next pass?] :as m}])}
  [m]
  (if (get m :pass?)
    (pass m)
    (fail m)))

(defn segment
  {:arglists '([{:keys [bindings-in value pattern]} result])}
  [m result]
  (let [bindings-out (get result :bindings-out)
        data (merge m {:bindings-out bindings-out
                       :next result})]
    (cond
      (pass? result)
      (map->Pass data)

      (fail? result)
      (map->Fail data)

      :else
      (throw (ex-info "" {})))))

(defn xsegment
  [value pattern bindings]
  (map
   (fn [result]
     (segment {:bindings-in bindings
               :pattern pattern
               :value value}
              result))))

(defmacro map-segment
  {:style/indent 1}
  [{:keys [bindings-in pattern value]} coll]
  `(map (fn [result#]
          (segment {:bindings-in ~bindings-in
                    :pattern ~pattern
                    :value ~value}
                   result#))
        ~coll))

;; Code generation
;; ---------------------------------------------------------------------

(defprotocol IQueryCode
  (-query-code [this target environment]))

(defprotocol IYieldCode
  (-yield-code [this environment]))

(defn return-code [environment value-code]
  (let [return-symbol (get environment :return-symbol)]
    `(~return-symbol ~value-code)))

(defn return-bindings-code [environment]
  (return-code environment (get environment :bindings-symbol)))

(defn make-search-environment []
  {:return-symbol 'list
   :bindings-symbol (gensym "RHO__")})

;; Primitive pattern implementation
;; ---------------------------------------------------------------------

(defrecord Anything []
  IQuery
  (-query [this x bindings]
    (let [result (pass {:bindings-in bindings
                        :bindings-out bindings
                        :pattern this
                        :value x})]
      (list result)))

  IQueryCode
  (-query-code [this target environment]
    (return-bindings-code environment))

  IYield
  (-yield [this bindings]
    (list (pass {:bindings-in bindings
                 :bindings-out bindings
                 :pattern this
                 :value (reify)})))

  IYieldCode
  (-yield-code [this environment]
    (return-code environment `(reify))))




(defrecord Constant [x]
  IInstances
  (-instances [this bindings]
    (list x))

  IQuery
  (-query [this y bindings]
    (list (result {:bindings-in bindings
                   :bindings-out bindings
                   :pattern this
                   :pass? (= y x)
                   :value y})))

  IQueryCode
  (-query-code [this target environment]
    `(if (= ~target ~x)
       ~(return-bindings-code environment)
       ()))

  IYield
  (-yield [this bindings]
    (list (pass {:bindings-in bindings
                 :bindings-out bindings
                 :pattern this
                 :value x})))

  IYieldCode
  (-yield-code [this environment]
    (return-code x)))

(defn resolve
  [bindings x]
  (get bindings x UNBOUND))

(defrecord Cell [id fold unfold merge]
  ICellPut
  (-cell-put [this x y]
    (fold [x y]))

  ICellMerge
  (-cell-merge [this a b]
    (merge a b))

  IQuery
  (-query [this y bindings]
    (let [x (resolve bindings this)
          z (fold [x y])
          result (if (unbound? z)
                   (fail {:bindings-in bindings
                          :bindings-out bindings
                          :pattern this
                          :value y})
                   (pass {:bindings-in bindings
                          :bindings-out (assoc bindings this z)
                          :pattern this
                          :value y}))]
      (list result)))

  IYield
  (-yield [this bindings]
    (let [x (resolve bindings this)
          pair (unfold x)
          result (if (unbound? pair)
                   (fail {:bindings-in bindings
                          :bindings-out bindings
                          :pattern this
                          :value UNBOUND})
                   (let [y (nth pair 0)
                         z (nth pair 1)]
                     (pass {:bindings-in bindings
                            :bindings-out (assoc bindings this z)
                            :pattern this
                            :value y})))]
      (list result))))

(defrecord LogicCell [id]
  ICellPut
  (-cell-put [this a b]
    (if (unbound? a)
      b
      (if (unbound? b)
        a
        (if (= a b)
          a
          (unbound)))))

  ICellMerge
  (-cell-merge [this a b]
    (if (unbound? a)
      b
      (if (unbound? b)
        a
        (if (= a b)
          a
          (unbound)))))

  IInstances
  (-instances [this bindings]
    (let [x (resolve bindings this)]
      (if (unbound? x)
        ()
        (list x))))

  IQuery
  (-query [this y bindings]
    (let [x (resolve bindings this)
          result (if (unbound? x)
                   (pass {:bindings-in bindings
                          :bindings-out (assoc bindings this y)
                          :pattern this
                          :value y})
                   (result {:bindings-in bindings
                            :bindings-out bindings
                            :pass? (= x y)
                            :pattern this
                            :value y}))]
      (list result)))

  IYield
  (-yield [this bindings]
    (let [x (resolve bindings this)]
      (list (result {:bindings-in bindings
                     :bindings-out bindings
                     :pass? (unbound? x)
                     :pattern this
                     :value x})))))

(defrecord MutableCell [id]
  ICellPut
  (-cell-put [this a b]
    b)

  ICellMerge
  (-cell-merge [this a b]
    b)

  IInstances
  (-instances [this bindings]
    (let [x (resolve bindings this)]
      (if (unbound? x)
        ()
        (list x))))

  IQuery
  (-query [this y bindings]
    (let [x (resolve bindings this)
          result (pass {:bindings-in bindings
                        :bindings-out (assoc bindings this y)
                        :pattern this
                        :value y})]
      (list result)))

  IYield
  (-yield [this bindings]
    (let [x (resolve bindings this)
          result (if (unbound? x)
                   (fail {:bindings-in bindings
                          :bindings-out bindings
                          :pattern this
                          :value UNBOUND})
                   (pass {:bindings-in bindings
                          :bindings-out bindings
                          :pattern x
                          :value UNBOUND}))]
      (list result))))

(defn yield-and
  {:private true}
  [p1 p2 bindings]
  (mapcat
   (fn [result]
     (if (pass? result)
       (query p2 (get result :value) (get result :bindings-out))
       (list result)))
   (yield p1 bindings)))

(defrecord And [p1 p2]
  IQuery
  (-query [this x bindings]
    (sequence
     (comp (mapcat
            (fn [result]
              (if (pass? result)
                (query p2 x (get result :bindings-out))
                (list result))))
           (xsegment x this bindings))
     (query p1 x bindings)))

  IYield
  (-yield [this bindings]
    (map
     (fn [result]
       (segment {:bindings-in bindings
                 :value (get result :value)
                 :pattern this}
                result))
     (mix (yield-and p1 p2 bindings)
          (yield-and p2 p1 bindings)))))

(defrecord Or [p1 p2]
  IInstances
  (-instances [this bindings]
    (mix (instances p1 bindings)
         (instances p2 bindings)))

  IQuery
  (-query [this x bindings]
    (sequence
     (xsegment x this bindings)
     (mix (query p1 x bindings)
          (query p2 x bindings))))

  IYield
  (-yield [this bindings]
    (mix (yield p1 bindings)
         (yield p2 bindings))))

(defrecord Predicate [f]
  IQuery
  (-query [this x bindings]
    (list (result {:bindings-in bindings
                   :bindings-out bindings
                   :pass? (f x)
                   :pattern this
                   :value x})))

  IYield
  (-yield [this bindings]
    (let [g (get bindings f)]
      (map
       (fn [result]
         (segment {:bindings-in bindings
                   :value (get result :value)
                   :pattern this}
                  result))
       (yield g bindings)))))


;; Pattern API
;; ---------------------------------------------------------------------

(def anything
  (Anything.))

(defn is [x]
  (Constant. x))

(defn &&
  ([p1] p1)
  ([p1 p2]
   (And. p1 p2))
  ([p1 p2 & more]
   (&& p1 (apply && p2 more))))

(defn ||
  ([p1] p1)
  ([p1 p2]
   (Or. p1 p2))
  ([p1 p2 & more]
   (|| p1 (apply || p2 more))))

(defn in [coll]
  (reify
    IInstances
    (-instances [this bindings]
      (sequence coll))

    IQuery
    (-query [this x bindings]
      (sequence
       (comp (map (fn [result]
                    (if (pass? result)
                      (let [y (get result :value)]
                        (if (= x y)
                          result
                          (fail {:bindings-in bindings
                                 :bindings-out bindings
                                 :pattern this
                                 :value x
                                 :next result})))
                      (fail {:bindings-in bindings
                             :bindings-out bindings
                             :pattern this
                             :value x
                             :next result}))))
             (xsegment x this bindings))
       (yield this bindings)))

    IYield
    (-yield [this bindings]
      (map
       (fn [x]
         (pass {:bindings-in bindings
                :bindings-out bindings
                :pattern this
                :value x}))
       coll))))



(defn yield-map
  ([f p1 bindings]
   (map (fn [result-p1]
          (if (pass? result-p1)
            (f result-p1)
            result-p1))
        (yield p1 bindings)))
  ([f p1 p2 bindings]
   (mapcat
    (fn [result-p1]
      (if (pass? result-p1)
        (let [value-p1 (get result-p1 :value)
              bindings-out-p1 (get result-p1 :bindings-out)]
          (map
           (fn [result-p2]
             (if (pass? result-p2)
               (f result-p1 result-p2)
               result-p2))
           (yield p2 bindings-out-p1)))
        (list result-p1)))
    (yield p1 bindings))))

(defn pair [p1 p2]
  (reify
    IInstances
    (-instances [this bindings]
      (mapcat
       (fn [x]
         (mapcat (fn [y] [x y]) (instances p2 bindings)))
       (instances p1)))

    IQuery
    (-query [this value bindings]
      (if (and (sequential? value)
               (= (bounded-count 3 value) 2))
        (let [a (nth value 0)
              b (nth value 1)]
          (sequence
           (comp (mapcat
                  (fn [a-result]
                    (let [a-bindings (get a-result :bindings-out)]
                      (if (pass? a-result)
                        (query p2 b a-bindings)
                        (list a-result)))))
                 (xsegment value this bindings))
           (query p1 a bindings)))
        (list (fail {:bindings-in bindings
                     :bindings-out bindings
                     :pattern this
                     :value value
                     :next nil}))))

    IYield
    (-yield [this bindings]
      (yield-map
       (fn [r1 r2]
         (segment {:bindings-in bindings
                   :value [(get r1 :value) (get r2 :value)]
                   :pattern this}
                  (segment r1 r2)))
       p1 p2 bindings))))

;; Cells
;; -----

(defn make-cell
  [fold unfold merge]
  (map->Cell {:id (gensym "$__")
              :fold fold
              :merge merge
              :unfold unfold}))

(defn make-fold
  [initialize reduce]
  (fn [[x y :as pair]]
    (if (unbound? x)
      (initialize y)
      (reduce pair))))

(defn make-unfold
  [terminal? value new-state]
  (fn [x]
    (if (terminal? x)
      UNBOUND
      [(value x) (new-state x)])))

(defn logic-cell []
  (LogicCell. (gensym "?__")))

(def cons-fold
  (make-fold list (fn [[x y]] (conj x y))))

(def conj-fold
  (make-fold vector (fn [[x y]] (conj x y))))

(def first-unfold
  (make-unfold (some-fn unbound? empty?) first rest))

(defn fifo-cell []
  (make-cell conj-fold first-unfold into))

(defn lifo-cell []
  (make-cell cons-fold first-unfold concat))

(defn next-boolean [bindings]
  (let [random (get bindings :random)]
    (.nextBoolean ^SplittableRandom random)))

(defn next-double
  ([bindings]
   (let [random (get bindings :random)]
     (.nextDouble ^SplittableRandom random)))
  ([bindings ^double origin ^double bound]
   (let [random (get bindings :random)]
     (.nextDouble ^SplittableRandom random))))

(defn next-int
  ([bindings]
   (let [random (get bindings :random)]
     (.nextInt ^SplittableRandom random)))
  ([bindings ^long origin ^long bound]
   (let [random (get bindings :random)]
     (.nextInt ^SplittableRandom random (int origin) (int bound)))))

(defn next-long
  ([bindings]
   (let [random (get bindings :random)]
     (.nextLong ^SplittableRandom random)))
  ([bindings ^long origin ^long bound]
   (let [random (get bindings :random)]
     (.nextLong ^SplittableRandom random origin bound))))

(defn split [bindings]
  (let [old-random (get bindings :random)
        new-random (.split ^SplittableRandom old-random)]
    (assoc bindings :random new-random)))

(def boolean
  (reify
    IQuery
    (-query [this value bindings]
      (list (result {:bindings-in bindings
                     :bindings-out bindings
                     :pass? (boolean? value)
                     :pattern this
                     :value value})))

    IYield
    (-yield [this bindings]
      (let [bool-a (next-boolean bindings)
            bool-b (not bool-a)]
        (list (pass {:bindings-in bindings
                     :bindings-out bindings
                     :pattern this
                     :value bool-a})
              (pass {:bindings-in bindings
                     :bindings-out bindings
                     :pattern this
                     :value bool-b}))))))

(defn pred [p g]
  (reify
    IInstances
    (-instances [this bindings]
      (g bindings))

    IQuery
    (-query [this value bindings]
      (list (result {:bindings-in bindings
                     :bindings-out bindings
                     :pass? (p value)
                     :pattern this
                     :value value})))

    IYield
    (-yield [this bindings]
      (map (fn [value]
             (pass {:bindings-in bindings
                    :bindings-out bindings
                    :pattern this
                    :value value}))
           (g bindings)))))

(defn long?
  [x] (instance? Long x))


(defn long-stream [bindings origin bound]
  ((fn f [low hi]
     (if (<= hi low)
       ()
       (let [i (next-long bindings low hi)]
         (lazy-seq (cons i (concat (f low i) (f (inc i) hi) ))))))
   origin bound))

(defn long-generator [origin bound]
  (fn [bindings]
    (long-stream bindings origin bound)))


(defn values? [x]
  (clojure/boolean (seq x)))

(defn long-3 [p p-origin p-bound]
  (reify
    IQuery
    (-query [this value bindings-in]
      (if (long? value)
        (let [bindings-out (split bindings-in)
              ;; All known long values. If this seq has at least one value we know
              is (filter (fn [x]
                           (= value x))
                         (instances p bindings-out))
              ;; All known origin values
              js (filter (fn [x]
                           (and (long? x) (<= x value)))
                         (instances p-origin bindings-out))
              ;; All known bound values
              ks (filter (fn [x]
                           (and (long? x) (<= value x)))
                         (instances p-bound bindings-out))]
          (case [(values? is) (values? js) (values? ks)]
            ;; All possible values are known.
            [true true true]
            (list (pass {:bindings-in bindings-in
                         :bindings-out bindings-out
                         :pattern this
                         :value value}))

            ;; Bound is unknown
            [true true false]
            (mapcat
             (fn [j]
               (mapcat
                (fn [k]
                  (map
                   (fn [result]
                     (segment {:bindings-in bindings-in
                               :value value
                               :pattern this}
                              result))
                   (query p-bound k bindings-in)))
                (long-stream bindings-out j Long/MAX_VALUE)))
             js)

            ;; Origin is unknown
            [true false true]
            (mapcat
             (fn [k]
               (mapcat
                (fn [j]
                  (map
                   (fn [result]
                     (segment {:bindings-in bindings-in
                               :value value
                               :pattern this}
                              result))
                   (query p-origin j bindings-in)))
                (long-stream bindings-out Long/MIN_VALUE k)))
             ks)

            [true false false]
            (mapcat
             (fn [j]
               (mapcat
                (fn [k]
                  (query (pair p-origin p-bound) [j k] bindings-out)
                  #_
                  (mapcat
                   (fn [result-origin]
                     (if (pass? result-origin)
                       (map
                        (fn [result-bound]
                          (segment {:bindings-in bindings-in
                                    :value value
                                    :pattern this}
                                   result-bound))
                        (query p-bound k (get result-origin :bindings-out)))
                       (list result-origin)))
                   (query p-origin j bindings-out)))
                (long-stream bindings-out value Long/MAX_VALUE)))
             (long-stream bindings-out Long/MIN_VALUE value))))))

    IYield
    (-yield [this bindings]
      )))



(defn long
  ([]
   (long Long/MIN_VALUE Long/MAX_VALUE))
  ([origin bound]
   (pred (fn [x]
           (and (long? x) (<= origin bound)))
         (long-generator origin bound))))

(defn double
  ([]
   (double Double/MIN_VALUE Double/MAX_VALUE))
  ([^double origin ^double bound]
   (pred double? (fn [bindings]
                   ((fn f [low hi]
                      (if (<= hi low)
                        ()
                        (let [i (next-double bindings low hi)]
                          (lazy-seq (cons i (concat (f low i) (f (inc i) hi) ))))))
                    origin bound)))))

(defn number
  ([]
   (|| (long) (double)))
  ([origin bound]
   (|| (long origin bound) (double origin bound))))

;; (set! *warn-on-reflection* true)

;; (next-int (make-bindings 0) 1 2)

(defn sum
  [p1 p2]
  (reify
    IInstances
    (-instances [this bindings]
      (let [p1-numbers (filter number? (instances p1 bindings))
            p2-numbers (filter number? (instances p2 bindings))]
        (mapcat (fn [i]
                  (map (fn [j]
                         (+ i j))
                       p2-numbers))
                p1-numbers)))

    IQuery
    (-query [this value bindings]
      (if (number? value)
        (if (integer? value)
          (let [;; Do the bindings need to be split?
                p1-numbers (filter number? (instances p1 bindings))
                p2-numbers (filter number? (instances p2 bindings))]
            (case [(clojure/boolean (seq p1-numbers)) (clojure/boolean (seq p2-numbers))]
              [true true]
              (mapcat (fn [p1-value]
                        (map (fn [p2-value]
                               (result {:bindings-in bindings
                                        :bindings-out bindings
                                        :value value
                                        :pattern this
                                        :pass? (= (+ p1-value p2-value) value)}))
                             p2-numbers))
                      p1-numbers)

              [true false]
              (mapcat (fn [p1-value]
                        (let [p2-value (- value p1-value)]
                          (query p2 p2-value bindings)))
                      p1-numbers)

              [false true]
              (mapcat (fn [p2-value]
                        (let [p1-value (- value p2-value)]
                          (query p1 p1-value bindings)))
                      p2-numbers)

              [false false]
              (mapcat
               (fn [p1-value]
                 (let [p2-value (- value p1-value)]
                   (mapcat
                    (fn [p1-result]
                      (if (pass? p1-result)
                        (let [p1-bindings (get p1-result :bindings-out)]
                          (query p2 p2-value p1-bindings))
                        (list p1-result)))
                    (query p1 p1-value bindings))))
               (instances (number) bindings))))
          (throw (ex-info "" {})))
        (list (fail {:bindings-in bindings
                     :bindings-out bindings
                     :value value
                     :pattern this
                     :next nil}))))

    IYield
    (-yield [this bindings]
      (mapcat
       (fn [p1-result]
         (let [p1-result-value (get p1-result :value)]
           (if (number? p1-result-value)
             (map
              (fn [p2-result]
                (let [p2-result-value (get p2-result :value)]
                  (if (number? p2-result-value)
                    (segment {:bindings-in bindings
                              :value (+' p1-result-value p2-result-value)
                              :pattern this}
                             (segment p1-result p2-result))
                    (fail p2-result))))
              (yield p2 (get p1-result :bindings-out)))
             (list (fail p1-result)))))
       (yield p1 bindings)))))


;; Regex patterns

(defrecord Concat [p-left p-right]
  )

(defrecord Cons [p-head p-tail]
  IQuery
  (-query [this value bindings-in]
    (if (and (sequential? value)
             (seq value))
      (let [head (nth value 0)
            tail (rest value)]
        (map (fn [result]
               (segment {:bindings-in bindings-in
                         :pattern this
                         :value value}
                        result))
             (mapcat
              (fn [result-head]
                (if (pass? result-head)
                  (map (fn [result-tail]
                         (segment result-head result-tail))
                       (query p-tail tail (get result-head :bindings-out)))
                  (list result-head)))
              (query p-head head bindings-in))))
      (fail {:bindings-in bindings-in
             :bindings-out bindings-in
             :next nil
             :pattern this
             :value value})))

  IYield
  (-yield [this bindings]
    (map
     (fn [result]
       )
     (yield (pair p-head p-tail) bindings))

   ))



(let [?x (logic-cell)
      ?y (logic-cell)]
  (query (Cons. (is 2) ?y)
         (list 1 2 3)
         (make-bindings 0)
         ))

#_
(let [?x (logic-cell)
      ?y (logic-cell)]
  (map pass?
       (query (long 1 10) 11 (make-bindings 10)))
  #_
  (map #(vector (get % ?x)
                (get % ?y)
                )
       (map :bindings-out
            (filter pass?
                    (take 10
                          (query (sum (&& (long 1 10) ?x) ?y) 3 (make-bindings 10)))))))

(def predicate-bindings
  {any? anything
   boolean? boolean})

(defn make-bindings
  [^long seed]
  (let [random (SplittableRandom. seed)]
    {:seed seed
     :random random}))

#_
(let [?x (logic-cell)
      ?y (logic-cell)]
  (map (juxt :value :bindings-out)
       (filter pass?
               (take 40
                     (yield (sum (&& (long) ?x)
                                 (&& (long) ?y))
                            (make-bindings 10))))))


#_
[associative?
 bound?
 bytes?
 char?
 chunked-seq?
 class?
 coll?
 contains?
 counted?
 decimal?
 delay?
 distinct?
 double?
 empty?
 even?
 every?
 extends?
 false?
 float?
 fn?
 future-cancelled?
 future-done?
 future?
 ident?
 identical?
 ifn?
 indexed?
 inst?
 instance?
 int?
 integer?
 isa?
 keyword?
 list?
 map-entry?
 map?
 nat-int?
 neg-int?
 neg?
 nil?
 not-any?
 not-every?
 number?
 odd?
 pos-int?
 pos?
 qualified-ident?
 qualified-keyword?
 qualified-symbol?
 ratio?
 rational?
 reader-conditional?
 realized?
 record?
 reduced?
 reversible?
 satisfies?
 seq?
 seqable?
 sequential?
 set?
 simple-ident?
 simple-keyword?
 simple-symbol?
 some?
 sorted?
 special-symbol?
 string?
 symbol?
 tagged-literal?
 thread-bound?
 true?
 uri?
 uuid?
 var?
 vector?
 volatile?
 zero?]

#_
(defn group-by-cell [f]
  (make-cell
   (make-fold
    (fn initialize [x]
      (let [y (f x)]
        (with-meta {y [x]} {:history [y]})))
    (fn reduce [[m x]]
      (let [y (f x)]
        (vary-meta (update m y (fnil conj []) x) update :history conj y))))
   (make-unfold
    ;; terminal?
    (some-fn unbound? empty?)
    (fn value [m]
      (let [history (get (meta m) :history)
            k (first history)
            vs (get m k)]
        (first vs)))
    (fn new-state [m]
      (let [history (get (meta m) :history)
            k (first history)
            vs* (rest (get m k))]
        (with-meta (if (seq vs*)
                     (assoc m k vs*)
                     (dissoc m k))
          {:history (rest history)}))))))

#_
(let [*x (group-by-cell (fn [x] (even? x)))
      pattern (pair (pair *x *x) (pair *x *x))]
  (map :value (yield pattern {*x (with-meta {true [2 4], false [3 5]}
                                   {:history [true false true false]})})))
;; =>
#_
([[2 3] [4 5]])


#_
(let [?x (logic-cell)
      x-> (lifo-cell)
      x<- (fifo-cell)
      p1 in-odd
      p2 in-even
      pattern (pair (&& (in [1 2 3]) x<- x->)
                    (&& (in [4 5 6]) x<- x->))
      value 1
      extract-bindings (fn [result]
                         (let [bindings (get result :bindings-out)]
                           {'x-> (get bindings x->)
                            'x<- (get bindings x<-)}))]
  [;; Query the pair [2 6] against the pattern and pull out the
   ;; passing bindings.
   (map extract-bindings
        (filter pass? (query pattern [2 6] {})))
   ;; Attempt to generate 20 solutions and pull out the passing value
   ;; and binding.s
   (map (juxt :value extract-bindings)
        (filter pass? (take 30 (yield pattern {}))))])
;; =>
#_
[({x-> (6 2), x<- [2 6]})
 ([[1 4] {x-> (4 1), x<- [1 4]}]
  [[1 5] {x-> (5 1), x<- [1 5]}]
  [[1 6] {x-> (6 1), x<- [1 6]}]
  [[2 4] {x-> (4 2), x<- [2 4]}]
  [[2 5] {x-> (5 2), x<- [2 5]}]
  [[2 6] {x-> (6 2), x<- [2 6]}])]


(let [?x (logic-cell)]
  (-cell-merge ?x 1 2))

(make-bindings 0)