 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Top Level  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
+(def *vars* nil)
+(def *extended-dtgs* nil) ; Map from var to map from prev val to map from post val to list of actions.
+(def *simple-dtgs* nil)   ; Map from var to edge list.
+(def *var-val-sets* nil)  ; Map from var name to set of all vals.
+(def #^HashMap *hla-cache* nil) ; a map from [action-name] to map from init-sets to action.
+
 (defn induce-hierarchy [sas-problem]
   (let [{:keys [vars actions init]} sas-problem]
-    (binding [*vars*         vars
-              *reverse-dtgs* (sas-analysis/reverse-domain-transition-graphs vars actions)
-              *hla-cache*    (HashMap.)              
-              ]
-      (hierarchy/SimpleHierarchicalEnv sas-problem 
-        [(util/make-safe 
-          (induce-action-hla (util/safe-singleton (get-in *reverse-dtgs* [sas/goal-var-name sas/goal-true-val sas/goal-false-val]))
-                             (util/map-vals (fn [x] #{x}) init)))]))))
+    (binding [*vars*          vars
+              *extended-dtgs* (sas-analysis/domain-transition-graphs vars actions)
+              *simple-dtgs*   (util/map-vals (fn [dtg] (for [[pval emap] dtg, [eval _] emap] [pval eval])) *extended-dtgs*)
+              *var-val-sets*  (util/map-map (juxt :name :vals) vars)
+              *hla-cache*     (HashMap.)]
+      (let [goal-action (util/safe-singleton (get-in *extended-dtgs* [sas/goal-var-name sas/goal-false-val sas/goal-true-val]))
+            goal-hla    (get-current-action-hla goal-action sas/goal-var-name)]
+        (extend-action-hla! goal-hla (util/map-vals (fn [x] #{x}) init))
+        (hierarchy/SimpleHierarchicalEnv sas-problem [goal-hla])))))
 
 
 


;; TODO: special treatment for "free"  vars without self-loops.

(defn vv-hla-name [var src-val dst-val] [:!VV src-var dst-val])

; successor-map is a map from dst-val to list of [ap-hla next-vv-hla] pairs. 
(deftype SAS-VV-HLA  [var src-val dst-val src?-atom init-sets-atom precond-vars-atom effect-sets-atom successor-map-atom]




;;;;;;;;;;;;;;;;;;;;;;;;;;;; Precondition Set Nodes ;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Each precond HLA is not cached, and is owned by a particular action.
;; It just aggregates sets of src vv-hla nodes, more or less.
;; src-map-atom maps from src vals to sas-vv-hla instances.  Init-sets describes current init-sets.

(deftype SAS-Precond-Set-HLA [hard-preconds soft-precond?] :as this
  SAS-Induced-Action
    (precond-var-set [] (if soft-precond? (precond-var-set soft-precond?) #{}))
    (effect-sets     [] (if soft-precond? (effect-sets     soft-precond?)  {}))
  env/Action
    (action-name [] (throw (UnsupportedOperationException.)))
    (primitive?  [] false)
  env/ContextualAction 
    (precondition-context [s] (precond-var-set this))
  hierarchy/HighLevelAction
    (immediate-refinements- [s] (assert (env/state-matches-map? s hard-preconds)) (if soft-precond? [soft-precond?] []))
    (cycle-level-           [s] nil))

(defn make-precond-set-hla [hard-preconds soft-precond?] 
  (SAS-Precond-Set-HLA hard-preconds soft-precond?))

(defn extend-precond-set-hla! [hla init-sets]
  (assert (every? (fn [[k v]] (contains? (get init-sets k) v)) (:hard-preconds hla)))
  (when-let [p (:soft-precond? hla)] (extend-precond-hla! p init-sets)))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Nodes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; An action.  
;; TODO: think about splitting this based on which var it's being used for.
;; TODO: make fancier.
;; TODO: how do we go in parallel? Need to simulate parallel execution, look at pairs of choice points, ETC ? 
;; For now, assume at most one unsatisfied precond.

(defn action-hla-name [action] [:!A (env/action-name action)])

(deftype SAS-Action-HLA [action precond-set-hla init-sets-atom precond-vars-atom effect-sets-atom]
  SAS-Induced-Action
    (precond-var-set [] @precond-vars-atom)
    (effect-sets     [] @effect-sets-atom)
  env/Action
    (action-name     [] (action-hla-name action))
    (primitive?      [] false)
  env/ContextualAction 
    (precondition-context [s] @precond-vars-atom)
  hierarchy/HighLevelAction
    (immediate-refinements- [s] [precond-set-hla action])
    (cycle-level-           [s] nil))


(defn get-current-action-hla [action var]
  (let [preconds     (:precond-map action)
        rem-preconds (dissoc preconds var)]
    (assert (<= (count rem-preconds) 1))
    (util/cache-with *hla-cache* (action-hla-name action)
      (SAS-Action-HLA action
        (make-precond-set-hla (select-keys preconds [var]) (make-precond-hla (key (first rem-preconds)) (val (first rem-preconds))))
        (atom {}) (atom (util/keyset preconds)) (atom {})))))

(defn extend-action-hla! [hla init-sets]
  (let [{:keys [action precond-set-hla init-sets-atom precond-vars-atom effect-sets-atom]} hla
        new-inits? (not= (select-keys @init-sets-atom @precond-vars-atom)
                         (select-keys (swap! @init-sets-atom #(merge-with clojure.set/union % init-sets)) @precond-vars-atom))]
    (when new-inits?
      (extend-precond-set-hla! precond-set-hla init-sets)
      (reset! precond-vars-atom (clojure.set/union (precond-var-set precond-set-hla) (util/keyset (:precond-map action))))
      (reset! effect-sets-atom  (sequence-effect-set-maps (effect-sets precond-set-hla)
                                                          (util/map-vals (fn [x] #{x}) (:effect-map action)))))))



