projects
/
kmrcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r9078: add ppmx
[kmrcl.git]
/
symbols.lisp
diff --git
a/symbols.lisp
b/symbols.lisp
index eb7ba14944c6379540c4a3bd267a422e371a7e1a..3621ac4a9d5a38d14c84bc6a0285137ae8ac934e 100644
(file)
--- a/
symbols.lisp
+++ b/
symbols.lisp
@@
-47,15
+47,15
@@
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (char= #\a (schar (symbol-name '#:a) 0))
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (char= #\a (schar (symbol-name '#:a) 0))
- (pushnew :lowercase-reader *features*)))
+ (pushnew :lowercase-reader *features*))
+ (when (not (eql '#:a '#:A))
+ (pushnew :case-sensitive *features*)))
(defun string-default-case (str)
(defun string-default-case (str)
- #+(and (not case-sensitive) (not lowercase-reader))
- (string-upcase str)
- #+(and (not case-sensitive) lowercase-reader)
- (string-downcase str)
- #+case-sensitive
- str)
+ #-lowercase-reader
+ (string-upcase str)
+ #+lowercase-reader
+ (string-downcase str))
(defun concat-symbol-pkg (pkg &rest args)
(declare (dynamic-extent args))
(defun concat-symbol-pkg (pkg &rest args)
(declare (dynamic-extent args))
@@
-66,8
+66,8
@@
(symbol
(symbol-name arg)))))
(let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
(symbol
(symbol-name arg)))))
(let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
- (intern (string-default-case str)
-
(if pkg pkg *package*
)))))
+ (
nth-value 0 (
intern (string-default-case str)
+
(if pkg pkg *package*)
)))))
(defun concat-symbol (&rest args)
(defun concat-symbol (&rest args)
@@
-77,14
+77,16
@@
"Returns keyword for a name"
(etypecase name
(keyword name)
"Returns keyword for a name"
(etypecase name
(keyword name)
- (string (
intern (string-default-case name) :keyword
))
- (symbol (
intern (symbol-name name) :keyword
))))
+ (string (
nth-value 0 (intern (string-default-case name) :keyword)
))
+ (symbol (
nth-value 0 (intern (symbol-name name) :keyword)
))))
(defun ensure-keyword-upcase (desig)
(defun ensure-keyword-upcase (desig)
- (intern (string-upcase (symbol-name (ensure-keyword desig))) :keyword))
+ (nth-value 0 (intern (string-upcase
+ (symbol-name (ensure-keyword desig))) :keyword)))
(defun ensure-keyword-default-case (desig)
(defun ensure-keyword-default-case (desig)
- (intern (string-default-case (symbol-name (ensure-keyword desig))) :keyword))
+ (nth-value 0 (intern (string-default-case
+ (symbol-name (ensure-keyword desig))) :keyword)))
(defun show (&optional (what :variables) (package *package*))
(ecase what
(defun show (&optional (what :variables) (package *package*))
(ecase what