Proto repl save functionality for ClojureCLR

save.clj

(ns miracle.tools.save
  (:require [clojure.walk :refer [postwalk]]))

(def ^:dynamic *max-saves* 1000000000)

(defn gensym? [s]       
  (re-find #"__\d+" s))

(defn fn->var
  "Takes a function and returns a var. Works even on function objects."
  [f]
  (-> (str f)
      clojure.repl/demunge
      (clojure.string/replace #"eval--\d+" "")
      (clojure.string/replace #"--\d+" "")
      (clojure.string/replace #"(/(?=[^/]*/))" ".")  ;; replace all but last / with .
      symbol
      (#(eval `(var ~%)))))

;; Contains the saved local bindings of various vars and identifiers.
(defonce saves (atom {}))

(defn clear-saves! [] (reset! saves {}))

(defn new*
  "Creates a new save at `var` and `id`, with `bindings`."
  ([var id]
   (new* var id {}))
  ([var id bindings]
   (swap! saves update-in [var id] 
          (fn [saves]
            (-> (conj saves bindings)  ;; put it on the stack!
                (#(if (< (count %) *max-saves*)
                    (into '() (reverse (take *max-saves* %)))
                    %)))))))

(defn update*
  "Updates a specific binding `k` using `f` for a `var` and an `id`entifier."
  ([sym id k val f]
   (let [binding-list (get-in @saves [sym id])]
     (if binding-list
       (let [v (get (peek binding-list) k)
             res (f v val)]
         (swap! saves assoc-in [sym id] (conj (pop binding-list) (assoc (peek binding-list) k res)))
         val)
       (let [res (f nil val)]
         (swap! saves assoc-in [sym id] (list {k res}))
         val)))))

(defn save-fn
  ([bindings] (save-fn bindings :__default))
  ([bindings id]
   (let [callee `(fn->var (second (last (sort-by first (filter #(re-matches #"fn__\d+" (name (key %))) ~bindings)))))] (save-fn bindings callee id)))
  ([bindings callee id]
   (let [bindings `(into {} (remove #(gensym? (name (key %))) ~bindings))]
     `(new* ~callee ~id ~bindings))))

(defmacro get-env
  []
  (into {} (for [k (keys &env)]
             [`'~k k])))

(defmacro save
  "Used to save all local bindings, takes an optional identifier as a parameter.
  The identifier is used with `ld` in order to load the local bindings at a specific point.
  If no identifier is provided, a default value is used instead."
  [& args]
  (apply save-fn
         (into {} (for [k (keys &env)]
                    [`'~k k]))
         args))

(defn get-save
  ([sym]
   (get-save sym :__default))
  ([sym id]
   (let [sym (cond (keyword? sym) sym
                   (var? sym) sym
                   (symbol? sym) (resolve sym)
                   :otherwise (fn->var sym))]
     (get-in @saves [sym id]))))

(defn ld
  "Loads the local bindings that have been saved in function `v` at point `id`.
  If `id` is omitted, a default value is used instead."
  ([v] (ld v :__default))
  ([v id]
   (let [locals (first (get-save v id))]
     (when-not (nil? locals)
       (do
         (println "Defining" (keys locals))
         (doseq [[sym val] locals]
           (try
             (eval `(def ~(symbol sym) '~val))
             (catch Exception e (do (prn sym val))))))))))

(defn fld
  "Loads the local bindings that have been saved in function `v` using save-func."
  ([v]
   (let [locals (first (get-save v :__funcall))]
     (when-not (nil? locals)
       (let [lets (into {} (:lets locals))
             args (into {} (:args locals))
             locals (merge args lets)]
         (println "Defining" (keys locals))
         (doseq [[sym val] locals]
           (try
             (eval `(def ~(symbol sym) '~val))
             (catch Exception e (do (prn sym val)))))))))
  ([v & [extra]]
   (let [pred (if (= extra :error) :error (constantly true))
         locals (first (filter pred (get-save v :__funcall)))]
     (when-not (nil? locals)
       (let [lets (into {} (:lets locals))
             args (into {} (:args locals))
             all-lets (:lets locals)
             error (:error locals)
             locals (merge args lets {'all-lets all-lets} {'args_ args} (when error {'error error}))]
         (prn (:error locals))
         (println "Defining" (keys locals))
         (doseq [[sym val] locals]
           (try
             (eval `(def ~(symbol sym) '~val))
             (catch Exception e (do (prn sym val))))))))))

(defmacro let-save-specific
  [sym id bindings & body]
  (let [bindings (->> (partition 2 bindings)
                      (map (fn [[k v]] [k `(update* ~sym ~id :lets ~v #(into [] (conj %1 ['~k %2])))]))
                      (apply concat)
                      (into []))]
    `(let ~bindings ~@body)))

(defmacro save-func-specific
  [id & body]
  (let [env (into {} (for [k (keys &env)]
                       [`'~k k])) 
        callee `(fn->var (second (last (sort-by first (filter #(re-matches #"fn__\d+" (name (key %))) ~env)))))]
    `(do
       (new* ~callee ~id {:__args (into {} (remove #(gensym? (name (key %))) ~env))})
       ~@(postwalk #(if (and (list? %)
                             (symbol? (first %))
                             (= (resolve (first %))
                                #'clojure.core/let))
                      (apply list 'let-save-specific callee id (rest %)) %)
                   body))))

(defmacro save-func
  [& body]
  (let [env (into {} (for [k (keys &env)]
                       [`'~k k]))
        callee `(fn->var (second (last (sort-by first (filter #(re-matches #"fn__\d+" (name (key %))) ~env)))))]
    `(do
       (miracle.tools.save/new* ~callee :__funcall {:args (into {} (remove #(gensym? (name (key %))) ~env))})
       (try
         ~@(postwalk #(if (and (list? %)
                               (symbol? (first %))
                               (= (resolve (first %))
                                  #'clojure.core/let))
                        (apply list 'let-save-specific callee :__funcall (rest %)) %)
                     body)
         (catch Exception ~'e (do (update* ~callee :__funcall :error ~'e #(identity %2))
                                  (throw ~'e)))))))

(defn inspect-map [map-to-print & {:keys [desired-level safe-count]
                                   :or {desired-level 4 safe-count 10}}]
  (binding [*print-level* desired-level *print-length* safe-count]
    (clojure.pprint/pprint map-to-print)))

(defn print-saves
  "Loads the local bindings that have been saved in function `v` at point `id`.
  If `id` is omitted, a default value is used instead."
  ([v] (print-saves
        v :__funcall))
  ([v id]
   (let [v (cond (keyword? v) v
                 (var? v) v
                 (symbol? v) (resolve v)
                 :otherwise (fn->var v))
         locals (take 10 (get-in @saves [v id]))]
     (doseq [i (reverse (range (count locals)))]
       (println "Entry no." i)
       (inspect-map (first (drop i locals)))
       (prn)))))