Merge pull request #206 from luontola/optimize-bytecode-amount

Optimize compiled bytecode amount

src/hiccup/compiler.clj

@@ -29,11 +29,30 @@
  (while (.hasNext iterator)
  (callback (.next iterator))))))
 
+(defn- concatenate-strings [coll]
+ (->> coll
+ (partition-by string?)
+ (mapcat (fn [group]
+ (if (string? (first group))
+ [(apply str group)]
+ group)))))
+
 (defmacro build-string [& strs]
- (let [w (gensym)]
- `(let [~w (StringBuilder.)]
- ~@(map (fn [arg] `(.append ~w (or ~arg ""))) strs)
- (.toString ~w))))
+ (let [strs (concatenate-strings strs)
+ w (gensym)]
+ (case (count strs)
+ 0 ""
+ 1 (let [arg (first strs)]
+ (if (string? arg)
+ arg
+ `(String/valueOf (or ~arg ""))))
+ `(let [~w (StringBuilder.)]
+ ~@(map (fn [arg]
+ (if (string? arg)
+ `(.append ~w ~arg)
+ `(.append ~w (or ~arg ""))))
+ strs)
+ (.toString ~w)))))
 
 (defn- render-style-map [value]
  (let [sb (StringBuilder.)]
@@ -316,20 +335,23 @@
  (let [[tag tag-attrs _] (normalize-element-form [tag])
  attrs-sym (gensym "attrs")]
  `(let [~attrs-sym ~attrs]
- (if (map? ~attrs-sym)
- ~(if (container-tag? tag content)
- `(build-string ~(str "<" tag)
- (render-attr-map (merge ~tag-attrs ~attrs-sym)) ">"
- ~@(compile-seq content)
- ~(str "</" tag ">"))
- `(build-string ~(str "<" tag)
- (render-attr-map (merge ~tag-attrs ~attrs-sym))
- ~(end-tag)))
- ~(if (container-tag? tag attrs)
- `(build-string ~(str "<" tag (render-attr-map tag-attrs) ">")
- ~@(compile-seq (cons attrs-sym content))
- ~(str "</" tag ">"))
- (build-string "<" tag (render-attr-map tag-attrs) (end-tag)))))))
+ (build-string
+ (if (map? ~attrs-sym)
+ ~(if (container-tag? tag content)
+ `(build-string ~(str "<" tag)
+ (render-attr-map (merge ~tag-attrs ~attrs-sym))
+ ">")
+ `(build-string ~(str "<" tag)
+ (render-attr-map (merge ~tag-attrs ~attrs-sym))
+ ~(end-tag)))
+ (build-string ~(str "<" tag (render-attr-map tag-attrs) ">")
+ ~@(compile-seq [attrs-sym])))
+ ~@(compile-seq content)
+ ;; ending tag, when the above code did not emit an ending tag
+ ~(if (container-tag? tag content)
+ (str "</" tag ">")
+ `(when-not (map? ~attrs-sym)
+ ~(str "</" tag ">")))))))
 
 (defmethod compile-element :default
  [element]

test/hiccup/compiler_test.clj

@@ -0,0 +1,113 @@
+(ns hiccup.compiler-test
+ (:require [clojure.test :refer :all]
+ [hiccup2.core :refer [html]]))
+
+(deftest test-compile-element-literal-tag
+ ;; `compile-element ::literal-tag` behavior varies based on the following
+ ;; things, so we need to test all their combinations:
+ ;; - mode: xhtml, html, xml, sgml
+ ;; - runtime type of the first child: attributes, content, nil
+ ;; - tag: normal element, void element
+
+ (testing "runtime attributes,"
+ (testing "normal tag"
+ (is (= (str (html {:mode :xhtml} [:p (identity {:id 1})]))
+ "<p id=\"1\"></p>"))
+ (is (= (str (html {:mode :html} [:p (identity {:id 1})]))
+ "<p id=\"1\"></p>"))
+ (is (= (str (html {:mode :xml} [:p (identity {:id 1})]))
+ "<p id=\"1\" />"))
+ (is (= (str (html {:mode :sgml} [:p (identity {:id 1})]))
+ "<p id=\"1\">")))
+ (testing "void tag"
+ (is (= (str (html {:mode :xhtml} [:br (identity {:id 1})]))
+ "<br id=\"1\" />"))
+ (is (= (str (html {:mode :html} [:br (identity {:id 1})]))
+ "<br id=\"1\">"))
+ (is (= (str (html {:mode :xml} [:br (identity {:id 1})]))
+ "<br id=\"1\" />"))
+ (is (= (str (html {:mode :sgml} [:br (identity {:id 1})]))
+ "<br id=\"1\">"))))
+
+ (testing "runtime content,"
+ (testing "normal tag"
+ (is (= (str (html {:mode :xhtml} [:p (identity "x")])) "<p>x</p>"))
+ (is (= (str (html {:mode :html} [:p (identity "x")])) "<p>x</p>"))
+ (is (= (str (html {:mode :xml} [:p (identity "x")])) "<p>x</p>"))
+ (is (= (str (html {:mode :sgml} [:p (identity "x")])) "<p>x</p>")))
+ (testing "void tag"
+ ;; it's not valid HTML to have content inside void elements,
+ ;; but Hiccup should still obey what the user told it to do
+ (is (= (str (html {:mode :xhtml} [:br (identity "x")])) "<br>x</br>"))
+ (is (= (str (html {:mode :html} [:br (identity "x")])) "<br>x</br>"))
+ (is (= (str (html {:mode :xml} [:br (identity "x")])) "<br>x</br>"))
+ (is (= (str (html {:mode :sgml} [:br (identity "x")])) "<br>x</br>"))))
+
+ (testing "runtime nil,"
+ (testing "normal tag"
+ (is (= (str (html {:mode :xhtml} [:p (identity nil)])) "<p></p>"))
+ (is (= (str (html {:mode :html} [:p (identity nil)])) "<p></p>"))
+ (is (= (str (html {:mode :xml} [:p (identity nil)])) "<p></p>"))
+ (is (= (str (html {:mode :sgml} [:p (identity nil)])) "<p></p>")))
+ (testing "void tag"
+ ;; TODO: this might not be desired behavior (use case: the user has
+ ;; a function which returns a map of attributes or nil)
+ (is (= (str (html {:mode :xhtml} [:br (identity nil)])) "<br></br>"))
+ (is (= (str (html {:mode :html} [:br (identity nil)])) "<br></br>"))
+ (is (= (str (html {:mode :xml} [:br (identity nil)])) "<br></br>"))
+ (is (= (str (html {:mode :sgml} [:br (identity nil)])) "<br></br>")))))
+
+(deftest test-compile-element-default
+ (testing "runtime tag"
+ (is (= (str (html {:mode :xhtml} [(identity :p)])) "<p></p>"))
+ (is (= (str (html {:mode :html} [(identity :p)])) "<p></p>"))
+ (is (= (str (html {:mode :xml} [(identity :p)])) "<p />"))
+ (is (= (str (html {:mode :sgml} [(identity :p)])) "<p>")))
+
+ (testing "runtime tag with attributes"
+ (is (= (str (html {:mode :xhtml} [(identity :p) {:id 1}]))
+ (str (html {:mode :xhtml} [(identity :p) (identity {:id 1})]))
+ "<p id=\"1\"></p>"))
+ (is (= (str (html {:mode :html} [(identity :p) {:id 1}]))
+ (str (html {:mode :html} [(identity :p) (identity {:id 1})]))
+ "<p id=\"1\"></p>"))
+ (is (= (str (html {:mode :xml} [(identity :p) {:id 1}]))
+ (str (html {:mode :xml} [(identity :p) (identity {:id 1})]))
+ "<p id=\"1\" />"))
+ (is (= (str (html {:mode :sgml} [(identity :p) {:id 1}]))
+ (str (html {:mode :sgml} [(identity :p) (identity {:id 1})]))
+ "<p id=\"1\">")))
+
+ (testing "runtime tag with text content"
+ (is (= (str (html {:mode :xhtml} [(identity :p) "x"]))
+ (str (html {:mode :xhtml} [(identity :p) (identity "x")]))
+ "<p>x</p>"))
+ (is (= (str (html {:mode :html} [(identity :p) "x"]))
+ (str (html {:mode :html} [(identity :p) (identity "x")]))
+ "<p>x</p>"))
+ (is (= (str (html {:mode :xml} [(identity :p) "x"]))
+ (str (html {:mode :xml} [(identity :p) (identity "x")]))
+ "<p>x</p>"))
+ (is (= (str (html {:mode :sgml} [(identity :p) "x"]))
+ (str (html {:mode :sgml} [(identity :p) (identity "x")]))
+ "<p>x</p>")))
+
+ (testing "runtime tag with child elements"
+ ;; FIXME: this should return "<p><span>x</span></p>"
+ (is (= (str (html {:mode :xhtml} [(identity :p) [:span "x"]]))
+ "<p>&lt;span&gt;x&lt;/span&gt;</p>"))
+ (is (= (str (html {:mode :html} [(identity :p) [:span "x"]]))
+ "<p>&lt;span&gt;x&lt;/span&gt;</p>"))
+ (is (= (str (html {:mode :xml} [(identity :p) [:span "x"]]))
+ "<p>&lt;span&gt;x&lt;/span&gt;</p>"))
+ (is (= (str (html {:mode :sgml} [(identity :p) [:span "x"]]))
+ "<p>&lt;span&gt;x&lt;/span&gt;</p>"))
+
+ (is (= (str (html {:mode :xhtml} [(identity :p) (identity [:span "x"])]))
+ "<p><span>x</span></p>"))
+ (is (= (str (html {:mode :html} [(identity :p) (identity [:span "x"])]))
+ "<p><span>x</span></p>"))
+ (is (= (str (html {:mode :xml} [(identity :p) (identity [:span "x"])]))
+ "<p><span>x</span></p>"))
+ (is (= (str (html {:mode :sgml} [(identity :p) (identity [:span "x"])]))
+ "<p><span>x</span></p>"))))

test/hiccup2/optimizations_test.clj

@@ -0,0 +1,78 @@
+(ns hiccup2.optimizations-test
+ (:require [clojure.test :refer :all]
+ [clojure.walk :as walk]
+ [hiccup2.core :as h]))
+
+(defn- count-forms [data]
+ (count (filter seq? (tree-seq coll? seq data))))
+
+(deftest method-code-size
+ ;; With Hiccup 2.0.0-RC2, it was easy to cause the hiccup2.core/html macro to
+ ;; generate so much bytecode that it would go over the 64KB limit of how much
+ ;; bytecode one Java method may contain. It would crash the Clojure compiler
+ ;; with a "Method code too large!" exception. These are a regression tests for
+ ;; that. See https://github.com/weavejester/hiccup/issues/205
+
+ (testing "static elements should be concatenated to one string, also when they have dynamic sibling elements"
+ (let [baseline (walk/macroexpand-all
+ `(h/html [:div
+ [:p]
+ (identity nil)
+ [:p]]))
+ pathological (walk/macroexpand-all
+ `(h/html [:div
+ [:p] [:p] [:p] [:p] [:p]
+ (identity nil)
+ [:p] [:p] [:p] [:p] [:p]]))]
+ (is (= (count-forms baseline)
+ (count-forms pathological)))))
+
+ (testing "code size should grow O(n), instead of O(n^2), as more dynamic first-child elements are added"
+ (let [example-0 (walk/macroexpand-all
+ `(h/html [:div
+ [:div
+ [:div
+ [:div
+ [:div]]]]]))
+ example-1 (walk/macroexpand-all
+ `(h/html [:div (identity nil)
+ [:div
+ [:div
+ [:div
+ [:div]]]]]))
+ example-2 (walk/macroexpand-all
+ `(h/html [:div (identity nil)
+ [:div (identity nil)
+ [:div
+ [:div
+ [:div]]]]]))
+ example-3 (walk/macroexpand-all
+ `(h/html [:div (identity nil)
+ [:div (identity nil)
+ [:div (identity nil)
+ [:div
+ [:div]]]]]))
+ example-4 (walk/macroexpand-all
+ `(h/html [:div (identity nil)
+ [:div (identity nil)
+ [:div (identity nil)
+ [:div (identity nil)
+ [:div]]]]]))
+ example-5 (walk/macroexpand-all
+ `(h/html [:div (identity nil)
+ [:div (identity nil)
+ [:div (identity nil)
+ [:div (identity nil)
+ [:div (identity nil)]]]]]))
+ examples [example-0
+ example-1
+ example-2
+ example-3
+ example-4
+ example-5]
+ diffs (->> examples
+ (map count-forms)
+ (partition 2 1)
+ (map (fn [[a b]] (- b a))))]
+ (is (< (apply max diffs)
+ (* 1.1 (apply min diffs)))))))