meander_delta_interpreter.clj

(ns meander.interpret.delta
  (:require [meander.match.delta :as r.match]
            [meander.syntax.delta :as r.syntax]
            [meander.util.delta :as r.util]))

(defn genmut
  []
  {:tag :mut
   :symbol (gensym "*m__")})

(defn search [[target pattern env]]
  (r.match/find [target pattern env]
    ;; Constants
    ;; ---------

    ;; literal

    [?x {:tag :lit :value ?x} ?env]
    (list ?env)

    [?x {:tag :lit :value (not ?x)} ?env]
    nil

    ;; quote

    [?x {:tag :quo :form ?x} ?env]
    (list ?env)

    [?x {:tag :quo :form (not ?x)} ?env]
    nil

    ;; Variables
    ;; ---------

    ;; any

    [_ {:tag :any} ?env]
    (list ?env)

    ;; logic variable

    [?x {:tag :lvr :as ?lvr} {?lvr ?x :as ?env}]
    (list ?env)

    [?x {:tag :lvr :as ?lvr} {?lvr (not ?x)}]
    nil

    [?x {:tag :lvr :as ?lvr} (not {?lvr _})]
    (list (assoc env ?lvr ?x))

    ;; memory variable

    [?x {:tag :mvr :as ?mvr} {?mvr ?xs :as ?env}]
    (list (update ?env ?mvr conj ?x))

    [?x {:tag :mvr :as ?mvr} (not {?mvr _})]
    (list (assoc env ?mvr [?x]))

    ;; mutable

    [?x {:tag :mut :as ?mut} ?env]
    (list (assoc ?env ?mut ?x))

    ;; reference

    [?x {:tag :ref :as ?ref} {?ref ?pattern :as ?env}]
    (search [?x ?pattern ?env])

    [?x {:tag :ref :as ?ref} (not {?ref _})]
    nil
    ;; Logic
    ;; -----

    ;; and

    [_ {:tag :cnj :arguments (or [] ())} ?env]
    (list ?env)

    [?x
     {:tag :cnj
      :arguments (or [?y . !ys ...] (?y . !ys ...))}
     ?env]
    (mapcat
     (fn [?env*]
       (search [?x {:tag :cnj :arguments !ys} ?env*]))
     (search [?x ?y ?env]))

    ;; or

    [_ {:tag :dsj :arguments (or [] ())} _]
    nil

    [?x {:tag :dsj :arguments (or [!xs ...] (!xs ...))} ?env]
    (mapcat
     (fn [x]
       (search [?x x ?env]))
     !xs)

    ;; not

    [?x {:tag :not :argument ?y} ?env]
    (if (seq (search [?x ?y ?env]))
      nil
      (list ?env))

    ;; Inductive collections
    ;; ---------------------

    ;; vector

    [[_ ... :as ?x] {:tag :vec :prt ?prt} ?env]
    (search [?x ?prt ?env])

    ;; seq

    [(_ ... :as ?x) {:tag :seq :prt ?prt} ?env]
    (search [?x ?prt ?env])

    ;; partition

    [[_ ... :as ?x] {:tag :prt, :left ?left, :right ?right} ?env]
    (case [(r.syntax/variable-length? ?left) (r.syntax/variable-length? ?right)]
      ([false false] [false true])
      (let [left-length (r.syntax/min-length ?left)
            left (subvec ?x 0 (min (count ?x) left-length))
            right (subvec ?x (min (count ?x) left-length))]
        (mapcat
         (fn [?env*]
           (search [right ?right ?env*]))
         (search [left ?left ?env])))

      ([true false] [true true])
      (mapcat
       (fn [[left right]]
         (mapcat
          (fn [?env*]
            (search [right ?right ?env*]))
          (search [left ?left ?env])))
       (r.util/partitions 2 ?x)))

    [(_ ... :as ?x) {:tag :prt, :left ?left, :right ?right} ?env]
    (case [(r.syntax/variable-length? ?left) (r.syntax/variable-length? ?right)]
      ([false false] [false true])
      (let [left-length (r.syntax/min-length ?left)
            left (take left-length ?x)
            right (drop left-length ?x)]
        (mapcat
         (fn [?env*]
           (search [right ?right ?env*]))
         (search [left ?left ?env])))

      ([true false] [true true])
      (mapcat
       (fn [[left right]]
         (mapcat
          (fn [?env*]
            (search [right ?right ?env*]))
          (search [left ?left ?env])))
       (r.util/partitions 2 ?x)))

    ;; concatenation

    [(or [] ())
     {:tag :cat
      :elements (or [] ())}
     ?env]
    (list ?env)

    [(or [?x] (?x))
     {:tag :cat
      :elements (or [?y] (?y))}
     ?env]
    (search [?x ?y ?env])

    [(or [?x . !xs ...] (?x . !xs ...))
     {:tag :cat
      :elements (or [?y . !ys ...] (?y . !ys ...))}
     ?env]
    (mapcat
     (fn [?env*]
       (search [!xs {:tag :cat :elements !ys} ?env*]))
     (search [?x ?y ?env]))

    ;; Noninductive collections
    ;; ------------------------

    ;; map

    [{:as ?x}
     {:tag :map
      :rest-map (and (not nil) ?rest-map)
      :map '{}}
     ?env]
    (search [?x ?rest-map ?env])

    [{} {:tag :map :map '{}} ?env]
    (list ?env)

    [{:as ?x}
     {:tag :map
      ':as (and (not nil) ?y)
      & ?rest-map}
     ?env]
    (mapcat
     (fn [?env*]
       (search [?x (assoc ?rest-map :tag :map) ?env*]))
     (search [?x ?y ?env]))

    [{:as ?x}
     {:tag :map
      :rest-map ?rest-map
      :map {(or {:tag :lit :value ?k}
                {:tag :quo :form ?k}) ?v
            & ?map}}
     ?env]
    (mapcat
     (fn [?env*]
       (search [(dissoc ?x ?k)
                {:tag :map
                 :rest-map ?rest-map
                 :map ?map}
                ?env*]))
     (search [(get ?x ?k) ?v ?env]))

    [{:as ?x}
     {:tag :map
      :rest-map ?rest-map
      :map ?map}
     ?env]
    (let [?x-set (set ?x)
          muts (repeatedly (count ?map) genmut)
          ?elements (map
                     (fn [[?key ?val] mut]
                       {:tag :cat
                        :elements [{:tag :cnj
                                    :arguments [?key mut]}
                                   ?val]})
                     ?map
                     muts)]
      (mapcat
       (fn [?env*]
         (let [?x* (reduce
                    (fn [?x* mut]
                      (dissoc ?x* (get ?env* mut)))
                    ?x
                    muts)
               ?env* (reduce dissoc ?env* muts)]
           (search [?x*
                    {:tag :map
                     :rest-map ?rest-map
                     :map {}}
                    ?env*])))
       (search [?x-set
                {:tag :set
                 :elements ?elements}
                ?env])))

    ;; set

    [#{^:as ?x}
     {:tag :set
      ':as (and (not nil) ?as)
      :elements ?elements}
     ?env]
    (mapcat
     (fn [?env*]
       [?x
        {:tag :set
         :as nil
         :elements ?elements}
        ?env*])
     (search [?x ?as ?env]))

    [#{^:as ?x}
     {:tag :set
      :rest (and (not nil) ?rest-set)
      :elements (or [] ())}
     ?env]
    (search [?x ?rest-set ?env])

    [#{}
     {:tag :set
      :elements (or [] ())}
     ?env]
    (list ?env)

    [#{^:as ?x}
     {:tag :set
      :rest ?rest-set
      :elements ?elements}
     ?env]
    (mapcat
     (fn [combination]
       (let [muts (repeatedly (count ?elements) genmut)
             ?elements* (map
                         (fn [?element mut]
                           {:tag :cnj
                            :arguments [?element mut]})
                         ?elements
                         muts)]
         (mapcat
          (fn [?env*]
            (let [?x* (reduce
                       (fn [?x* mut]
                         (disj ?x* (get ?env* mut)))
                       ?x
                       muts)
                  ?env* (reduce dissoc ?env* muts)]
              (search [?x*
                       {:tag :set
                        :rest ?rest-set
                        :elements ()}
                       ?env*])))
          (search [combination
                   {:tag :cat
                    :elements ?elements*}
                   ?env]))))
     (r.util/k-combinations ?x (count ?elements)))

    ;; Operators
    ;; ---------

    ;; drop

    [(or (_ ... :as ?x) [_ ... :as ?x]) {:tag :drp} ?env]
    (list ?env)

    ;; rest

    [(or (_ ... :as ?x) [_ ... :as ?x]) {:tag :rst :mvr ?mvr} {?mvr _ :as ?env}]
    (list (update ?env ?mvr into ?x))

    [(or (_ ... :as ?x) [_ ... :as ?x]) {:tag :rst :mvr ?mvr} ?env]
    (list (assoc ?env ?mvr (vec ?x)))

    ;; zero or more

    [(or () []) {:tag :rp*} ?env]
    (list ?env)

    [(_ ... :as ?x)
     {:tag :rp*
      :cat {:elements ?elements
            :as ?cat}
      :as ?rp*}
     ?env]
    (let [n (count ?elements)]
      (mapcat
       (fn [?env*]
         (search [(drop n ?x) ?rp* ?env*]))
       (search [(take n ?x) ?cat ?env])))

    [[_ ... :as ?x]
     {:tag :rp*
      :cat {:elements ?elements
            :as ?cat}
      :as ?rp*}
     ?env]
    (let [n (count ?elements)
          m (count ?x)]
      (if (= (mod m n) 0)
        (mapcat
         (fn [?env*]
           (search [(subvec ?x n) ?rp* ?env*]))
         (search [(subvec ?x 0 n) ?cat ?env]))
        nil))

    [_ {:tag :wth :body nil} _]
    nil

    [?x
     {:tag :wth
      :bindings ({:ref !refs
                  :pattern !patterns} ...)
      :body ?body}
     ?env]
    (let [?env* (into ?env (map vector !refs !patterns))]
      (map
       (fn [?env**]
         (reduce dissoc ?env** !refs))
       (search [?x ?body ?env*])))))

(search [[1 2 3 4]
         (r.syntax/parse '[!xs ... !ys ...])
         {}])
;; => 
({{:tag :mvr, :symbol !xs} [], {:tag :mvr, :symbol !ys} [1 2 3 4]}
 {{:tag :mvr, :symbol !xs} [1], {:tag :mvr, :symbol !ys} [2 3 4]}
 {{:tag :mvr, :symbol !xs} [1 2], {:tag :mvr, :symbol !ys} [3 4]}
 {{:tag :mvr, :symbol !xs} [1 2 3], {:tag :mvr, :symbol !ys} [4]}
 {{:tag :mvr, :symbol !xs} [1 2 3 4], {:tag :mvr, :symbol !ys} []})


(time
 (distinct
  (search [{:a 1
            :b {:a 1
                :b 2}
            :c '(1 2 1 2)}
           (r.syntax/parse
            '(with [%1_ (or %1 _)
                    %1 (or (and 1 !1s)
                           {_ %1_ & %1_}
                           (%1_ ...)
                           [%1_ ...]
                           #{%1_})]
               %1))
           {}])))
;; => "Elapsed time: 59.540176 msecs"
({{:tag :mvr, :symbol !1s} [1 1 1 1]}
 {{:tag :mvr, :symbol !1s} [1 1 1]}
 {{:tag :mvr, :symbol !1s} [1 1]}
 {{:tag :mvr, :symbol !1s} [1]}
 {})