(ns angelic.search.action-set.stratified
  (:require [edu.berkeley.ai.util :as util]
            [edu.berkeley.ai.util.queues :as queues]
            [edu.berkeley.ai.util.graphs :as graphs]
            [angelic.env :as env]
            [angelic.env.util :as env-util]
            [angelic.env.state :as state]
            [angelic.sas :as sas]
            [angelic.sas.analysis :as sas-analysis]
            [angelic.search.action-set.asplan :as asplan]
            )
  (:import [java.util HashSet HashMap  ArrayList]))

;; This implements (inefficiently) the stratified planning strategy of
;; Chen et al. (2009), for comparing # states generated with BI.

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

(defn effect-var [a] (util/safe-singleton (keys (:effect-map a))))

(defn dynamic-predecessors [state ap-map v]
  (for [a (get ap-map [v (state/get-var state v)])
        [pvar pval] (:precond-map a)
        :when (not (= (state/get-var state pvar) pval))]
    pvar))

(defn dynamic-var-set [state av-map ap-map v]
  (let [open   (ArrayList.)
        ret    (HashSet.)
        closed (HashSet.)]
    (.add open v)
    (while (not (.isEmpty open))
      (let [v (.remove open (dec (count open)))]
        (when-not (.contains closed v)
          (.add closed v)
          (doseq [x (dynamic-predecessors state ap-map v)]
            (.addAll ret (av-map x))
            (.addAll open (av-map x))))))
    (set (seq ret))))

(defn dynamic-inf-stratified-applicable-actions [last-a state tsi av-map ap-map actions]
  (if last-a
    (let [a-var   (effect-var last-a)
          a-level (util/safe-get tsi a-var)
          p-set   (dynamic-var-set state av-map ap-map a-var)]
      (filter
       (fn [b]
         (let [b-var (effect-var b)
               b-level (util/safe-get tsi b-var)]
           (or (and (<= b-level a-level) (contains? p-set b-var))
               (contains? (:precond-map b) a-var))))
       (actions state)))
    (actions state)))

(defn fluid-predecessors [state ap-map v]
  (apply clojure.set/intersection
         (for [a (util/safe-get ap-map [v (state/get-var state v)])
               :when (contains? (:effect-map a) v)]
           (set (for [[pvar pval] (:precond-map a)
                      :when (and (not (= pvar v)) (not (= pval (state/get-var state pvar))))]
                  pvar)))))

;; TODO: dead vars?
;; Fluid iff *all* children fluid? Yes.
;; Idea: take min-level fluid var, everything <=-level, everything in CC.  Toss everything else.

;; Fluid vars are those whose value must change, and current value is useless.
;; Ideally, we would take dead vars into account here too.
(defn fluid-vars [state ap-map cg-map goal]
  (let [open   (ArrayList.)
        closed (HashSet.)
        fluid-child-count-map (HashMap.)]
    (doseq [[var val] goal]
      (when-not (= val (state/get-var state var))
        (.add open var)))
    (while (not (.isEmpty open))
      (let [v (.remove open (dec (count open)))]
        (when-not (.contains closed v)
          (.add closed v)
          (doseq [p (fluid-predecessors state ap-map v)]
            (let [oc (get fluid-child-count-map p 0)]
              (if (= oc (dec (count (cg-map p))))
                (.add open p)
                (.put fluid-child-count-map p (inc oc))))))))
    (set (seq closed))))

(defn dynamic-fluid-var-set [state av-map ap-map f]
  (let [open   (ArrayList.)
        ret    (HashSet.)
        closed (HashSet.)]
    (.addAll open (av-map f))
    (.addAll ret  (av-map f))
    (while (not (.isEmpty open))
      (let [v (.remove open (dec (count open)))]
        (when-not (.contains closed v)
          (.add closed v)
          (doseq [x (dynamic-predecessors state ap-map v)]
            (.addAll ret (av-map x))
            (.addAll open (av-map x))))))
    (set (seq ret))))

(comment
 (defn connected-component [domain seeds cg-map icg-map]
   (let [open   (ArrayList.)
         closed (HashSet.)]
     (doseq [v seeds]
       (.addAll open seeds))
     (while (not (.isEmpty open))
       (let [v (.remove open (dec (count open)))]
         (when (and (not (.contains closed v)) (contains? domain v))
           (.add closed v)
           (.addAll open (cg-map v))
           (.addAll open (icg-map v)))))
     (set (seq closed)))))

(defn fluid-source [fluid-set tsi icg-map v]
  (if-let [fluid-parents (seq (filter fluid-set (icg-map v)))]
    (recur fluid-set tsi icg-map (apply max-key tsi fluid-parents))
    v))

(defn fluid-prune [p-set state tsi av-map ap-map goal cg-map icg-map]
  (let [fluid-set   (fluid-vars state ap-map cg-map goal)
        fluid-p-set (clojure.set/intersection p-set fluid-set)]
;    (println fluid-set)
    (if (seq fluid-p-set)
      (let [root-fluid (apply max-key tsi fluid-p-set)
            source-fluid (fluid-source fluid-p-set tsi icg-map root-fluid)
;            rfs (set (concat (filter #(> (tsi %) (tsi root-fluid)) p-set)
;            (dynamic-fluid-var-set state av-map ap-map root-fluid)))
            sfs (set (concat (filter #(> (tsi %) (tsi source-fluid)) p-set)
                             (dynamic-fluid-var-set state av-map ap-map source-fluid)))]
;        (println "\n" root-fluid source-fluid rfs sfs)
;        #_(when-not (= rfs sfs) (println "\n" root-fluid rfs "\n" source-fluid sfs "\n" (filter #(> (tsi %) (tsi source-fluid)) p-set)
;        (dynamic-fluid-var-set state av-map ap-map source-fluid)))
        sfs )
      p-set)))

(defn dynamic-fluid-inf-stratified-applicable-actions [last-a state tsi av-map ap-map goal cg-map icg-map actions]
  ;; Root set ignored for now -- doing it dynamically.
  (if last-a
    (let [a-var   (effect-var last-a)
          a-level (util/safe-get tsi a-var)
          p-set   (fluid-prune (dynamic-var-set state av-map ap-map a-var)
                               state tsi av-map ap-map goal cg-map icg-map)]
;      (println "\n" last-a fluid-set fluid-root-set p-set state)
      (filter
       (fn [b]
         (let [b-var (effect-var b)
               b-level (util/safe-get tsi b-var)]
           (or (contains? (:precond-map b) a-var)
               (and (<= b-level a-level) (contains? p-set b-var)))))
       (actions state)))
    (actions state)))

(comment (some #(= ((:precond-map last-a) %) ((:precond-map b) %))
            (clojure.set/intersection (util/keyset (:precond-map last-a)) (util/keyset (:precond-map b)))))

;; TODO: Is this actually right -- i think not?
(defn improved-inf-stratified-applicable-actions [last-a state tsi cav-map actions]
  (if last-a
    (let [a-var   (effect-var last-a)
          a-level (util/safe-get tsi a-var)
          p-set   (util/safe-get cav-map a-var)]
      (filter
       (fn [b]
         (let [b-var (effect-var b)
               b-level (util/safe-get tsi b-var)]
           (or (and (<= b-level a-level)  (contains? p-set b-var))
               (contains? (:precond-map b) a-var))))
       (actions state)))
    (actions state)))

(defn inf-stratified-applicable-actions [last-a state tsi actions]
  (if last-a
    (let [a-var   (effect-var last-a)
          a-level (util/safe-get tsi a-var)]
      (filter
       (fn [b]
         (let [b-var (effect-var b)
               b-level (util/safe-get tsi b-var)]
           (or (<= b-level a-level)
               (contains? (:precond-map b) a-var))))
       (actions state)))
    (actions state)))

(defn stratified-search [sas-problem type]
  (assert (#{:simple :dynamic :fluid} type))
  (let [q       (queues/make-tree-search-pq)
        closed  (HashSet.)
        actions (env/actions-fn sas-problem)
        causal-graph  (sas-analysis/standard-causal-graph sas-problem)
        noeq-causal-graph (remove (fn [[v c]] (= v c)) causal-graph)
        cg-map        (graphs/edge-list->outgoing-map noeq-causal-graph)
        icg-map       (graphs/edge-list->incoming-map noeq-causal-graph)
        av-map        (into {} (for [v (keys (:vars sas-problem))]
                                 [v (graphs/ancestor-set causal-graph [v])]))
        cav-map       (into {} (for [v (keys (:vars sas-problem))]
                                 [v (apply clojure.set/union (map av-map (cg-map v)))]))
        ap-map        (HashMap.)
;        pre-var-map   (util/map-vals #(set (map first %)) (group-by second causal-graph))
        tsi           (graphs/df-topological-sort-indices (remove #(apply = %) noeq-causal-graph))
        goal-map (:precond-map (util/safe-singleton (filter #(= (:name %) sas/goal-action-name) (:actions sas-problem))))
        goal    (env/goal-fn sas-problem)
        init    (env/initial-state sas-problem)
        strat-actions (case type
                        :simple     (fn [last-a state] (inf-stratified-applicable-actions last-a state tsi actions))
                        :structural (fn [last-a state] (improved-inf-stratified-applicable-actions last-a state tsi cav-map actions))                       :dynamic    (fn [last-a state] (dynamic-inf-stratified-applicable-actions last-a state tsi av-map ap-map actions))
                        :fluid    (fn [last-a state] (dynamic-fluid-inf-stratified-applicable-actions last-a state tsi av-map ap-map goal-map cg-map icg-map actions))
                        )]
    (println tsi)
    (when (#{:dynamic :fluid} type) #_ (println av-map)
      (doseq [a (:actions sas-problem), pp (:precond-map a)]
        (.put ap-map pp (cons a (.get ap-map pp)))))
    (queues/pq-add! q [nil init] 0)
;    (println causal-graph tsi pre-var-map)
    (loop []
      (when-not (queues/pq-empty? q)
        (let [[[last-a state] c] (queues/pq-remove-min-with-cost! q)]
          (util/print-debug 3 "dequeueing " (:act-seq (meta state)) c last-a state "\n")
          (if (goal state)
            [(reverse (:act-seq (meta state))) (:reward (meta state))]
            (do (when-not (.contains closed state)
                  (.add closed state)
                  (doseq [a (strat-actions last-a state)]
                    (when (env/applicable? a state)
                      (let [[ss sc] (env/successor a state)]
                        (queues/pq-add! q [a ss] (- c sc))))))
                (recur))))))))

;; (use 'angelic.env 'angelic.domains.taxi-infinite 'angelic.domains.sas-problems 'angelic.search.action-set.stratified)

;; (let [e (force (nth ipc2-logistics 3)) ]  (println (time (run-counted #(stratified-search e)))))

;; Logistics results (# states) to match table. -- ordi
;; 5-2: 19771
;; 6-1: 226446
;; 4-2: 365709
;; 5-1: 677522
;; 4-1: 1030555
;; 4-0: 1281114
;; 6-3: 2747824
;; 6-0: 3435578
;; 6-2: 3286212
;; 5-0: 4053436

;; Logistics results (# states) to match table. -- dynamic AND fluid
;; 5-2: 16086
;; 6-1: 194870
;; 4-2: 277791
;; 5-1: 454016
;; 4-1: 750217
;; 4-0: 986574
;; 6-3: 1908549
;; 6-0: 1864844
;; 6-2: 1947242
;; 5-0: 2272572

;; Wrong!
;; Logistics results (# states) to match table. -- fluid
;; 5 5-2: 10230
;; 7 6-1: 96430
;; 2 4-2: 182321
;; 4 5-1: 229929
;; 1 4-1: 324127
;; 0 4-0: 473231
;; 9 6-3: 1087515
;; 6 6-0: 899623
;; 8 6-2: 903447
;; 3 5-0: 1155503

;; Wrong ?
;; Logistics results (# states) to match table. -- structural
;; 5-2: 8585
;; 6-1: 226446
;; 4-2: 122924
;; 5-1: 390726
;; 4-1: 414577
;; 4-0: 646398
;; 6-3: 2747824
;; 6-0: 3435578
;; 6-2: 3286212
;; 5-0: 3085333

(ns angelic.search.action-set.stratified
  (:require [edu.berkeley.ai.util :as util]
            [edu.berkeley.ai.util.queues :as queues]
            [edu.berkeley.ai.util.graphs :as graphs]
            [angelic.env :as env]
            [angelic.env.util :as env-util]
            [angelic.env.state :as state]
            [angelic.sas :as sas]
            [angelic.sas.analysis :as sas-analysis]
            [angelic.search.action-set.asplan :as asplan]
            )
  (:import [java.util HashSet HashMap  ArrayList]))

;; This implements (inefficiently) the stratified planning strategy of
;; Chen et al. (2009), for comparing # states generated with BI.

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

(defn effect-var [a] (util/safe-singleton (keys (:effect-map a))))

(defn dynamic-predecessors [state ap-map v]
  (for [a (get ap-map [v (state/get-var state v)])
        [pvar pval] (:precond-map a)
        :when (not (= (state/get-var state pvar) pval))]
    pvar))

(defn dynamic-var-set [state av-map ap-map v]
  (let [open   (ArrayList.)
        ret    (HashSet.)
        closed (HashSet.)]
    (.add open v)
    (while (not (.isEmpty open))
      (let [v (.remove open (dec (count open)))]
        (when-not (.contains closed v)
          (.add closed v)
          (doseq [x (dynamic-predecessors state ap-map v)]
            (.addAll ret (av-map x))
            (.addAll open (av-map x))))))
    (set (seq ret))))

(defn dynamic-inf-stratified-applicable-actions [last-a state tsi av-map ap-map actions]
  (if last-a
    (let [a-var   (effect-var last-a)
          a-level (util/safe-get tsi a-var)
          p-set   (dynamic-var-set state av-map ap-map a-var)]
      (filter
       (fn [b]
         (let [b-var (effect-var b)
               b-level (util/safe-get tsi b-var)]
           (or (and (<= b-level a-level) (contains? p-set b-var))
               (contains? (:precond-map b) a-var))))
       (actions state)))
    (actions state)))

(defn fluid-predecessors [state ap-map v]
  (apply clojure.set/intersection
         (for [a (util/safe-get ap-map [v (state/get-var state v)])
               :when (contains? (:effect-map a) v)]
           (set (for [[pvar pval] (:precond-map a)
                      :when (and (not (= pvar v)) (not (= pval (state/get-var state pvar))))]
                  pvar)))))

;; TODO: dead vars?
;; Fluid iff *all* children fluid? Yes.
;; Idea: take min-level fluid var, everything <=-level, everything in CC.  Toss everything else.

;; Fluid vars are those whose value must change, and current value is useless.
;; Ideally, we would take dead vars into account here too.
(defn fluid-vars [state ap-map cg-map goal]
  (let [open   (ArrayList.)
        closed (HashSet.)
        fluid-child-count-map (HashMap.)]
    (doseq [[var val] goal]
      (when-not (= val (state/get-var state var))
        (.add open var)))
    (while (not (.isEmpty open))
      (let [v (.remove open (dec (count open)))]
        (when-not (.contains closed v)
          (.add closed v)
          (doseq [p (fluid-predecessors state ap-map v)]
            (let [oc (get fluid-child-count-map p 0)]
              (if (= oc (dec (count (cg-map p))))
                (.add open p)
                (.put fluid-child-count-map p (inc oc))))))))
    (set (seq closed))))

(defn dynamic-fluid-var-set [state av-map ap-map f]
  (let [open   (ArrayList.)
        ret    (HashSet.)
        closed (HashSet.)]
    (.addAll open (av-map f))
    (.addAll ret  (av-map f))
    (while (not (.isEmpty open))
      (let [v (.remove open (dec (count open)))]
        (when-not (.contains closed v)
          (.add closed v)
          (doseq [x (dynamic-predecessors state ap-map v)]
            (.addAll ret (av-map x))
            (.addAll open (av-map x))))))
    (set (seq ret))))

(comment
 (defn connected-component [domain seeds cg-map icg-map]
   (let [open   (ArrayList.)
         closed (HashSet.)]
     (doseq [v seeds]
       (.addAll open seeds))
     (while (not (.isEmpty open))
       (let [v (.remove open (dec (count open)))]
         (when (and (not (.contains closed v)) (contains? domain v))
           (.add closed v)
           (.addAll open (cg-map v))
           (.addAll open (icg-map v)))))
     (set (seq closed)))))

(defn fluid-source [fluid-set tsi icg-map v]
  (if-let [fluid-parents (seq (filter fluid-set (icg-map v)))]
    (recur fluid-set tsi icg-map (apply max-key tsi fluid-parents))
    v))

(defn fluid-prune [p-set state tsi av-map ap-map goal cg-map icg-map]
  (let [fluid-set   (fluid-vars state ap-map cg-map goal)
        fluid-p-set (clojure.set/intersection p-set fluid-set)]
;    (println fluid-set)
    (if (seq fluid-p-set)
      (let [root-fluid (apply max-key tsi fluid-p-set)
            source-fluid (fluid-source fluid-p-set tsi icg-map root-fluid)
;            rfs (set (concat (filter #(> (tsi %) (tsi root-fluid)) p-set)
;            (dynamic-fluid-var-set state av-map ap-map root-fluid)))
            sfs (set (concat (filter #(> (tsi %) (tsi source-fluid)) p-set)
                             (dynamic-fluid-var-set state av-map ap-map source-fluid)))]
;        (println "\n" root-fluid source-fluid rfs sfs)
;        #_(when-not (= rfs sfs) (println "\n" root-fluid rfs "\n" source-fluid sfs "\n" (filter #(> (tsi %) (tsi source-fluid)) p-set)
;        (dynamic-fluid-var-set state av-map ap-map source-fluid)))
        sfs )
      p-set)))

(defn dynamic-fluid-inf-stratified-applicable-actions [last-a state tsi av-map ap-map goal cg-map icg-map actions]
  ;; Root set ignored for now -- doing it dynamically.
  (if last-a
    (let [a-var   (effect-var last-a)
          a-level (util/safe-get tsi a-var)
          p-set   (fluid-prune (dynamic-var-set state av-map ap-map a-var)
                               state tsi av-map ap-map goal cg-map icg-map)]
;      (println "\n" last-a fluid-set fluid-root-set p-set state)
      (filter
       (fn [b]
         (let [b-var (effect-var b)
               b-level (util/safe-get tsi b-var)]
           (or (contains? (:precond-map b) a-var)
               (and (<= b-level a-level) (contains? p-set b-var)))))
       (actions state)))
    (actions state)))

(comment (some #(= ((:precond-map last-a) %) ((:precond-map b) %))
            (clojure.set/intersection (util/keyset (:precond-map last-a)) (util/keyset (:precond-map b)))))

;; TODO: Is this actually right -- i think not?
(defn improved-inf-stratified-applicable-actions [last-a state tsi cav-map actions]
  (if last-a
    (let [a-var   (effect-var last-a)
          a-level (util/safe-get tsi a-var)
          p-set   (util/safe-get cav-map a-var)]
      (filter
       (fn [b]
         (let [b-var (effect-var b)
               b-level (util/safe-get tsi b-var)]
           (or (and (<= b-level a-level)  (contains? p-set b-var))
               (contains? (:precond-map b) a-var))))
       (actions state)))
    (actions state)))

(defn inf-stratified-applicable-actions [last-a state tsi actions]
  (if last-a
    (let [a-var   (effect-var last-a)
          a-level (util/safe-get tsi a-var)]
      (filter
       (fn [b]
         (let [b-var (effect-var b)
               b-level (util/safe-get tsi b-var)]
           (or (<= b-level a-level)
               (contains? (:precond-map b) a-var))))
       (actions state)))
    (actions state)))

(defn stratified-search [sas-problem type]
  (assert (#{:simple :dynamic :fluid} type))
  (let [q       (queues/make-tree-search-pq)
        closed  (HashSet.)
        actions (env/actions-fn sas-problem)
        causal-graph  (sas-analysis/standard-causal-graph sas-problem)
        noeq-causal-graph (remove (fn [[v c]] (= v c)) causal-graph)
        cg-map        (graphs/edge-list->outgoing-map noeq-causal-graph)
        icg-map       (graphs/edge-list->incoming-map noeq-causal-graph)
        av-map        (into {} (for [v (keys (:vars sas-problem))]
                                 [v (graphs/ancestor-set causal-graph [v])]))
        cav-map       (into {} (for [v (keys (:vars sas-problem))]
                                 [v (apply clojure.set/union (map av-map (cg-map v)))]))
        ap-map        (HashMap.)
;        pre-var-map   (util/map-vals #(set (map first %)) (group-by second causal-graph))
        tsi           (graphs/df-topological-sort-indices (remove #(apply = %) noeq-causal-graph))
        goal-map (:precond-map (util/safe-singleton (filter #(= (:name %) sas/goal-action-name) (:actions sas-problem))))
        goal    (env/goal-fn sas-problem)
        init    (env/initial-state sas-problem)
        strat-actions (case type
                        :simple     (fn [last-a state] (inf-stratified-applicable-actions last-a state tsi actions))
                        :structural (fn [last-a state] (improved-inf-stratified-applicable-actions last-a state tsi cav-map actions))                       :dynamic    (fn [last-a state] (dynamic-inf-stratified-applicable-actions last-a state tsi av-map ap-map actions))
                        :fluid    (fn [last-a state] (dynamic-fluid-inf-stratified-applicable-actions last-a state tsi av-map ap-map goal-map cg-map icg-map actions))
                        )]
;    (println tsi)
    (when (#{:dynamic :fluid} type) #_ (println av-map)
      (doseq [a (:actions sas-problem), pp (:precond-map a)]
        (.put ap-map pp (cons a (.get ap-map pp)))))
    (queues/pq-add! q [nil init] 0)
;    (println causal-graph tsi pre-var-map)
    (loop []
      (when-not (queues/pq-empty? q)
        (let [[[last-a state] c] (queues/pq-remove-min-with-cost! q)]
          (util/print-debug 3 "dequeueing " (:act-seq (meta state)) c last-a state "\n")
          (if (goal state)
            [(reverse (:act-seq (meta state))) (:reward (meta state))]
            (do (when-not (.contains closed state)
                  (.add closed state)
                  (doseq [a (strat-actions last-a state)]
                    (when (env/applicable? a state)
                      (let [[ss sc] (env/successor a state)]
                        (queues/pq-add! q [a ss] (- c sc))))))
                (recur))))))))

;; (use 'angelic.env 'angelic.domains.taxi-infinite 'angelic.domains.sas-problems 'angelic.search.action-set.stratified)

;; (let [e (force (nth ipc2-logistics 3)) ]  (println (time (run-counted #(stratified-search e)))))

;; Logistics results (# states) to match table. -- ordi
;; 5-2: 19771
;; 6-1: 226446
;; 4-2: 365709
;; 5-1: 677522
;; 4-1: 1030555
;; 4-0: 1281114
;; 6-3: 2747824
;; 6-0: 3435578
;; 6-2: 3286212
;; 5-0: 4053436

;; Logistics results (# states) to match table. -- dynamic AND fluid
;; 5-2: 16086
;; 6-1: 194870
;; 4-2: 277791
;; 5-1: 454016
;; 4-1: 750217
;; 4-0: 986574
;; 6-3: 1908549
;; 6-0: 1864844
;; 6-2: 1947242
;; 5-0: 2272572

;; Wrong!
;; Logistics results (# states) to match table. -- fluid
;; 5 5-2: 10230
;; 7 6-1: 96430
;; 2 4-2: 182321
;; 4 5-1: 229929
;; 1 4-1: 324127
;; 0 4-0: 473231
;; 9 6-3: 1087515
;; 6 6-0: 899623
;; 8 6-2: 903447
;; 3 5-0: 1155503

;; Wrong ?
;; Logistics results (# states) to match table. -- structural
;; 5-2: 8585
;; 6-1: 226446
;; 4-2: 122924
;; 5-1: 390726
;; 4-1: 414577
;; 4-0: 646398
;; 6-3: 2747824
;; 6-0: 3435578
;; 6-2: 3286212
;; 5-0: 3085333

Remove print statement

Remove print statement


(ns desdemona.query-test
  (:require
   [desdemona.query :as q]
   [clojure.test :refer [deftest is are testing]]))

(deftest infix-parser-tests
  (is (= [:expr [:ipv4-address "10" "0" "0" "1"]]
         (#'q/infix-parser "10.0.0.1"))
      "ipv4 addresses")
  (is (= [:expr [:fn-call
                 [:identifier "ip"]
                 [:identifier "x"]]]
         (#'q/infix-parser "ip(x)"))
      "simple fn calls")
  (is (= [:expr [:eq
                 [:identifier "a"]
                 [:identifier "b"]]]
         (#'q/infix-parser "a = b"))
      "equality between identifiers")
  (is (= [:expr [:eq
                 [:fn-call
                  [:identifier "ip"]
                  [:identifier "x"]]
                 [:ipv4-address "10" "0" "0" "1"]]]
         (#'q/infix-parser "ip(x) = 10.0.0.1"))
      "equality between fn call and IP address literal"))

(deftest infix->dsl-tests
  (is (= '(= (:ip x) "10.0.0.1")
         (q/infix->dsl "ip(x) = 10.0.0.1"))))

(def dsl->logic
  @#'desdemona.query/dsl->logic)

(deftest dsl->logic-tests
  (is (thrown? IllegalArgumentException (dsl->logic '(BOGUS BOGUS BOGUS))))
  (is (= '(clojure.core.logic/featurec x {:ip "10.0.0.1"})
         (dsl->logic '(= (:ip x) "10.0.0.1"))
         (dsl->logic '(= "10.0.0.1" (:ip x)))))
  (testing "logical conjunction"
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})
              (clojure.core.logic/featurec x {:type "egress"})])
           (dsl->logic '(and (= (:ip x) "10.0.0.1")
                             (= (:type x) "egress"))))))
  (testing "logical disjunction"
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})]
             [(clojure.core.logic/featurec x {:type "egress"})])
           (dsl->logic '(or (= (:ip x) "10.0.0.1")
                            (= (:type x) "egress")))))
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:type "egress"})]
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})])
           (dsl->logic '(or (= (:type x) "egress")
                            (= (:ip x) "10.0.0.1")))))))

(def events
  [{:ip "10.0.0.1"}
   {:ip "10.0.0.2"
    :type "egress"}
   {:ip "10.0.0.2"
    :type "ingress"}])

(deftest dsl-query-tests
  (are [query results] (= results (q/run-dsl-query query events))
    '(= (:ip x) "10.0.0.1")
    [[{:ip "10.0.0.1"}]]

    '(= (:ip x) "BOGUS")
    []

    '(= "10.0.0.1" (:ip x))
    [[{:ip "10.0.0.1"}]]

    '(= "BOGUS" (:ip x))
    [])
  (testing "explicit maximum number of results"
    (let [results [[{:ip "10.0.0.1"}]]
          query '(= (:ip x) "10.0.0.1")]
      (are [n-results] (= results (q/run-dsl-query n-results query events))
        1
        10)))
  (testing "conjunction"
    (are [query results] (= results (q/run-dsl-query query events))
      '(and (= (:ip x) "10.0.0.1")
            (= (:type x) "egress"))
      []

      '(and (= (:ip x) "10.0.0.2")
            (= (:type x) "egress"))
      [[{:ip "10.0.0.2"
         :type "egress"}]]

      '(and (= (:type x) "egress")
            (= (:ip x) "10.0.0.2"))
      [[{:ip "10.0.0.2"
         :type "egress"}]]))
  (testing "disjunction"
    (are [query results] (= results (q/run-dsl-query 10 query events))
      '(or (= (:ip x) "1.2.3.4")
           (= (:type x) "bogus"))
      []

      '(or (= (:ip x) "10.0.0.1")
           (= (:type x) "egress"))
      [[{:ip "10.0.0.1"}]
       [{:ip "10.0.0.2"
         :type "egress"}]]

      '(or (= (:ip x) "10.0.0.1")
           (= (:type x) "ingress"))
      [[{:ip "10.0.0.1"}]
       [{:ip "10.0.0.2"
         :type "ingress"}]]

      '(or (= (:ip x) "10.0.0.2")
           (= (:type x) "egress"))
      [[{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; type clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "ingress"}]]

      '(or (= (:type x) "egress")
           (= (:ip x) "10.0.0.2"))
      [[{:ip "10.0.0.2"    ;; type clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "ingress"}]])))

(deftest logic-query-tests
  (are [query results] (= results (#'q/run-logic-query query events))
    'l/fail
    []

    '(l/featurec x {:ip "10.0.0.1"})
    [[{:ip "10.0.0.1"}]])
  (testing "explicit maximum number of results"
    (let [results [[{:ip "10.0.0.1"}]]
          query '(l/featurec x {:ip "10.0.0.1"})]
      (are [n-results] (= results (#'q/run-logic-query n-results query events))
        1
        10))))

(deftest find-free-vars-tests
  (are [expected query] (= expected (#'q/find-free-vars query))
    #{}
    '()

    #{'x}
    '(clojure.core.logic/featurec x {:ip "10.0.0.1"})))

(deftest free-sym-tests
  (is (#'q/free-sym 'x))
  (is (#'q/free-sym 'y))

  (is (not (#'q/free-sym 'clojure.core/=))
      "fully qualified")
  (is (not (#'q/free-sym 1))
      "not a symbol"))

    ;; #{'x}
    ;; '(clojure.core.logic/conde
    ;;   [(clojure.core.logic/featurec x {:ip "10.0.0.1"})
    ;; (clojure.core.logic/featurec x {:type "egress"})])

Add some tests to decide if a symbol is free


;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Main class for launching experiments"}
  dsbdp.main
  (:require
    (clj-assorted-utils [util :refer :all])
    (clojure.tools [cli :refer :all])
    (dsbdp
      [data-processing-dsl :refer :all]
      [byte-array-conversion :refer :all]
      [experiment-helper :refer :all]
      [local-data-processing-pipeline :refer :all]
      [local-dpp-self-adaptivity :refer :all]
      [processing-fn-utils :as utils]))
  (:import
    (dsbdp Counter ExperimentHelper ProcessingLoop)
    (java.lang.management ManagementFactory ThreadInfo ThreadMXBean)
    (java.util HashMap Map))
  (:gen-class))

(defn create-thread-info-fn
  []
  (let [^ThreadMXBean tmxb (ManagementFactory/getThreadMXBean)
        cpu-time-supported (.isThreadCpuTimeSupported tmxb)
        delta-cntr (delta-counter)]
    (.setThreadContentionMonitoringEnabled tmxb true)
    (if cpu-time-supported
      (.setThreadCpuTimeEnabled tmxb true))
    (fn []
      (let [t-ids (sort (vec (.getAllThreadIds tmxb)))]
        (doseq [t-id t-ids]
          (let [^ThreadInfo t-info (.getThreadInfo tmxb ^long t-id)
                t-name (.getThreadName t-info)
                cpu-time (if cpu-time-supported
                           (double (/ (.getThreadCpuTime tmxb t-id) 1000000000.0))
                           -1)
                user-time (if cpu-time-supported
                            (double (/ (.getThreadUserTime tmxb t-id) 1000000000.0))
                            -1)
                waited (.getWaitedTime t-info)
                blocked (.getBlockedTime t-info)]
            (println (str t-id "," t-name "," cpu-time "," user-time "," waited "," blocked ","
                       (delta-cntr (str "cpu-" t-id) cpu-time) ","
                       (delta-cntr (str "user-" t-id) user-time) ","
                       (delta-cntr (str "waited-" t-id) waited) ","
                       (delta-cntr (str "blocked-" t-id) blocked)))))))))

(def cli-options
  [["-b" "--batch-size BATCH-SIZE"
    "The number of data instances to be generated for one batch."
    :default 2000
    :parse-fn #(Integer/parseInt %)]
   ["-d" "--batch-delay BATCH-DELAY"
    "The delay in ms between generating batches."
    :default 1
    :parse-fn #(Integer/parseInt %)]
   ["-h" "--help"]
   ["-i" "--in-data IN-DATA"
    "The input data to be used."
    :default nil
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ["-l" "--pipeline-length PIPELINE-LENGTH"
    :default 2
    :parse-fn #(Integer/parseInt %)]
   ["-m" "--fn-mapping FN-MAPPING"
    "The mapping of dsl-expressions to processing functions."
    :default [5 5 4 3]
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ["-s" "--scenario SCENARIO"
    "The scenario that is to be used."
    :default "no-op"]
   ["-S" "--self-adaptivity-cfg SELF-ADAPTIVITY-CFG"
    "Configuration for self-adaptive adjustment of the data processing pipeline."
    :default nil
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ])

(defn create-direct-proc-fn
  [scenario]
  (condp (fn [^String v ^String s] (.startsWith s v)) scenario
    "busy-sleep" (fn [in] (ExperimentHelper/busySleep ^long (first in)))
    "factorial" factorial
    "opennlp-single" opennlp-single-sentence-direct-test-fn
    "opennlp-multi" opennlp-multi-sentence-direct-test-fn
    "pcap-clj-map" (create-proc-fn sample-pcap-processing-definition-clj-map)
    "pcap-java-map" (create-proc-fn sample-pcap-processing-definition-java-map)
    "pcap-json" (create-proc-fn sample-pcap-processing-definition-json)
    "pcap-csv" (create-proc-fn sample-pcap-processing-definition-csv)
    nil))

(defn -main [& args]
  (println "Starting dsbdp main...")
  (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
    (when (:help options)
      (println summary)
      (System/exit 0))
    (println "Using options:" options)
    (println "Using args:" arguments)
    (let [in-cntr (Counter.)
          out-cntr (Counter.)
          delta-cntr (delta-counter)
          out-fn (fn [_ _]
                   (.inc out-cntr))
          ^String scenario (:scenario options)
          in-data-arg (:in-data options)
          in-data (if (not (nil? in-data-arg))
                    in-data-arg
                    (condp (fn [^String v ^String s] (.startsWith s v)) scenario
                      "no-op" 1
                      "busy-sleep" [100000 100000 100000 100000]
                      "factorial" 300N
                      "opennlp-single" "This is a simple sentence."
                      "opennlp-multi" (str
                                        "This is a simple sentence. "
                                        "The first example sentence is followed by another example sentence. "
                                        "The second sentence is followed by another example sentence.")
                      "pcap" pcap-byte-array-test-data
                      "self-adaptive" 1
                      "nil" nil))
          _ (println "in-data:" in-data)
          fn-mapping (atom (:fn-mapping options))
          _ (println "fn-mapping:" @fn-mapping)
          pipeline-length (:pipeline-length options)
          proc-fns (atom
                     (condp = scenario
                       "no-op" (create-no-op-proc-fns pipeline-length)
                       "busy-sleep" (create-busy-sleep-proc-fns (count in-data))
                       "factorial" [(fn [i _] (factorial i))]
                       "factorial-inc" (create-factorial-proc-fns pipeline-length)
                       "opennlp-single-inc" (utils/combine-proc-fns-vec
                                              @fn-mapping
                                              opennlp-single-sentence-inc-test-fns)
                       "pcap-clj-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-clj-map)]
                                        [(fn [i _] (pcap-fn i))])
                       "pcap-clj-map-inc" (combine-proc-fns-vec
                                            @fn-mapping
                                            sample-pcap-processing-definition-clj-map)
                       "pcap-java-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-java-map)]
                                         [(fn [i _] (pcap-fn i))])
                       "pcap-java-map-inc" (combine-proc-fns-vec
                                             @fn-mapping
                                             sample-pcap-processing-definition-java-map)
                       "pcap-json" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-json)]
                                     [(fn [i _] (pcap-fn i))])
                       "pcap-json-inc" (combine-proc-fns-vec
                                         @fn-mapping
                                         sample-pcap-processing-definition-json)
                       "pcap-csv" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-csv)]
                                    [(fn [i _] (pcap-fn i))])
                       "pcap-csv-inc" (combine-proc-fns-vec
                                        @fn-mapping
                                        sample-pcap-processing-definition-csv)
                       "self-adaptive-low-throughput" (utils/combine-proc-fns-vec
                                                        @fn-mapping
                                                        synthetic-low-throughput-self-adaptivity-processing-fns)
                       "self-adaptive-average-throughput" (utils/combine-proc-fns-vec
                                                            @fn-mapping
                                                            synthetic-average-throughput-self-adaptivity-processing-fns)
                       "self-adaptive-high-throughput" (utils/combine-proc-fns-vec
                                                         @fn-mapping
                                                         synthetic-high-throughput-self-adaptivity-processing-fns)
                       nil))
          _ (println "Proc-fns:" @proc-fns)
          pipeline (if (and
                         (not (nil? in-data))
                         (not (.endsWith scenario "-direct")))
                     (create-local-processing-pipeline
                       @proc-fns
                       out-fn))
          batch-delay (:batch-delay options)
          batch-size (:batch-size options)
          in-loop (ProcessingLoop.
                    "DataGenerationLoop"
                    (cond
                      (.endsWith scenario "-direct")
                        (let [proc-fn (create-direct-proc-fn scenario)]
                          (fn []
                            (proc-fn in-data)
                            (.inc out-cntr)))
                      (.endsWith scenario "-pmap")
                        (let [proc-fn (create-direct-proc-fn scenario)]
                          (fn []
                            (doseq [data (pmap proc-fn (repeat in-data))]
                              (.inc out-cntr))))
                      (and
                        in-data
                        (> batch-delay 0)
                        (> batch-size 0)) (let [in-fn (get-in-fn pipeline)]
                                            (fn []
                                              (doseq [i (repeat batch-size 0)]
                                                (in-fn in-data)
                                                (.inc in-cntr))
                                              (sleep batch-delay)))
                      in-data (let [in-fn (get-in-fn pipeline)]
                                (fn []
                                  (in-fn in-data)
                                  (.inc in-cntr)))
                      :default (fn [] (.inc out-cntr))))
          self-adaptivity-cfg (options :self-adaptivity-cfg)
          self-adaptivity-controller (if (not (nil? self-adaptivity-cfg))
                                       (create-self-adaptivity-controller
                                         self-adaptivity-cfg
                                         pipeline
                                         (condp = scenario
                                           "self-adaptive-low-throughput" synthetic-low-throughput-self-adaptivity-processing-fns
                                           "self-adaptive-average-throughput" synthetic-average-throughput-self-adaptivity-processing-fns
                                           "self-adaptive-high-throughput" synthetic-high-throughput-self-adaptivity-processing-fns)
                                         fn-mapping))
          thread-info-fn (create-thread-info-fn)
          stats-fn (fn []
                     (let [in (double (/ (.value in-cntr) 1000.0))
                           out (double (/ (.value out-cntr) 1000.0))]
                       (println
                         "time-delta:" (delta-cntr :time (System/currentTimeMillis)) "ms;"
                         "in:" in "k;"
                         "out:" out "k;"
                         "in-delta:" (delta-cntr :in in) "k/s;"
                         "out-delta:" (delta-cntr :out out) "k/s;")
                       (if (not (nil? pipeline))
                         (let [counts (get-counts pipeline)]
                           (println "mapping:" @fn-mapping)
                           (println counts)
                           (if (not (nil? self-adaptivity-controller))
                             (update-stats self-adaptivity-controller counts))))))]
      (println "Starting experiment...")
      (.setName (Thread/currentThread) "Main")
      (.start in-loop)
      (run-repeat (executor) (fn []
                               (stats-fn)
                               (thread-info-fn) (println)
                               )
                  1000)
      (run-once (executor) (fn [] (System/exit 0)) 120000))))

;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Main class for launching experiments"}
  dsbdp.main
  (:require
    (clj-assorted-utils [util :refer :all])
    (clojure.tools [cli :refer :all])
    (dsbdp
      [data-processing-dsl :refer :all]
      [byte-array-conversion :refer :all]
      [experiment-helper :refer :all]
      [local-data-processing-pipeline :refer :all]
      [local-dpp-self-adaptivity :refer :all]
      [processing-fn-utils :as utils]))
  (:import
    (dsbdp Counter ExperimentHelper ProcessingLoop)
    (java.lang.management ManagementFactory ThreadInfo ThreadMXBean)
    (java.util HashMap Map))
  (:gen-class))

(defn create-thread-info-fn
  []
  (let [^ThreadMXBean tmxb (ManagementFactory/getThreadMXBean)
        cpu-time-supported (.isThreadCpuTimeSupported tmxb)
        delta-cntr (delta-counter)]
    (.setThreadContentionMonitoringEnabled tmxb true)
    (if cpu-time-supported
      (.setThreadCpuTimeEnabled tmxb true))
    (fn []
      (let [t-ids (sort (vec (.getAllThreadIds tmxb)))]
        (doseq [t-id t-ids]
          (let [^ThreadInfo t-info (.getThreadInfo tmxb ^long t-id)
                t-name (.getThreadName t-info)
                cpu-time (if cpu-time-supported
                           (double (/ (.getThreadCpuTime tmxb t-id) 1000000000.0))
                           -1)
                user-time (if cpu-time-supported
                            (double (/ (.getThreadUserTime tmxb t-id) 1000000000.0))
                            -1)
                waited (.getWaitedTime t-info)
                blocked (.getBlockedTime t-info)]
            (println (str t-id "," t-name "," cpu-time "," user-time "," waited "," blocked ","
                       (delta-cntr (str "cpu-" t-id) cpu-time) ","
                       (delta-cntr (str "user-" t-id) user-time) ","
                       (delta-cntr (str "waited-" t-id) waited) ","
                       (delta-cntr (str "blocked-" t-id) blocked)))))))))

(def cli-options
  [["-b" "--batch-size BATCH-SIZE"
    "The number of data instances to be generated for one batch."
    :default 2000
    :parse-fn #(Integer/parseInt %)]
   ["-d" "--batch-delay BATCH-DELAY"
    "The delay in ms between generating batches."
    :default 1
    :parse-fn #(Integer/parseInt %)]
   ["-h" "--help"]
   ["-i" "--in-data IN-DATA"
    "The input data to be used."
    :default nil
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ["-l" "--pipeline-length PIPELINE-LENGTH"
    :default 2
    :parse-fn #(Integer/parseInt %)]
   ["-m" "--fn-mapping FN-MAPPING"
    "The mapping of dsl-expressions to processing functions."
    :default [5 5 4 3]
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ["-s" "--scenario SCENARIO"
    "The scenario that is to be used."
    :default "no-op"]
   ["-S" "--self-adaptivity-cfg SELF-ADAPTIVITY-CFG"
    "Configuration for self-adaptive adjustment of the data processing pipeline."
    :default nil
    :parse-fn #(binding [*read-eval* false] (read-string %))]
   ])

(defn create-direct-proc-fn
  [scenario]
  (condp (fn [^String v ^String s] (.startsWith s v)) scenario
    "busy-sleep" (fn [in] (ExperimentHelper/busySleep ^long (first in)))
    "factorial" factorial
    "opennlp-single" opennlp-single-sentence-direct-test-fn
    "opennlp-multi" opennlp-multi-sentence-direct-test-fn
    "pcap-clj-map" (create-proc-fn sample-pcap-processing-definition-clj-map)
    "pcap-java-map" (create-proc-fn sample-pcap-processing-definition-java-map)
    "pcap-json" (create-proc-fn sample-pcap-processing-definition-json)
    "pcap-csv" (create-proc-fn sample-pcap-processing-definition-csv)
    nil))

(defn -main [& args]
  (println "Starting dsbdp main...")
  (let [{:keys [options arguments errors summary]} (parse-opts args cli-options)]
    (when (:help options)
      (println summary)
      (System/exit 0))
    (println "Using options:" options)
    (println "Using args:" arguments)
    (let [in-cntr (Counter.)
          out-cntr (Counter.)
          delta-cntr (delta-counter)
          ^String scenario (:scenario options)
          in-data-arg (:in-data options)
          in-data (if (not (nil? in-data-arg))
                    in-data-arg
                    (condp (fn [^String v ^String s] (.startsWith s v)) scenario
                      "no-op" 1
                      "busy-sleep" [100000 100000 100000 100000]
                      "factorial" 300N
                      "opennlp-single" "This is a simple sentence."
                      "opennlp-multi" (str
                                        "This is a simple sentence. "
                                        "The first example sentence is followed by another example sentence. "
                                        "The second sentence is followed by another example sentence.")
                      "pcap" pcap-byte-array-test-data
                      "self-adaptive" 1
                      "nil" nil))
          _ (println "in-data:" in-data)
          fn-mapping (atom (:fn-mapping options))
          _ (println "fn-mapping:" @fn-mapping)
          pipeline-length (:pipeline-length options)
          proc-fns (atom
                     (condp = scenario
                       "no-op" (create-no-op-proc-fns pipeline-length)
                       "busy-sleep" (create-busy-sleep-proc-fns (count in-data))
                       "factorial" [(fn [i _] (factorial i))]
                       "factorial-inc" (create-factorial-proc-fns pipeline-length)
                       "opennlp-single-inc" (utils/combine-proc-fns-vec
                                              @fn-mapping
                                              opennlp-single-sentence-inc-test-fns)
                       "pcap-clj-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-clj-map)]
                                        [(fn [i _] (pcap-fn i))])
                       "pcap-clj-map-inc" (combine-proc-fns-vec
                                            @fn-mapping
                                            sample-pcap-processing-definition-clj-map)
                       "pcap-java-map" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-java-map)]
                                         [(fn [i _] (pcap-fn i))])
                       "pcap-java-map-inc" (combine-proc-fns-vec
                                             @fn-mapping
                                             sample-pcap-processing-definition-java-map)
                       "pcap-json" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-json)]
                                     [(fn [i _] (pcap-fn i))])
                       "pcap-json-inc" (combine-proc-fns-vec
                                         @fn-mapping
                                         sample-pcap-processing-definition-json)
                       "pcap-csv" (let [pcap-fn (create-proc-fn sample-pcap-processing-definition-csv)]
                                    [(fn [i _] (pcap-fn i))])
                       "pcap-csv-inc" (combine-proc-fns-vec
                                        @fn-mapping
                                        sample-pcap-processing-definition-csv)
                       "self-adaptive-low-throughput" (utils/combine-proc-fns-vec
                                                        @fn-mapping
                                                        synthetic-low-throughput-self-adaptivity-processing-fns)
                       "self-adaptive-average-throughput" (utils/combine-proc-fns-vec
                                                            @fn-mapping
                                                            synthetic-average-throughput-self-adaptivity-processing-fns)
                       "self-adaptive-high-throughput" (utils/combine-proc-fns-vec
                                                         @fn-mapping
                                                         synthetic-high-throughput-self-adaptivity-processing-fns)
                       nil))
          _ (println "Proc-fns:" @proc-fns)
          out-fn (fn [_ _]
                   (.inc out-cntr))
          pipeline (if (and
                         (not (nil? in-data))
                         (not (.endsWith scenario "-direct")))
                     (create-local-processing-pipeline
                       @proc-fns
                       out-fn))
          batch-delay (:batch-delay options)
          batch-size (:batch-size options)
          in-loop (ProcessingLoop.
                    "DataGenerationLoop"
                    (cond
                      (.endsWith scenario "-direct")
                        (let [proc-fn (create-direct-proc-fn scenario)]
                          (fn []
                            (proc-fn in-data)
                            (.inc out-cntr)))
                      (.endsWith scenario "-pmap")
                        (let [proc-fn (create-direct-proc-fn scenario)]
                          (fn []
                            (doseq [data (pmap proc-fn (repeat in-data))]
                              (.inc out-cntr))))
                      (and
                        in-data
                        (> batch-delay 0)
                        (> batch-size 0)) (let [in-fn (get-in-fn pipeline)]
                                            (fn []
                                              (doseq [i (repeat batch-size 0)]
                                                (in-fn in-data)
                                                (.inc in-cntr))
                                              (sleep batch-delay)))
                      in-data (let [in-fn (get-in-fn pipeline)]
                                (fn []
                                  (in-fn in-data)
                                  (.inc in-cntr)))
                      :default (fn [] (.inc out-cntr))))
          self-adaptivity-cfg (options :self-adaptivity-cfg)
          self-adaptivity-controller (if (not (nil? self-adaptivity-cfg))
                                       (create-self-adaptivity-controller
                                         self-adaptivity-cfg
                                         pipeline
                                         (condp = scenario
                                           "self-adaptive-low-throughput" synthetic-low-throughput-self-adaptivity-processing-fns
                                           "self-adaptive-average-throughput" synthetic-average-throughput-self-adaptivity-processing-fns
                                           "self-adaptive-high-throughput" synthetic-high-throughput-self-adaptivity-processing-fns)
                                         fn-mapping))
          thread-info-fn (create-thread-info-fn)
          stats-fn (fn []
                     (let [in (double (/ (.value in-cntr) 1000.0))
                           out (double (/ (.value out-cntr) 1000.0))]
                       (println
                         "time-delta:" (delta-cntr :time (System/currentTimeMillis)) "ms;"
                         "in:" in "k;"
                         "out:" out "k;"
                         "in-delta:" (delta-cntr :in in) "k/s;"
                         "out-delta:" (delta-cntr :out out) "k/s;")
                       (if (not (nil? pipeline))
                         (let [counts (get-counts pipeline)]
                           (println "mapping:" @fn-mapping)
                           (println counts)
                           (if (not (nil? self-adaptivity-controller))
                             (update-stats self-adaptivity-controller counts))))))]
      (println "Starting experiment...")
      (.setName (Thread/currentThread) "Main")
      (.start in-loop)
      (run-repeat (executor) (fn []
                               (stats-fn)
                               (thread-info-fn) (println)
                               )
                  1000)
      (run-once (executor) (fn [] (System/exit 0)) 120000))))

Move out-fn closer to pipeline definition.


;; TODO: nouns do not need {:essere false}
(ns babel.italiano.lexicon
  (:refer-clojure :exclude [get-in])
  (:require
   [babel.encyclopedia :as encyc]
   [babel.lexiconfn
    :as lexfn
    :refer [apply-unify-key default evaluate
            filter-vals listify map-function-on-map-vals
            new-entries rewrite-keys verb-pred-defaults]]

   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [babel.italiano.morphology :as morph
    :refer [phonize2]]

   [clojure.edn :as edn]
   [clojure.java.io :refer [resource]]
   [clojure.repl :refer [doc]]
   [dag_unify.core :refer [dissoc-paths fail? get-in strip-refs unify]]))

(declare edn2lexicon)

(defonce lexicon (promise))
(defn deliver-lexicon []
  (if (not (realized? lexicon))
    (deliver lexicon (edn2lexicon (resource "babel/italiano/lexicon.edn")))))

;; The values in this map in (defonce defaults) are used for lexical
;; compilation but also available for external use.
(defonce defaults
  {:adjective
   {:non-comparative
    (let [subject (atom :top)]
      {:synsem {:cat :adjective
                   :sem {:arg1 subject
                         :comparative false}
                :subcat {:1 {:sem subject}
                         :2 '()}}})}

   :agreement
   (let [agr (atom :top)
         cat (atom :verb)
         essere (atom :top)
         infl (atom :top)]
     {:italiano {:agr agr
                 :cat cat
                 :essere essere
                 :infl infl}
      :synsem {:agr agr
               :cat cat
               :essere essere
               :infl infl}})})

(defn exception-generator [lexicon]
  (let [exception-maps (morph/exception-generator lexicon)]
    (if (not (empty? exception-maps))
      (merge-with concat
                  lexicon
                  (reduce (fn [m1 m2]
                            (merge-with concat m1 m2))
                          (morph/exception-generator lexicon)))
      lexicon)))

;; TODO: see if we can use Clojure transducers here. (http://clojure.org/reference/transducers)
(defn edn2lexicon [resource]
  (-> (lexfn/edn2lexicon resource)

      ;; <noun default rules>
      (default ;; a noun by default is neither a pronoun nor a propernoun.
       {:synsem {:cat :noun
                 :agr {:person :3rd}
                 :pronoun false
                 :propernoun false}})

      (default ;; a common noun takes a determiner as its only argument.
       {:synsem {:cat :noun
                 :pronoun false
                 :propernoun false
                 :subcat {:1 {:cat :det}
                          :2 '()}}})

      (default ;; how a determiner modifies its head noun's semantics.
       (let [def (atom :top)]
         {:synsem {:cat :noun
                   :pronoun false
                   :propernoun false
                   :sem {:spec {:def def}}
                   :subcat {:1 {:def def}}}}))

      (default ;; a pronoun takes no args.
       {:synsem {:cat :noun
                 :pronoun true
                 :propernoun false
                 :subcat '()}})

      (default ;; a propernoun takes no args.
       {:synsem {:cat :noun
                 :pronoun false
                 :propernoun true
                 :subcat '()}})

      (default ;; a propernoun is agr=3rd singular
       {:synsem {:cat :noun
                 :pronoun false
                 :propernoun true
                 :agr {:number :sing
                       :person :3rd}}})

      (default  ;; reflexive pronouns are case=acc
       {:synsem {:case :acc
                 :cat :noun
                 :pronoun true
                 :reflexive true}})

      (default
       ;; pronoun case and subcat: set sharing within :italiano so
       ;; that morphology can work as expected.
       (let [cat (atom :noun)
             case (atom :top)]
         {:synsem {:case case
                   :cat cat
                   :pronoun true
                   :subcat '()}
          :italiano {:cat cat
                     :case case}}))

      (default ;; determiner-noun agreement
       (unify {:synsem {:cat :noun
                        :pronoun false
                        :propernoun false
                        :subcat {:1 {:cat :det}
                                 :2 '()}}}
              (let [agr (atom :top)
                    cat (atom :top)]
                {:italiano {:agr agr
                            :cat cat}
                 :synsem {:cat cat
                          :agr agr
                          :subcat {:1 {:agr agr}}}})))

      ;; pronouns have semantic number and gender.
      (default
       (let [gender (atom :top)
             number (atom :top)]
         {:synsem {:cat :noun
                   :pronoun true
                   :agr {:gender gender
                         :number number}
                   :sem {:gender gender
                         :number number}}}))

      ;; propernouns have semantic number and gender.
      (default
       (let [gender (atom :top)
             number (atom :top)]
         {:synsem {:cat :noun
                   :propernoun true
                   :agr {:gender gender
                         :number number}
                   :sem {:gender gender
                         :number number}}}))

      ;; nouns are semantically non-null by default
      (default
       {:synsem {:cat :noun
                 :sem {:null false}}})

      ;; </noun default rules>

      ;; <verb default rules>

      (default (let [cat (atom :verb)
                     agr (atom :top)
                     essere (atom :top)
                     infl (atom :top)]
                 {:applied {:subject-agreement true}
                  :synsem {:agr agr
                           :cat cat
                           :subcat {:1 {:agr agr}}
                           :essere essere
                           :infl infl}}))

      (default ;; aux defaults to false:
       {:synsem {:cat :verb
                 :aux false}})

      (default ;; ..but if aux is true:
       (let [;; whether a verb has essere or avere as its
             ;; auxiliary to form its past form:
             pred (atom :top)
             sem (atom :top)
             subject (atom :top)]
         {;; useful for diagnostics: can check for
          ;; this being set within a parse or generation tree.
          :applied {:aux-is-true-1 true}

          :synsem {:aux true
                   :cat :verb
                   :sem sem
                   :subcat {:1 subject
                            :2 {:cat :verb
                                :aux false
                                :subcat {:1 subject}
                                :sem sem}}}}))

      (default ;; a verb's first argument's case is nominative.
       {:synsem {:cat :verb
                 :subcat {:1 {:cat :noun
                              :case :nom}}}})

      (default ;; a verb's second argument's case is accusative.
       {:synsem {:cat :verb
                 :subcat {:2 {:cat :noun
                              :case :acc}}}})

      (default ;;  a verb's first argument defaults to the semantic subject of the verb.
       (let [subject-semantics (atom :top)]
         {:synsem {:cat :verb
                   :subcat {:1 {:sem subject-semantics}}
                   :sem {:subj subject-semantics}}}))

      (verb-pred-defaults encyc/verb-pred-defaults)

      (new-entries ;; remove the second argument and semantic object to make verbs intransitive.
       {:allow-intransitivize true
        :synsem {:cat :verb
                 :aux false
                 :sem {:obj {:top :top}
                       :reflexive false}
                 :subcat {:2 {:cat :noun}
                          :3 '()}}}
       (fn [lexeme]
         (dissoc-paths lexeme [[:synsem :sem :obj]
                               [:synsem :subcat :2]])))

      (default ;; reflexive defaults to false..
       {:synsem {:cat :verb
                 :aux false
                 :sem {:reflexive false}}})

      (default ;; ..but if a verb *is* reflexive:
       (let [subject-semantics (atom {:animate true})
             subject-agr (atom :top)]
         {:synsem {:aux false
                   :cat :verb
                   :essere true
                   :sem {:subj subject-semantics
                         :obj subject-semantics
                         :reflexive true}
                   :subcat {:1 {:agr subject-agr
                                :sem subject-semantics}
                            :2 {:agr subject-agr
                                :pronoun true
                                :reflexive true
                                :sem subject-semantics}}}}))

      (default ;; a verb defaults to intransitive.
       {:synsem {:cat :verb
                 :subcat {:1 {:top :top}
                          :2 '()}}})

      (default ;; intransitive verbs' :obj is :unspec.
       {:synsem {:cat :verb
                 :subcat {:1 {:top :top}
                          :2 '()}
                 :sem {:obj :unspec}}})

      (default ;;  a verb's second argument (if there is one)
       ;; defaults to the semantic object of the verb.
       (let [object-semantics (atom :top)]
         {:synsem {:cat :verb
                   :subcat {:2 {:sem object-semantics}}
                   :sem {:obj object-semantics}}}))

      (default ;; a verb defaults to transitive if not intransitive..
       {:synsem {:cat :verb
                 :subcat {:1 {:top :top}
                          :2 {:top :top}
                          :3 '()}}})

      (default ;;  but if there *is* a third argument, it defaults
       ;; to the semantic indirect object of the verb.
       (let [indirect-object-semantics (atom :top)]
         {:synsem {:cat :verb
                   :subcat {:3 {:sem indirect-object-semantics}}
                   :sem {:iobj indirect-object-semantics}}}))

      (default ;; a verb agrees with its first argument
       (let [subject-agreement (atom :top)]
         {:synsem {:cat :verb
                   :subcat {:1 {:agr subject-agreement}}
                   :agr subject-agreement}}))

      (default ;; essere defaults to false.
       {:synsem {:cat :verb
                 :essere false}})

      (default ;; subject is semantically non-null by default.
       {:synsem {:cat :verb
                 :aux false
                 :subcat {:1 {:sem {:null false}}}}})

      (default ;; subject is semantically non-null by default.
       {:synsem {:cat :verb
                 :aux false
                 :subcat {:1 {:sem {:null true}}}}})

      ;; </verb default rules>

      ;; <preposition default rules>
      (default ;;  a preposition's semantic object defaults to its first argument.
       (let [object-semantics (atom :top)]
         {:synsem {:cat :prep
                   :subcat {:1 {:cat :noun
                                :subcat '()
                                :sem object-semantics}
                            :2 '()}
                   :sem {:obj object-semantics}}}))

      ;; a preposition's object cannot be a reflexive pronoun.
      (default
       {:synsem {:cat :prep
                 :subcat {:1 {:reflexive false}}}})

      ;; </preposition default rules>

      ;; <adjective default rules>
      (default ;; an adjective is comparative=false by default..
       (-> defaults
           :adjective
           :non-comparative))
      ;; ..but, if comparative:
      (default
       (let [complement-sem (atom :top)
             subject-sem (atom :top)]
         {:synsem {:sem {:comparative true
                         :arg1 subject-sem
                         :arg2 complement-sem}
                   :cat :adjective
                   :subcat {:1 {:cat :noun
                                :sem subject-sem}
                            :2 {:cat :prep
                                :sem {:pred :di ;; Italian name for pred, for now: TODO: change to English :than.
                                      :obj complement-sem}
                                :subcat {:1 {:sem complement-sem}
                                         :2 '()}}}}}))
      ;; </adjective default rules>

      ;; <sent-modifier default rules>
      (default
       (let [sentential-sem (atom :top)]
         {:synsem {:cat :sent-modifier
                   :sem {:subj sentential-sem}
                   :subcat {:1 {:sem sentential-sem}}}}))
      ;; </sent-modifier default rules>

      ;; <adverb default rules>
      (default
       (let [verb-sem (atom :top)]
         {:synsem {:cat :adverb
                   :sem verb-sem
                   :subcat {:1 {:cat :verb
                                :sem verb-sem}
                            :2 '()}}}))
      ;; </adverb default rules>

      ;; <determiner default rules>
      (default
       (let [def (atom :top)]
         {:synsem {:cat :det
                   :def def
                   :sem {:def def}}}))

      ;; <category-independent>
      ;; This rule needs to be before exception-generator; otherwise
      ;; exception will be generated that fail to match this agreement rule. Putting it
      ;; before prevents these bad exceptions from existing.
      (default ;; morphology looks in :italiano, so share relevant grammatical pieces of
       ;; info (:agr, :cat, :infl, and :essere) there so it can see them.
       (unify (:agreement defaults)
              {:applied {:agreement-defaults true}}))
      ;; </category-independent>

      exception-generator ;; add new keys to the map for all exceptions found.

      ;; <category-independent>
      (default ;; morphology looks in :italiano, so share relevant grammatical pieces of
       ;; info (:agr, :cat, :infl, and :essere) there so it can see them.
       (:agreement defaults))
      ;; </category-independent>

      phonize2 ;; for each value v of each key k, set the [:italiano :italiano] of v to k, if not already set
      ;; e.g. by exception-generator2.

      ;; TODO: throw error or warning in certain cases:
      ;; (= true (fail? value))
      ;;

      ;; common nouns need a gender (but propernouns do not need one).
      ;; TODO: throw error rather than just throwing out entry.
      (filter-vals
      #(or (not (and (= :noun (get-in % [:synsem :cat]))
                     (= :none (get-in % [:synsem :agr :gender] :none))
                     (= false (get-in % [:synsem :propernoun] false))
                     (= false (get-in % [:synsem :pronoun] false))))
           (and (log/warn (str "ignoring common noun with no gender specified: " %))
                false)))

      (filter-vals
       #(not (= :fail %)))

      ;; filter out entries with no :cat.
      (filter-vals
      #(or (and (not (= :none (get-in % [:synsem :cat] :none)))
                (or (log/debug (str "lexical entry has a cat - good : " (strip-refs %)))
                    true))
           (and (log/warn (str "ignoring lexical entry with no :cat: " (strip-refs %)))
                false)))

     ;; end of language-specific grammar rules
))

;; TODO: nouns do not need {:essere false}
(ns babel.italiano.lexicon
  (:refer-clojure :exclude [get-in])
  (:require
   [babel.encyclopedia :as encyc]
   [babel.lexiconfn
    :as lexfn
    :refer [apply-unify-key default evaluate
            filter-vals listify map-function-on-map-vals
            new-entries rewrite-keys verb-pred-defaults]]

   #?(:clj [clojure.tools.logging :as log])
   #?(:cljs [babel.logjs :as log])
   [babel.italiano.morphology :as morph
    :refer [phonize2]]

   [clojure.edn :as edn]
   [clojure.java.io :refer [resource]]
   [clojure.repl :refer [doc]]
   [dag_unify.core :refer [dissoc-paths fail? get-in strip-refs unify]]))

(declare edn2lexicon)

(defonce lexicon (promise))
(defn deliver-lexicon []
  (if (not (realized? lexicon))
    (deliver lexicon (edn2lexicon (resource "babel/italiano/lexicon.edn")))))

;; The values in this map in (defonce defaults) are used for lexical
;; compilation but also available for external use.
(defonce defaults
  {:adjective
   {:non-comparative
    (let [subject (atom :top)]
      {:synsem {:cat :adjective
                   :sem {:arg1 subject
                         :comparative false}
                :subcat {:1 {:sem subject}
                         :2 '()}}})}

   :agreement
   (let [agr (atom :top)
         cat (atom :verb)
         essere (atom :top)
         infl (atom :top)]
     {:italiano {:agr agr
                 :cat cat
                 :essere essere
                 :infl infl}
      :synsem {:agr agr
               :cat cat
               :essere essere
               :infl infl}})})

(defn exception-generator [lexicon]
  (let [exception-maps (morph/exception-generator lexicon)]
    (if (not (empty? exception-maps))
      (merge-with concat
                  lexicon
                  (reduce (fn [m1 m2]
                            (merge-with concat m1 m2))
                          (morph/exception-generator lexicon)))
      lexicon)))

;; TODO: see if we can use Clojure transducers here. (http://clojure.org/reference/transducers)
(defn edn2lexicon [resource]
  (-> (lexfn/edn2lexicon resource)

      ;; <noun default rules>
      (default ;; a noun by default is neither a pronoun nor a propernoun.
       {:synsem {:cat :noun
                 :agr {:person :3rd}
                 :pronoun false
                 :propernoun false}})

      (default ;; a common noun takes a determiner as its only argument.
       {:synsem {:cat :noun
                 :pronoun false
                 :propernoun false
                 :subcat {:1 {:cat :det}
                          :2 '()}}})

      (default ;; how a determiner modifies its head noun's semantics.
       (let [def (atom :top)]
         {:synsem {:cat :noun
                   :pronoun false
                   :propernoun false
                   :sem {:spec {:def def}}
                   :subcat {:1 {:def def}}}}))

      (default ;; a pronoun takes no args.
       {:synsem {:cat :noun
                 :pronoun true
                 :propernoun false
                 :subcat '()}})

      (default ;; a propernoun takes no args.
       {:synsem {:cat :noun
                 :pronoun false
                 :propernoun true
                 :subcat '()}})

      (default ;; a propernoun is agr=3rd singular
       {:synsem {:cat :noun
                 :pronoun false
                 :propernoun true
                 :agr {:number :sing
                       :person :3rd}}})

      (default  ;; reflexive pronouns are case=acc
       {:synsem {:case :acc
                 :cat :noun
                 :pronoun true
                 :reflexive true}})

      (default
       ;; pronoun case and subcat: set sharing within :italiano so
       ;; that morphology can work as expected.
       (let [cat (atom :noun)
             case (atom :top)]
         {:synsem {:case case
                   :cat cat
                   :pronoun true
                   :subcat '()}
          :italiano {:cat cat
                     :case case}}))

      (default ;; determiner-noun agreement
       (unify {:synsem {:cat :noun
                        :pronoun false
                        :propernoun false
                        :subcat {:1 {:cat :det}
                                 :2 '()}}}
              (let [agr (atom :top)
                    cat (atom :top)]
                {:italiano {:agr agr
                            :cat cat}
                 :synsem {:cat cat
                          :agr agr
                          :subcat {:1 {:agr agr}}}})))

      ;; pronouns have semantic number and gender.
      (default
       (let [gender (atom :top)
             number (atom :top)]
         {:synsem {:cat :noun
                   :pronoun true
                   :agr {:gender gender
                         :number number}
                   :sem {:gender gender
                         :number number}}}))

      ;; propernouns have semantic number and gender.
      (default
       (let [gender (atom :top)
             number (atom :top)]
         {:synsem {:cat :noun
                   :propernoun true
                   :agr {:gender gender
                         :number number}
                   :sem {:gender gender
                         :number number}}}))

      ;; nouns are semantically non-null by default
      (default
       {:synsem {:cat :noun
                 :sem {:null false}}})

      ;; </noun default rules>

      ;; <verb default rules>

      (default (let [cat (atom :verb)
                     agr (atom :top)
                     essere (atom :top)
                     infl (atom :top)]
                 {:applied {:subject-agreement true}
                  :synsem {:agr agr
                           :cat cat
                           :subcat {:1 {:agr agr}}
                           :essere essere
                           :infl infl}}))

      (default ;; aux defaults to false:
       {:synsem {:cat :verb
                 :aux false}})

      (default ;; ..but if aux is true:
       (let [;; whether a verb has essere or avere as its
             ;; auxiliary to form its past form:
             pred (atom :top)
             sem (atom :top)
             subject (atom :top)]
         {;; useful for diagnostics: can check for
          ;; this being set within a parse or generation tree.
          :applied {:aux-is-true-1 true}

          :synsem {:aux true
                   :cat :verb
                   :sem sem
                   :subcat {:1 subject
                            :2 {:cat :verb
                                :aux false
                                :subcat {:1 subject}
                                :sem sem}}}}))

      (default ;; a verb's first argument's case is nominative.
       {:applied {:subcat-1-is-nom true}
        :synsem {:cat :verb
                 :subcat {:1 {:cat :noun
                              :case :nom}}}})

      (default ;; a verb's second argument's case is accusative.
       {:applied {:subcat-2-is-acc true}
        :synsem {:cat :verb
                 :subcat {:2 {:cat :noun
                              :case :acc}}}})

      (default ;;  a verb's first argument defaults to the semantic subject of the verb.
       (let [subject-semantics (atom :top)]
         {:synsem {:cat :verb
                   :subcat {:1 {:sem subject-semantics}}
                   :sem {:subj subject-semantics}}}))

      (verb-pred-defaults encyc/verb-pred-defaults)

      (new-entries ;; remove the second argument and semantic object to make verbs intransitive.
       {:allow-intransitivize true
        :synsem {:cat :verb
                 :aux false
                 :sem {:obj {:top :top}
                       :reflexive false}
                 :subcat {:2 {:cat :noun}
                          :3 '()}}}
       (fn [lexeme]
         (dissoc-paths lexeme [[:synsem :sem :obj]
                               [:synsem :subcat :2]])))

      (default ;; reflexive defaults to false..
       {:synsem {:cat :verb
                 :aux false
                 :sem {:reflexive false}}})

      (default ;; ..but if a verb *is* reflexive:
       (let [subject-semantics (atom {:animate true})
             subject-agr (atom :top)]
         {:synsem {:aux false
                   :cat :verb
                   :essere true
                   :sem {:subj subject-semantics
                         :obj subject-semantics
                         :reflexive true}
                   :subcat {:1 {:agr subject-agr
                                :sem subject-semantics}
                            :2 {:agr subject-agr
                                :pronoun true
                                :reflexive true
                                :sem subject-semantics}}}}))

      (default ;; a verb defaults to intransitive.
       {:synsem {:cat :verb
                 :subcat {:1 {:top :top}
                          :2 '()}}})

      (default ;; intransitive verbs' :obj is :unspec.
       {:synsem {:cat :verb
                 :subcat {:1 {:top :top}
                          :2 '()}
                 :sem {:obj :unspec}}})

      (default ;;  a verb's second argument (if there is one)
       ;; defaults to the semantic object of the verb.
       (let [object-semantics (atom :top)]
         {:synsem {:cat :verb
                   :subcat {:2 {:sem object-semantics}}
                   :sem {:obj object-semantics}}}))

      (default ;; a verb defaults to transitive if not intransitive..
       {:synsem {:cat :verb
                 :subcat {:1 {:top :top}
                          :2 {:top :top}
                          :3 '()}}})

      (default ;;  but if there *is* a third argument, it defaults
       ;; to the semantic indirect object of the verb.
       (let [indirect-object-semantics (atom :top)]
         {:synsem {:cat :verb
                   :subcat {:3 {:sem indirect-object-semantics}}
                   :sem {:iobj indirect-object-semantics}}}))

      (default ;; a verb agrees with its first argument
       (let [subject-agreement (atom :top)]
         {:synsem {:cat :verb
                   :subcat {:1 {:agr subject-agreement}}
                   :agr subject-agreement}}))

      (default ;; essere defaults to false.
       {:synsem {:cat :verb
                 :essere false}})

      (default ;; subject is semantically non-null by default.
       {:synsem {:cat :verb
                 :aux false
                 :subcat {:1 {:sem {:null false}}}}})

      (default ;; subject is semantically non-null by default.
       {:synsem {:cat :verb
                 :aux false
                 :subcat {:1 {:sem {:null true}}}}})

      ;; </verb default rules>

      ;; <preposition default rules>
      (default ;;  a preposition's semantic object defaults to its first argument.
       (let [object-semantics (atom :top)]
         {:synsem {:cat :prep
                   :subcat {:1 {:cat :noun
                                :subcat '()
                                :sem object-semantics}
                            :2 '()}
                   :sem {:obj object-semantics}}}))

      ;; a preposition's object cannot be a reflexive pronoun.
      (default
       {:synsem {:cat :prep
                 :subcat {:1 {:reflexive false}}}})

      ;; </preposition default rules>

      ;; <adjective default rules>
      (default ;; an adjective is comparative=false by default..
       (-> defaults
           :adjective
           :non-comparative))
      ;; ..but, if comparative:
      (default
       (let [complement-sem (atom :top)
             subject-sem (atom :top)]
         {:synsem {:sem {:comparative true
                         :arg1 subject-sem
                         :arg2 complement-sem}
                   :cat :adjective
                   :subcat {:1 {:cat :noun
                                :sem subject-sem}
                            :2 {:cat :prep
                                :sem {:pred :di ;; Italian name for pred, for now: TODO: change to English :than.
                                      :obj complement-sem}
                                :subcat {:1 {:sem complement-sem}
                                         :2 '()}}}}}))
      ;; </adjective default rules>

      ;; <sent-modifier default rules>
      (default
       (let [sentential-sem (atom :top)]
         {:synsem {:cat :sent-modifier
                   :sem {:subj sentential-sem}
                   :subcat {:1 {:sem sentential-sem}}}}))
      ;; </sent-modifier default rules>

      ;; <adverb default rules>
      (default
       (let [verb-sem (atom :top)]
         {:synsem {:cat :adverb
                   :sem verb-sem
                   :subcat {:1 {:cat :verb
                                :sem verb-sem}
                            :2 '()}}}))
      ;; </adverb default rules>

      ;; <determiner default rules>
      (default
       (let [def (atom :top)]
         {:synsem {:cat :det
                   :def def
                   :sem {:def def}}}))

      ;; <category-independent>
      ;; This rule needs to be before exception-generator; otherwise
      ;; exception will be generated that fail to match this agreement rule. Putting it
      ;; before prevents these bad exceptions from existing.
      (default ;; morphology looks in :italiano, so share relevant grammatical pieces of
       ;; info (:agr, :cat, :infl, and :essere) there so it can see them.
       (unify (:agreement defaults)
              {:applied {:agreement-defaults true}}))
      ;; </category-independent>

      exception-generator ;; add new keys to the map for all exceptions found.

      ;; <category-independent>
      (default ;; morphology looks in :italiano, so share relevant grammatical pieces of
       ;; info (:agr, :cat, :infl, and :essere) there so it can see them.
       (unify (:agreement defaults)
              {:applied {:agreement-defaults true}}))
      ;; </category-independent>

      phonize2 ;; for each value v of each key k, set the [:italiano :italiano] of v to k, if not already set
      ;; e.g. by exception-generator2.

      ;; TODO: throw error or warning in certain cases:
      ;; (= true (fail? value))
      ;;

      ;; common nouns need a gender (but propernouns do not need one).
      ;; TODO: throw error rather than just throwing out entry.
      (filter-vals
      #(or (not (and (= :noun (get-in % [:synsem :cat]))
                     (= :none (get-in % [:synsem :agr :gender] :none))
                     (= false (get-in % [:synsem :propernoun] false))
                     (= false (get-in % [:synsem :pronoun] false))))
           (and (log/warn (str "ignoring common noun with no gender specified: " %))
                false)))

      (filter-vals
       #(not (= :fail %)))

      ;; filter out entries with no :cat.
      (filter-vals
      #(or (and (not (= :none (get-in % [:synsem :cat] :none)))
                (or (log/debug (str "lexical entry has a cat - good : " (strip-refs %)))
                    true))
           (and (log/warn (str "ignoring lexical entry with no :cat: " (strip-refs %)))
                false)))

     ;; end of language-specific grammar rules
))

add :applied feature to diagnose where rules are being applied