CLJS-1243: Add TaggedLiteral type & related fns

Author: brandonbloom

src/cljs/cljs/core.cljs

@@ -8956,6 +8956,7 @@ reduces them without incurring seq initialization"
   [proc coll]
   (reduce #(proc %2) nil coll))
 
+
 (defprotocol IEncodeJS
   (-clj->js [x] "Recursively transforms clj values to JavaScript")
   (-key->js [x] "Transforms map keys to valid JavaScript keys. Arbitrary keys are
@@ -9610,3 +9611,40 @@ Maps become Objects. Arbitrary keys are encoded to by key->js."
     (if f
       (do (f) :ok)
       :no-test)))
+
+
+(deftype TaggedLiteral [tag form]
+
+  IEquiv
+  (-equiv [this other]
+    (and (instance? TaggedLiteral other)
+         (= tag (.-tag other))
+         (= form (.-form other))))
+
+  IHash
+  (-hash [this]
+    (+ (* 31 (hash tag))
+       (hash form)))
+
+  ILookup
+  (-lookup [this v]
+    (-lookup this v nil))
+  (-lookup [this v not-found]
+    (case v
+      :tag tag
+      :form form
+      not-found))
+
+  )
+
+(defn tagged-literal?
+  "Return true if the value is the data representation of a tagged literal"
+  [value]
+  (instance? cljs.core.TaggedLiteral value))
+
+(defn tagged-literal
+  "Construct a data representation of a tagged literal from a
+  tag symbol and a form."
+  [tag form]
+  {:pre (symbol? tag)}
+  (cljs.core.TaggedLiteral. tag form))

test/cljs/cljs/core_test.cljs

@@ -2793,6 +2793,17 @@
   (is (= (-> #'map meta :arglists)
         '([f] [f coll] [f c1 c2] [f c1 c2 c3] [f c1 c2 c3 & colls]))))
 
+(deftest tagged-literals
+  (let [tl (tagged-literal 'x "y")]
+    (is (tagged-literal? tl))
+    (is (not (tagged-literal? {:tag 'x :form "y"})))
+    (is (= (:tag tl) 'x))
+    (is (= (:form tl) "y"))
+    (is (= tl (tagged-literal 'x "y")))
+    (is (not= tl (tagged-literal 'z "y")))
+    (is (not= tl (tagged-literal 'x "z")))
+    (is (= (hash tl) (hash (tagged-literal 'x "y"))))))
+
 (comment
   ;; ObjMap
   ;; (let [ks (map (partial str "foo") (range 500))