Skip to content

Commit 15f330f

Browse files
authored
CLJS-3309 (#96)
The `and/or` optimization removes the intermediate let, however the child expressions will still have the local in their environments, and more importantly anon fns in loops will have captured the local in the `:loop-lets` AST field. We add a pass that removes the local as well as loop-lets. Add compile and runtime tests based on cases from the ticket.
1 parent 8ef4bd2 commit 15f330f

File tree

4 files changed

+130
-17
lines changed

4 files changed

+130
-17
lines changed
+32
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
;; Copyright (c) Rich Hickey. All rights reserved.
2+
;; The use and distribution terms for this software are covered by the
3+
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
4+
;; which can be found in the file epl-v10.html at the root of this distribution.
5+
;; By using this software in any fashion, you are agreeing to be bound by
6+
;; the terms of this license.
7+
;; You must not remove this notice, or any other, from this software.
8+
9+
(ns cljs.analyzer.passes)
10+
11+
(defn apply-passes
12+
([ast passes]
13+
(apply-passes ast passes nil))
14+
([ast passes opts]
15+
(reduce
16+
(fn [ast pass]
17+
(pass (:env ast) ast opts))
18+
ast passes)))
19+
20+
(defn walk
21+
([ast passes]
22+
(walk ast passes nil))
23+
([ast passes opts]
24+
(reduce
25+
(fn [ast child-k]
26+
(assoc ast
27+
child-k
28+
(let [child (get ast child-k)]
29+
(if (vector? child)
30+
(into [] (map #(walk % passes opts)) child)
31+
(walk child passes)))))
32+
(some-> ast (apply-passes passes opts)) (:children ast))))

src/main/cljs/cljs/analyzer/passes/and_or.cljc

+38-17
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,8 @@
66
;; the terms of this license.
77
;; You must not remove this notice, or any other, from this software.
88

9-
(ns cljs.analyzer.passes.and-or)
9+
(ns cljs.analyzer.passes.and-or
10+
(:require [cljs.analyzer.passes :as passes]))
1011

1112
(def simple-ops
1213
#{:var :js-var :local :invoke :const :host-field :host-call :js :quote})
@@ -70,25 +71,45 @@
7071
(and (simple-or? ast)
7172
(simple-test-expr? (-> ast :body :ret :else))))
7273

74+
(defn remove-loop-let [fn-ast local]
75+
(update fn-ast :loop-lets
76+
(fn [loop-lets]
77+
(map
78+
(fn [m]
79+
(update m :params
80+
(fn [xs] (remove #(= local (:name %)) xs))))
81+
loop-lets))))
82+
83+
(defn remove-local-pass [local]
84+
(fn [env ast opts]
85+
(cond-> (update-in ast [:env :locals] dissoc local)
86+
(= :fn (:op ast)) (remove-loop-let local))))
87+
7388
(defn optimize-and [ast]
74-
{:op :js
75-
:env (:env ast)
76-
:segs ["((" ") && (" "))"]
77-
:args [(-> ast :bindings first :init)
78-
(->expr-env (-> ast :body :ret :then))]
79-
:form (:form ast)
80-
:children [:args]
81-
:tag 'boolean})
89+
(let [{:keys [init name]} (-> ast :bindings first)]
90+
{:op :js
91+
:env (:env ast)
92+
:segs ["((" ") && (" "))"]
93+
:args [init
94+
(passes/walk
95+
(->expr-env (-> ast :body :ret :then))
96+
[(remove-local-pass name)])]
97+
:form (:form ast)
98+
:children [:args]
99+
:tag 'boolean}))
82100

83101
(defn optimize-or [ast]
84-
{:op :js
85-
:env (:env ast)
86-
:segs ["((" ") || (" "))"]
87-
:args [(-> ast :bindings first :init)
88-
(->expr-env (-> ast :body :ret :else))]
89-
:form (:form ast)
90-
:children [:args]
91-
:tag 'boolean})
102+
(let [{:keys [init name]} (-> ast :bindings first)]
103+
{:op :js
104+
:env (:env ast)
105+
:segs ["((" ") || (" "))"]
106+
:args [init
107+
(passes/walk
108+
(->expr-env (-> ast :body :ret :else))
109+
[(remove-local-pass name)])]
110+
:form (:form ast)
111+
:children [:args]
112+
:tag 'boolean}))
92113

93114
(defn optimize [env ast _]
94115
(cond

src/test/cljs/cljs/core_test.cljs

+12
Original file line numberDiff line numberDiff line change
@@ -1854,3 +1854,15 @@
18541854
(is (false? (contains? sv :kw))))
18551855
(let [sv (subvec [0 1 2 3 4] 2 2)]
18561856
(is (false? (contains? sv 0)))))
1857+
1858+
(deftest test-cljs-3309
1859+
(is (= :ok
1860+
(loop [x 4]
1861+
(if (or (< x 4) (not-any? (fn [y] x) [1]))
1862+
(recur 5)
1863+
:ok))))
1864+
(is (= '([])
1865+
((fn [s]
1866+
(for [e s :when (and (sequential? e) (every? (fn [x] x) e))]
1867+
e))
1868+
[[]]))))

src/test/clojure/cljs/analyzer_pass_tests.clj

+48
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88

99
(ns cljs.analyzer-pass-tests
1010
(:require [cljs.analyzer :as ana]
11+
[cljs.analyzer.passes :as passes]
1112
[cljs.analyzer.passes.and-or :as and-or]
1213
[cljs.analyzer-tests :as ana-tests :refer [analyze]]
1314
[cljs.compiler :as comp]
@@ -16,6 +17,33 @@
1617
[clojure.string :as string]
1718
[clojure.test :as test :refer [deftest is testing]]))
1819

20+
(deftest test-walk
21+
(testing "walking visits every node"
22+
(let [expr-env (assoc (ana/empty-env) :context :expr)
23+
ast (->> `(and true false)
24+
(analyze expr-env))
25+
ast' (passes/walk ast [(fn [_ ast _] (dissoc ast :env))])]
26+
(is (not (contains? ast' :env)))
27+
(is (not (some #(contains? % :env) (:args ast')))))))
28+
29+
(deftest remove-local
30+
(testing "and/or remove local pass"
31+
(let [ast {:op :fn
32+
:env '{:locals {x {}}}
33+
:loop-lets '[{:params [{:name x}]}]}
34+
pass (and-or/remove-local-pass 'x)
35+
ast' (passes/apply-passes ast [pass])]
36+
(is (contains? (-> ast :env :locals) 'x))
37+
(is (not (contains? (-> ast' :env :locals) 'x)))
38+
(is (some
39+
(fn [{:keys [params]}]
40+
(some #(= 'x (:name %)) params))
41+
(:loop-lets ast)))
42+
(is (not (some
43+
(fn [{:keys [params]}]
44+
(some #(= 'x (:name %)) params))
45+
(:loop-lets ast')))))))
46+
1947
(deftest test-and-or-code-gen-pass
2048
(testing "and/or optimization code gen pass"
2149
(let [expr-env (assoc (ana/empty-env) :context :expr)
@@ -110,6 +138,26 @@
110138
(and (even? 1) false))]))))]
111139
(is (= 1 (count (re-seq #"&&" code)))))))
112140

141+
(deftest test-cljs-3309
142+
(testing "CLJS-3309: and/or optimization removes discarded local and loop-lets"
143+
(let [code (env/with-compiler-env (env/default-compiler-env)
144+
(comp/with-core-cljs {}
145+
(fn []
146+
(compile-form-seq
147+
'[(loop [x 4]
148+
(when (or (< x 4) (not-any? (fn [y] x) [1]))
149+
(recur 5)))]))))]
150+
(is (empty? (re-seq #"or_" code))))
151+
(let [code (env/with-compiler-env (env/default-compiler-env)
152+
(comp/with-core-cljs {}
153+
(fn []
154+
(compile-form-seq
155+
'[((fn [s]
156+
(for [e s :when (and (sequential? e) (every? (fn [x] x) e))]
157+
e))
158+
[[]])]))))]
159+
(is (empty? (re-seq #"and_" code))))))
160+
113161
(comment
114162
(test/run-tests)
115163

0 commit comments

Comments
 (0)