feat: max-let-bindings var

Author: erdos

src/uclj/core.clj

@@ -29,7 +29,7 @@
 
 (run! require namespaces-to-require)
 
-(def ^:private ^:dynamic *template-vars* {})
+(def ^:dynamic *template-vars* {})
 (defn- template* [bindings expr]
   (assert (vector? bindings))
   (letfn [(unroll [expr] (cond (seq? expr) (unroll-seq expr)
@@ -401,25 +401,36 @@
                                           [arity (->eval-node iden->idx recur-indices (list* 'do bodies))]))]
     (make-fn-body fname symbol-used arity->body-node arity->symbols-introduced iden->idx vararg-arity)))
 
+(def ^:const max-let-bindings 32)
+
 (defmethod seq->eval-node 'let* seq-eval-let [iden->idx recur-indices [_ bindings & bodies :as form]]
   (cond
     ;; can merge (let*) forms
-    (and (= 1 (count bodies)) (seq? (first bodies)) (= 'let* (ffirst bodies)))
+    (and (= 1 (count bodies))
+         (< (count bindings) (* 2 max-let-bindings))
+         (seq? (first bodies)) (= 'let* (ffirst bodies)))
     (recur iden->idx recur-indices (list* 'let*
-                                           (into bindings (second (first bodies)))
-                                           (nnext (first bodies))))
-
+                                          (into bindings (second (first bodies)))
+                                          (nnext (first bodies))))
+    ;; it must have at most max-let-bindings binding vars
+    (> (count bindings) (* 2 max-let-bindings))
+    (recur iden->idx recur-indices
+           (list 'let*
+                 (vec (take (* 2 max-let-bindings) bindings))
+                 (list* 'let*
+                        (vec (drop (* 2 max-let-bindings) bindings))
+                        bodies)))
     :else
-    (template [idx-symbols  (mapv #(symbol (str 'idx- %)) (range 20))
-               node-symbols (mapv #(symbol (str 'node- %)) (range 20))]
+    (template [idx-symbols  (mapv #(symbol (str 'idx- %)) (range max-let-bindings))
+               node-symbols (mapv #(symbol (str 'node- %)) (range max-let-bindings))]
       (let [[~@(map vector idx-symbols node-symbols)]
             (for [[k v] (partition 2 bindings)]
               [(int (iden->idx (::symbol-identity (meta k))))
               (->eval-node iden->idx nil v)])
             body-node (seq->eval-node iden->idx recur-indices (list* 'do bodies))]
         (case (count bindings)
           ~@(mapcat seq
-                    (for [i (range 20)]
+                    (for [i (range (inc max-let-bindings))]
                       [(* 2 i)
                         `(gen-eval-node
                           (do ~@(for [i (range i)]

test/uclj/core_test.clj

@@ -19,7 +19,14 @@
     (is (fn? (evaluator '(let [b :lol] (fn [] (let [_ b] :hi)))))))
 
   (testing "Shadow lexical bindings"
-    (is (= 4 (evaluator '(let [inc dec] (inc 5)))))))
+    (is (= 4 (evaluator '(let [inc dec] (inc 5))))))
+
+  (testing "let forms with many bindings"
+    (template [varnames (repeatedly gensym)]
+       (do ~@(for [i (range 0 100 5)]
+               `(is (= (reduce + (range ~i))
+                       (evaluator '(let [~@(interleave varnames (range i))]
+                                     (+ ~@(take i varnames)))))))))))
 
 (deftest test-eval-try
   (testing "try-catch maintains sybol usage across closure"
@@ -145,8 +152,8 @@
                    (evaluator '(loop [i 2] (case (recur (dec i)) 1 1 2 2 :three)))))))
 
   (testing "used vars in case are correctly encapsulated in closure"
-    (is (= :ok 
-          (evaluator '(let [a :ok b :w1 c :w2] ((fn [t] (case t, 1 a, 2 b, c)) 1))))))
+    (is (= :ok
+           (evaluator '(let [a :ok b :w1 c :w2] ((fn [t] (case t, 1 a, 2 b, c)) 1))))))
 
   (testing "Identity checking because all cases are keywords"
     (testing "All keys have different hashes"