Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
(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)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment