Memoized SYMBOL-NAME-TO-JS-STRING (performance improvement).

diff --git a/src/utils.lisp b/src/utils.lisp
index 6c4a8c6..37e996b 100644 (file)
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -20,45 +20,49 @@
       (when keep-separators (push (string (char string i)) res))
       (setf last (1+ i)))))
 
-(defun symbol-name-to-js-string (symbol)
-  "Given a Lisp symbol or string, produces to a valid JavaScript
+(let ((cache (make-hash-table :test 'eq)))
+  (defun symbol-name-to-js-string (symbol)
+    "Given a Lisp symbol or string, produces to a valid JavaScript
 identifier by following transformation heuristics case conversion. For
 example, paren-script becomes parenScript, *some-global* becomes
 SOMEGLOBAL."
-  (let ((sym-name (symbol-name symbol))
-        (no-case-conversion nil)
-        (lowercase t)
-        (all-uppercase nil))
-    (when (and (not (eq symbol '[])) ;; HACK
-               (find-if (lambda (x) (find x '(#\. #\[ #\]))) sym-name))
-      (warn "Symbol ~A contains one of '.[]' - this compound naming convention is no longer supported by Parenscript!"
-            symbol))
-    (acond ((nth-value 1 (cl-ppcre:scan-to-strings "[\\*|\\+](.*)[\\*|\\+](.*)" sym-name :sharedp t))
-            (setf all-uppercase t
-                  sym-name (concatenate 'string (aref it 0) (aref it 1))))
-           ((and (> (length sym-name) 1)
-                 (or (eql (char sym-name 0) #\+)
-                     (eql (char sym-name 0) #\*)))
-            (setf lowercase nil
-                  sym-name (subseq sym-name 1)))
-           ((and (> (length sym-name) 1)
-                 (char= #\: (char sym-name 0)))
-            (setf no-case-conversion t
-                  sym-name (subseq sym-name 1))))
-    (with-output-to-string (acc)
-      (loop for c across sym-name
-         do (acond ((eql c #\-)
-                    (setf lowercase (not lowercase)))
-                   ((position c "!?#@%+*/=:")
-                    (write-sequence (aref #("bang" "what" "hash" "at" "percent"
-                                            "plus" "star" "slash" "equals" "colon")
-                                          it)
-                                    acc))
-                   (t (write-char (cond (no-case-conversion c)
-                                        ((and lowercase (not all-uppercase)) (char-downcase c))
-                                        (t (char-upcase c)))
-                                  acc)
-                      (setf lowercase t)))))))
+    (or (gethash symbol cache)
+        (setf (gethash symbol cache)
+              (let ((sym-name (symbol-name symbol))
+                    (no-case-conversion nil)
+                    (lowercase t)
+                    (all-uppercase nil))
+                (when (and (not (eq symbol '[])) ;; HACK
+                           (find-if (lambda (x) (find x '(#\. #\[ #\]))) sym-name))
+                  (warn "Symbol ~A contains one of '.[]' - this compound naming convention is no longer supported by Parenscript!"
+                        symbol))
+                (acond ((nth-value 1 (cl-ppcre:scan-to-strings "[\\*|\\+](.*)[\\*|\\+](.*)"
+                                                               sym-name :sharedp t))
+                        (setf all-uppercase t
+                              sym-name (concatenate 'string (aref it 0) (aref it 1))))
+                       ((and (> (length sym-name) 1)
+                             (or (eql (char sym-name 0) #\+)
+                                 (eql (char sym-name 0) #\*)))
+                        (setf lowercase nil
+                              sym-name (subseq sym-name 1)))
+                       ((and (> (length sym-name) 1)
+                             (char= #\: (char sym-name 0)))
+                        (setf no-case-conversion t
+                              sym-name (subseq sym-name 1))))
+                (with-output-to-string (acc)
+                  (loop for c across sym-name
+                     do (acond ((eql c #\-)
+                                (setf lowercase (not lowercase)))
+                               ((position c "!?#@%+*/=:")
+                                (write-sequence (aref #("bang" "what" "hash" "at" "percent"
+                                                        "plus" "star" "slash" "equals" "colon")
+                                                      it)
+                                                acc))
+                               (t (write-char (cond (no-case-conversion c)
+                                                    ((and lowercase (not all-uppercase)) (char-downcase c))
+                                                    (t (char-upcase c)))
+                                              acc)
+                                  (setf lowercase t))))))))))
   
 (defun ordered-set-difference (list1 list2 &key (test #'eql)) ; because the CL set-difference may not preserve order
   (reduce (lambda (list el) (remove el list :test test))