 
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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? 
-;; For now, considers all ways 
+;; 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 preconds init-sets-atom precond-vars-atom effect-sets-atom]
-  SAS-Induced-Action
-    (precond-var-set [] precond-vars)
-    (effect-sets     [] effect-sets)
+(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)
+    (action-name     [] (action-hla-name action))
+    (primitive?      [] false)
   env/ContextualAction 
-    (precondition-context [s] precond-vars)
+    (precondition-context [s] @precond-vars-atom)
   hierarchy/HighLevelAction
-    (immediate-refinements- [s] refinements)
+    (immediate-refinements- [s] [precond-set-hla action])
     (cycle-level-           [s] nil))
 
 
-(defn get-current-action-hla [action]
-  (util/cache-with *hla-cache* (action-hla-name action)
-    (SAS-Action-HLA action 
-      (doall (map #(partial apply make-precond-hla) (:precond-map a)))
-      (atom {}) (atom #{})
-                    )
-    (if (= src-val dst-val)
-      (SAS-VV-HLA var src-val dst-val (atom true) (atom *var-val-sets*) (atom #{var}) (atom {}) (atom {}))      
-      (SAS-VV-HLA var src-val dst-val (atom false) (atom {})            (atom #{var}) (atom {}) (atom {})))))
+(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)))))))
 
 
 

      (doseq [e (vals @successor-map-atom)] (extend-vv-hla-edge! hla e @init-sets-atom)))
    (when (or new-src? new-inits?)
      (let [successors (map second (apply concat (vals @successor-map-atom)))]
        (swap! precond-vars-atom (apply clojure.set/union       (map precond-var-set successors)))
        (swap! effect-sets-atom  (apply disjoin-effect-set-maps (map effect-sets     successors)))))))

(defn extend-vv-hla-edge! 
  "Extend this VV-HLA edge to cover new init-sets, as needed."

          (when (seq @(:init-sets-atom sn)) (println "Warning: adding outgoing edges! (sas_hierarchy_induction)"))
          (swap! @(:successor-map-atom sn) assoc t
            (doall (for [a (util/safe-get-in *extended-dtgs* var s t)] 
                     [(get-current-action-hla a var) (get-current-vv-hla var t dst-val)])))
          (doseq [e (util/safe-get @(:successor-map-atom sn) t)]
            (extend-vv-hla-edge! sn e @(:init-sets sn))))))))

