           (merge (effect-sets bit) (util/map-vals (fn [x] #{x}) (:effect-map a)))
           [[bit a]]))))))
 
+
+;; TODO: figure out how much to generalize here.
+(defn cached-induce [name init-sets result-fn]
+  (let [entries (.get *hla-cache* name)]
+    (assert (not (identical? entries :STACK)))
+    (if-let [v (first (filter #(let [ks (precond-var-set %)] 
+                                 (= (select-keys init-sets ks) (select-keys (initial-sets %) ks))) 
+                              entries))]
+        (do (println "Cache hit for" name) 
+            v)
+      (do (.put *hla-cache* name :STACK)
+          (let [ret (result-fn)]
+            (assert ret) ;; If we run into this, need to figure out how to properly cache failures.
+            (.put *hla-cache* name (cons ret entries))
+            ret)))))
+
+(defn induce-action-hla [a init-sets]
+  (cached-induce (action-hla-name a) init-sets #(induce-action-hla- a init-sets)))
+
+(defn induce-vv-hla [var goal-val init-sets ]
+  (cached-induce (vv-hla-name var goal-val) init-sets #(induce-vv-hla- var goal-val init-sets)))
+
 (defn induce-hierarchy [sas-problem]
   (let [{:keys [vars actions init]} sas-problem]
     (binding [*vars*         vars
-              *reverse-dtgs* (make-extended-reverse-dtgs vars actions)]
+              *reverse-dtgs* (make-extended-reverse-dtgs vars actions)
+              *hla-cache*    (HashMap.)              
+              ]
       (hierarchy/SimpleHierarchicalEnv sas-problem 
         [(util/make-safe 
           (induce-action-hla (util/safe-singleton (get-in *reverse-dtgs* [:goal [:true] [:false]]))
                              (util/map-vals (fn [x] #{x}) init)))]))))
 
+
+
+
+
 (defmulti pretty-print-action type)
 
 (defn pretty-print-hla [h]
-  (println (str "\nRefs for HLA" (env/action-name h)) (precond-var-set h) (effect-sets h))
+  (println (str "\nRefs for HLA" (env/action-name h)) (precond-var-set h) #_ (effect-sets h))
   (doseq [ref (:refinements h)]
     (println " " (util/str-join ", " (map env/action-name ref))))
   (doseq [ref (:refinements h), a ref]

(defn backward-simplify [sas-problem]
  (let [{:keys [vars actions init]} sas-problem
        extended-dtgs               (make-extended-dtgs vars actions)     
        dead-actions                (HashSet. actions)
        now-live-actions            (HashSet.)
        new-goals                   (make-map-of-sets (keys vars))
        new-srcs                    (make-map-of-sets (keys vars))


(def *vars* nil)
(def *reverse-dtgs* nil)
(def #^HashMap *hla-cache* (HashMap.)) ; a map from [action-name] to map from init-sets to action.

(defprotocol SAS-Induced-Action
  (precond-var-set [a])
  (initial-sets    [a])
  (effect-sets     [a]))

(extend ::env/FactoredPrimitive
  SAS-Induced-Action
    {:precond-var-set (fn [a] (util/keyset (:precond-map a)))
     :initial-sets    (fn [a] (util/map-vals (fn [x] #{x}) (:precond-map a)))
     :effect-sets     (fn [a] (util/map-vals (fn [x] #{x}) (:effect-map a)))})

(defn vv-hla-name [var val] [::VV var val])
(deftype SAS-VV-HLA     [var val precond-vars init-sets effect-sets refinements]
  SAS-Induced-Action
    (precond-var-set [] precond-vars)
    (initial-sets    [] init-sets)
    (effect-sets     [] effect-sets)
  env/Action
    (action-name [] (vv-hla-name var val))
    (primitive?  [] false)
  env/ContextualAction 
    (precondition-context [s] (assert (util/subset? (util/keyset effect-sets) precond-vars)) precond-vars)
