summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-05 17:59:08 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-05 17:59:08 +0100
commit1e1ae77a17a3e03aef130119186297d80efe1200 (patch)
tree84517de4bfce5be00be088bae1dc9d71be6e922a /Lisp
parente6e75a38a8310dc759ebb64b10c2822dd2705c39 (diff)
Simplify SLOT-NAME->FOREIGN-SLOT-NAME.
darcs-hash:f106034cce0323b22f0aa80b43bccf9d60e471f7
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))))