(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))