Auto transient (#743)

Author: borkdude

src/squint/compiler.cljc

@@ -297,7 +297,7 @@
         (let [expr (list* 'doto {} (map (fn [[k v]]
                                           (list 'clojure.core/unchecked-set k v)) expr))]
           (emit expr env)))
-      (cc/tagged-expr 'object)))
+      (cc/tagged-expr 'object true)))
 
 (defn emit-set [expr env]
   (emit-return

src/squint/compiler_common.cljc

@@ -57,17 +57,23 @@
             s)
     s))
 
-(defrecord Code [js bool]
+(defrecord Code [js tag transient]
   Object
   (toString [_] js))
 
-(defn tagged-expr [js tag]
-  (map->Code {:js js
-              :tag tag}))
+(defn tagged-expr
+  ([js tag]
+   (map->Code {:js js
+               :tag tag}))
+  ([js tag transient]
+   (map->Code {:js js
+               :tag tag
+               :transient transient})))
 
 (defmethod emit-special 'js* [_ env [_js* template & args :as expr]]
   (let [mexpr (meta expr)
         tag (:tag mexpr)
+        transient (:transient mexpr)
         template (str template)]
     (cond->
         (-> (reduce (fn [template substitution]
@@ -76,7 +82,7 @@
                     template
                     args)
             (emit-return (merge env (meta expr))))
-      tag (tagged-expr tag))))
+      tag (tagged-expr tag transient))))
 
 (defn expr-env [env]
   (assoc env :context :expr :top-level false))
@@ -380,13 +386,14 @@
         lctx (if iife? :return ctx)
         res (emit l (assoc env :context lctx))
         tag (:tag res)
+        transient (:transient res)
         res (cond-> res
               (= :return ctx) (statement))
         s (cond-> (str exprs res)
             iife?
             (wrap-implicit-iife env))]
     (cond-> s
-      tag (tagged-expr tag))))
+      tag (tagged-expr tag transient))))
 
 (defmethod emit-special 'do [_type env [_ & exprs]]
   (emit-do env exprs))
@@ -414,7 +421,8 @@
                           (-> var->ident
                               (assoc var-name
                                      (cond-> renamed
-                                       tag (vary-meta assoc :tag tag))))]
+                                       tag
+                                       (vary-meta assoc :tag tag))))]
                       [(str acc expr) var->ident]))
                   ["" upper-var->ident]
                   partitioned))
@@ -425,7 +433,8 @@
                (emit-do (if iife?
                           (assoc enc-env :context :return)
                           enc-env) body))
-        tag (:tag body)]
+        tag (:tag body)
+        transient (:transient body)]
     (cond-> (str
              bindings
              (when loop?
@@ -440,7 +449,7 @@
       (wrap-implicit-iife env)
       iife?
       (emit-return enc-env)
-      tag (tagged-expr tag))))
+      tag (tagged-expr tag transient))))
 
 (defmethod emit-special 'let* [_type enc-env [_let bindings & body]]
   (emit-let enc-env bindings body false))
@@ -1027,7 +1036,8 @@ break;}" body)
         cherry+interop? (and
                          cherry?
                          (= "js" ns))
-        tag (:tag (meta expr))]
+        tag (:tag (meta expr))
+        transient (:transient (meta expr))]
     (cond-> (emit-return (str
                          (emit fname (expr-env env))
                          ;; this is needed when calling keywords, symbols, etc. We could
@@ -1043,7 +1053,7 @@ break;}" body)
                                                     args)
                                                   args))))
                          env)
-      tag (tagged-expr tag))))
+      tag (tagged-expr tag transient))))
 
 (defmethod emit-special 'letfn* [_ env [_ form & body]]
   (let [gensym (:gensym env)

src/squint/internal/macros.cljc

@@ -668,7 +668,9 @@
       {:tag 'string})))
 
 (core/defmacro assoc-inline [x & xs]
-  (assert (even? (count xs)) "assoc! must be called with and object and an even amount of arguments")
+  (assert (and (even? (count xs))
+               (seq xs))
+          "assoc! must be called with and object and an even + positive amount of arguments")
   (if (and (= 'assoc (first &form))
            (let [snd (second &form)]
              (and (seq? snd)
@@ -683,28 +685,36 @@
           emitted (emit x (assoc &env :context :expr))
           tag (or (:tag emitted)
                   (:tag (meta x)))
+          transient (:transient emitted)
           x (with-meta (list 'js* (str emitted))
-              {:tag tag})]
+              {:tag tag
+               :transient transient})]
       (if (= 'object tag)
-        (with-meta
-          (list* 'js* (str "({...~{},"
-                           (str/join ","
-                                     (repeat (/ (count xs) 2) "~{}:~{}"))
-                           "})")
-                 x xs)
-          {:tag 'object})
+        (if transient
+          `(assoc! ~x ~@xs)
+          (with-meta
+            (list* 'js* (str "({...~{},"
+                             (str/join ","
+                                       (repeat (/ (count xs) 2) "~{}:~{}"))
+                             "})")
+                   x xs)
+            {:tag 'object
+             :transient true}))
         (let [[fn _ & tail] &form]
           (with-meta
             (list* fn x tail)
             (assoc (meta &form)
                    :squint.compiler/skip-macro true)))))))
 
 (core/defmacro assoc!-inline [x & xs]
-  (assert (even? (count xs)) "assoc! must be called with and object and an even amount of arguments")
+  (assert (and (even? (count xs))
+               (seq xs))
+          "assoc! must be called with and object and an even + positive amount of arguments")
   (let [emit (-> &env :utils :emit)
         emitted (emit x (assoc &env :context :expr))
         tag (or (:tag emitted)
                 (:tag (meta x)))
+        transient (:transient emitted)
         x* x
         x (with-meta (list 'js* (str emitted))
             {:tag tag})]
@@ -713,10 +723,10 @@
         (let [obj-sym (with-meta (gensym)
                         {:tag tag})]
           (with-meta `(^:=> (fn [~obj-sym]
-                         (assoc! ~obj-sym ~@xs)) ~x)
+                              (assoc! ~obj-sym ~@xs)) ~x)
             ;; TODO: we shouldn't have to add a tag here with function return
             ;; tag inference, which isn't yet available, but within reach
-            {:tag tag}))
+            {:tag tag :transient transient}))
         (with-meta
           (list* 'js* (str "("
                            (str/join "," (repeat (/ (count xs) 2) "~{}"))
@@ -727,7 +737,7 @@
                          `(aset ~x ~k ~v))
                        (partition 2 xs))
                   [x]))
-          {:tag 'object}))
+          {:tag 'object :transient transient}))
       (let [[fn _ & tail] &form]
         (with-meta
           (list* fn x tail)

test/squint/compiler_test.cljs

@@ -2676,11 +2676,40 @@ new Foo();")
     (let [s (jss! "(get {:a 1} :a)")]
       (is (str/includes? s "[\"a\"]")))
     (testing "nested assoc"
-      (let [s (jss! '(-> (assoc {} :a :b)
-                         (assoc :c :d)))]
+      (let [s (jss! '((fn [^object x]
+                        (-> (assoc x :a :b)
+                            (assoc :c :d))) {}))]
         (is (= 1 (count (re-seq #"\.\.\." s))))
         (is (not (str/includes? s "assoc")))
-        (is (eq {:a :b :c :d} (js/eval s)))))))
+        (is (eq {:a :b :c :d} (js/eval s))))
+      (let [s (jss! '(let [x {:a 1}]
+                       (assoc (-> (assoc x :b 2) (assoc :c :d)) :e :f)))]
+        (is (= 1 (count (re-seq #"\.\.\." s))))
+        (is (not (str/includes? s "assoc")))
+        (is (str/includes? s "[\"e\"] = \"f\""))
+        (is (eq {:a 1 :b 2 :c :d :e :f} (js/eval s))))
+      (let [s (jss! '(assoc (let [x 1 o {}] (assoc o :x x)) :b 2))]
+        (is (= 1 (count (re-seq #"\.\.\." s))))
+        (is (not (str/includes? s "assoc")))
+        (is (str/includes? s "[\"b\"] = 2"))
+        (is (eq {:x 1 :b 2} (js/eval s))))
+      (testing "auto-transient"
+        (let [s (jss! '(assoc {:a 1} :b 2))]
+          (is (not (str/includes? s "assoc")))
+          (is (not (str/includes? s "...")))
+          (is (str/includes? s "[\"b\"] = 2")))
+        (let [s (jss! '(assoc (assoc! {} :a 1) :b 2))]
+          (is (not (str/includes? s "assoc")))
+          (is (not (str/includes? s "...")))
+          (is (str/includes? s "[\"a\"] = 1"))
+          (is (str/includes? s "[\"b\"] = 2")))
+        (let [s (jss! '(let [x {}]
+                         (assoc (assoc! x :a 1) :b 2)))]
+          (is (not (str/includes? s "assoc")))
+          (testing "assoc! mutates and potentially returns shared object"
+            (is (str/includes? s "...")))
+          (is (str/includes? s "[\"a\"] = 1"))
+          (is (not (str/includes? s "[\"b\"] = 2"))))))))
 
 (defn init []
   (t/run-tests 'squint.compiler-test 'squint.jsx-test 'squint.string-test 'squint.html-test))