purgatory.cljs

(ns purgatory.core
  (:require-macros [purgatory.macros :refer [check]])
  (:require [goog.object :as gobject]))

(enable-console-print!)

(def ^:dynamic *parent* nil)

(defprotocol ITrappable
  (-trap [this]))

(defprotocol IPurgatory
  (-release [this]))

(declare trap)

(deftype PArray [arr idx ^{:mutable true :tag boolean} used parent]
  Object
  (mark! [_]
    (set! used true)
    (if-not (nil? parent)
      (.mark! parent)))
  IPurgatory
  (-release [this]
    (check
      (.mark! this)
      arr))
  ICounted
  (-count [_]
    (check (alength arr)))
  ILookup
  (-lookup [this key]
    (-lookup this key nil))
  (-lookup [this key not-found]
    (check
      (binding [*parent* this]
        (if (< key (- (alength arr) idx))
          (trap (aget arr key))
          not-found))))
  ISeq
  (-first [_]
    (check (aget arr idx)))
  ITransientCollection
  (-conj! [this val]
    (check
      (.push arr val )
      (.mark! this)
      (PArray. arr 0 false nil)))
  (-persistent! [_ val]
    (throw (js/Error. "PArray cannot be made persistent!")))
  ITransientVector
  (-assoc-n! [_ n val]
    (check
      (aset arr n val)
      (.mark! used true)
      (PArray. arr 0 false nil)))
  (-pop! [_ n val]
    (check
      (.pop arr)
      (.mark! used true)
      (PArray. arr 0 false nil)))
  IPrintWithWriter
  (-pr-writer [_ writer opts]
    (pr-sequential-writer writer pr-writer "(" " " ")" opts arr)))

(defn parray
  ([] (parray (array)))
  ([arr]
    (PArray. arr 0 false *parent*)))

(deftype PObject [obj ^{:mutable true :tag boolean} used parent]
  Object
  (mark! [_]
    (set! used true)
    (if-not (nil? parent)
      (.mark! parent)))
  IPurgatory
  (-release [this]
    obj)
  ISeqable
  (-seq [this]
    (let [ret (array)]
      (goog.object/forEach obj
        (fn [val key obj] (.push ret [key val])))
      (seq ret)))
  ILookup
  (-lookup [this key]
    (-lookup this key nil))
  (-lookup [this key not-found]
    (check
      (binding [*parent* this]
        (if (.hasOwnProperty obj key)
          (trap (aget obj key))
          not-found))))
  ITransientCollection
  (-conj! [this val]
    (check
      (aset obj (first val) (second val))
      (.mark! this)
      (PObject. obj false nil)))
  (-persistent! [_ val]
    (throw (js/Error. "PObject cannot be made persistent!")))
  ITransientAssociative
  (-assoc! [this key val]
    (check
      (aset obj key val)
      (.mark! this)
      (PObject. obj false nil)))
  (-dissoc! [this key]
    (check
      (js-delete obj key)
      (.mark! this)
      (PObject. obj false nil)))
  IPrintWithWriter
  (-pr-writer [coll writer opts]
    (let [pr-pair (fn [keyval] (pr-sequential-writer writer pr-writer "" " " "" opts keyval))]
      (pr-sequential-writer writer pr-pair "{" ", " "}" opts coll))))

(defn pobject
  ([] (pobject (js-obj)))
  ([obj]
    (PObject. obj false *parent*)))

(defn release [x]
  (-release x))

(defn trap [x]
  (-trap x))

(extend-protocol ITrappable
  array
  (-trap [arr]
    (parray arr))
  object
  (-trap [obj]
    (pobject obj))
  number
  (-trap [n]
    n))

(println (conj! (parray (array 1 2 3)) 4))

(println (assoc! (pobject (js-obj "foo" "bar")) "baz" "woz"))

(let [x (trap
          (js-obj
            "foo" (array 1 2 3)
            "bar" (array 4 5 6)))]
  (println (get-in x ["bar" 1])))

(let [x (trap
          (js-obj
            "foo" (array 1 2 3)
            "bar" (array 4 5 6)))]
  (println (conj! (get x "bar") 7)))

(let [x (trap
          (js-obj
            "foo" (array 1 2 3)
            "bar" (array 4 5 6)))]
  (println (conj! (get x "bar") 7))
  ;;(assoc! x "baz" (array 8 9 10)) ;; error
  )

;; 6507 ms
(time (count (persistent! (reduce #(assoc! %1 %2 %2) (transient {}) (range 1000000)))))
;; 418ms
(time (reduce #(assoc! %1 %2 %2) (trap (js-obj)) (range 1000000)))