From 00ddf9996eca193606763a071334bfa1fcc0fd20 Mon Sep 17 00:00:00 2001 From: Esko Luontola Date: Tue, 28 Nov 2023 20:31:51 +0200 Subject: [PATCH] Optimize to generate less bytecode It was possible for the macros to generate so much bytecode that they would exceed Java's 64KB limit for method code size. In such situations the Clojure compiler would fail with the message "Method code too large!" See https://github.com/weavejester/hiccup/issues/205 This commit does the following optimizations: 1. Concatenate string literals at compile time, so that we can replace multiple StringBuilder.append() calls with just one. This reduces the generated code from O(n) to O(1). This also improves performance by 10-20%, since copying one long string is faster than many short strings. 2. When a runtime check is needed to determine whether a value is the element's attribute map or its first child element, avoid duplicating the code for the element's content. This reduces the generated code from O(n^2) to O(n). While improving the test coverage, some edge cases of generating bad HTML were detected. This commit doesn't change the existing behavior, but only documents it in the new tests. Fixing that behavior will be done in future commits. --- src/hiccup/compiler.clj | 58 +++++++++----- test/hiccup/compiler_test.clj | 113 ++++++++++++++++++++++++++++ test/hiccup2/optimizations_test.clj | 78 +++++++++++++++++++ 3 files changed, 231 insertions(+), 18 deletions(-) create mode 100644 test/hiccup/compiler_test.clj create mode 100644 test/hiccup2/optimizations_test.clj diff --git a/src/hiccup/compiler.clj b/src/hiccup/compiler.clj index b30e8ac..ef06242 100644 --- a/src/hiccup/compiler.clj +++ b/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 "")) - `(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 "")) - (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 "") + `(when-not (map? ~attrs-sym) + ~(str ""))))))) (defmethod compile-element :default [element] diff --git a/test/hiccup/compiler_test.clj b/test/hiccup/compiler_test.clj new file mode 100644 index 0000000..552e219 --- /dev/null +++ b/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})])) + "

")) + (is (= (str (html {:mode :html} [:p (identity {:id 1})])) + "

")) + (is (= (str (html {:mode :xml} [:p (identity {:id 1})])) + "

")) + (is (= (str (html {:mode :sgml} [:p (identity {:id 1})])) + "

"))) + (testing "void tag" + (is (= (str (html {:mode :xhtml} [:br (identity {:id 1})])) + "
")) + (is (= (str (html {:mode :html} [:br (identity {:id 1})])) + "
")) + (is (= (str (html {:mode :xml} [:br (identity {:id 1})])) + "
")) + (is (= (str (html {:mode :sgml} [:br (identity {:id 1})])) + "
")))) + + (testing "runtime content," + (testing "normal tag" + (is (= (str (html {:mode :xhtml} [:p (identity "x")])) "

x

")) + (is (= (str (html {:mode :html} [:p (identity "x")])) "

x

")) + (is (= (str (html {:mode :xml} [:p (identity "x")])) "

x

")) + (is (= (str (html {:mode :sgml} [:p (identity "x")])) "

x

"))) + (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")])) "
x
")) + (is (= (str (html {:mode :html} [:br (identity "x")])) "
x
")) + (is (= (str (html {:mode :xml} [:br (identity "x")])) "
x
")) + (is (= (str (html {:mode :sgml} [:br (identity "x")])) "
x
")))) + + (testing "runtime nil," + (testing "normal tag" + (is (= (str (html {:mode :xhtml} [:p (identity nil)])) "

")) + (is (= (str (html {:mode :html} [:p (identity nil)])) "

")) + (is (= (str (html {:mode :xml} [:p (identity nil)])) "

")) + (is (= (str (html {:mode :sgml} [:p (identity nil)])) "

"))) + (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)])) "

")) + (is (= (str (html {:mode :html} [:br (identity nil)])) "

")) + (is (= (str (html {:mode :xml} [:br (identity nil)])) "

")) + (is (= (str (html {:mode :sgml} [:br (identity nil)])) "

"))))) + +(deftest test-compile-element-default + (testing "runtime tag" + (is (= (str (html {:mode :xhtml} [(identity :p)])) "

")) + (is (= (str (html {:mode :html} [(identity :p)])) "

")) + (is (= (str (html {:mode :xml} [(identity :p)])) "

")) + (is (= (str (html {:mode :sgml} [(identity :p)])) "

"))) + + (testing "runtime tag with attributes" + (is (= (str (html {:mode :xhtml} [(identity :p) {:id 1}])) + (str (html {:mode :xhtml} [(identity :p) (identity {:id 1})])) + "

")) + (is (= (str (html {:mode :html} [(identity :p) {:id 1}])) + (str (html {:mode :html} [(identity :p) (identity {:id 1})])) + "

")) + (is (= (str (html {:mode :xml} [(identity :p) {:id 1}])) + (str (html {:mode :xml} [(identity :p) (identity {:id 1})])) + "

")) + (is (= (str (html {:mode :sgml} [(identity :p) {:id 1}])) + (str (html {:mode :sgml} [(identity :p) (identity {:id 1})])) + "

"))) + + (testing "runtime tag with text content" + (is (= (str (html {:mode :xhtml} [(identity :p) "x"])) + (str (html {:mode :xhtml} [(identity :p) (identity "x")])) + "

x

")) + (is (= (str (html {:mode :html} [(identity :p) "x"])) + (str (html {:mode :html} [(identity :p) (identity "x")])) + "

x

")) + (is (= (str (html {:mode :xml} [(identity :p) "x"])) + (str (html {:mode :xml} [(identity :p) (identity "x")])) + "

x

")) + (is (= (str (html {:mode :sgml} [(identity :p) "x"])) + (str (html {:mode :sgml} [(identity :p) (identity "x")])) + "

x

"))) + + (testing "runtime tag with child elements" + ;; FIXME: this should return "

x

" + (is (= (str (html {:mode :xhtml} [(identity :p) [:span "x"]])) + "

<span>x</span>

")) + (is (= (str (html {:mode :html} [(identity :p) [:span "x"]])) + "

<span>x</span>

")) + (is (= (str (html {:mode :xml} [(identity :p) [:span "x"]])) + "

<span>x</span>

")) + (is (= (str (html {:mode :sgml} [(identity :p) [:span "x"]])) + "

<span>x</span>

")) + + (is (= (str (html {:mode :xhtml} [(identity :p) (identity [:span "x"])])) + "

x

")) + (is (= (str (html {:mode :html} [(identity :p) (identity [:span "x"])])) + "

x

")) + (is (= (str (html {:mode :xml} [(identity :p) (identity [:span "x"])])) + "

x

")) + (is (= (str (html {:mode :sgml} [(identity :p) (identity [:span "x"])])) + "

x

")))) diff --git a/test/hiccup2/optimizations_test.clj b/test/hiccup2/optimizations_test.clj new file mode 100644 index 0000000..44fef99 --- /dev/null +++ b/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)))))))