summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/name-conversion.lisp31
1 files changed, 17 insertions, 14 deletions
diff --git a/Lisp/name-conversion.lisp b/Lisp/name-conversion.lisp
index 55ea829..70fd919 100644
--- a/Lisp/name-conversion.lisp
+++ b/Lisp/name-conversion.lisp
@@ -117,17 +117,20 @@
(defun slot-name->foreign-slot-name (slot-name)
- (let* ((string (symbol-name slot-name))
- (case-converted-slot-name
- (ecase (readtable-case *readtable*)
- (:preserve string)
- (:invert (cond ((notany #'lower-case-p string)
- (string-downcase string))
- ((notany #'upper-case-p string)
- (string-upcase string))
- (t string)))
- (:upcase (if (notany #'lower-case-p string)
- (string-downcase string)
- string))
- (:downcase string))))
- (substitute #\_ #\- case-converted-slot-name)))
+ (substitute #\_ #\- (name->lower-case (symbol-name slot-name))))
+
+
+(defun name->lower-case (string)
+ (cond ((name-typed-in-canonical-case-p) (string-downcase string))
+ ((and (eq (readtable-case *readtable*) :invert)
+ (notany #'upper-case-p string))
+ (string-upcase string))
+ (t string)))
+
+
+(defun name-typed-in-canonical-case-p (string)
+ (or (and (member (readtable-case *readtable*)
+ '(:downcase :invert :preserve))
+ (notany #'upper-case-p string))
+ (and (member (readtable-case *readtable*))
+ (notany #'lower-case-p string))))