Skip to content
Snippets Groups Projects
Commit f5df120e authored by Andreas Fuchs's avatar Andreas Fuchs Committed by Nikodemus Siivola
Browse files

Support case-sensitive lisps.

* Alter `format-symbol` to accept a string designator as the format
  control.
* Use uninterned symbols as format control for type names in type.lisp
  to get the correct names in case-sensitive lisps.
parent a5d7ec2a
No related branches found
No related tags found
No related merge requests found
...@@ -21,12 +21,12 @@ Example: ...@@ -21,12 +21,12 @@ Example:
(declaim (inline format-symbol)) (declaim (inline format-symbol))
(defun format-symbol (package control &rest arguments) (defun format-symbol (package control &rest arguments)
"Constructs a string by applying ARGUMENTS to CONTROL as if by FORMAT, and "Constructs a string by applying ARGUMENTS to string designator
then creates a symbol named by that string. If PACKAGE is NIL, returns an CONTROL as if by FORMAT, and then creates a symbol named by that
uninterned symbol, if package is T, returns a symbol interned in the current string. If PACKAGE is NIL, returns an uninterned symbol, if package is
package, and otherwise returns a symbol interned in the package designated by T, returns a symbol interned in the current package, and otherwise
PACKAGE." returns a symbol interned in the package designated by PACKAGE."
(maybe-intern (apply #'format nil control arguments) package)) (maybe-intern (apply #'format nil (string control) arguments) package))
(defun make-keyword (name) (defun make-keyword (name)
"Interns the string designated by NAME in the KEYWORD package." "Interns the string designated by NAME in the KEYWORD package."
......
...@@ -24,7 +24,7 @@ ARRAY-DIMENSION-LIMIT." ...@@ -24,7 +24,7 @@ ARRAY-DIMENSION-LIMIT."
(push result subtype-names) (push result subtype-names)
result)) result))
(make-predicate-name (sybtype-name) (make-predicate-name (sybtype-name)
(let ((result (format-symbol :alexandria "~A-P" (let ((result (format-symbol :alexandria '#:~A-p
(symbol-name sybtype-name)))) (symbol-name sybtype-name))))
(push result predicate-names) (push result predicate-names)
result)) result))
...@@ -34,10 +34,10 @@ ARRAY-DIMENSION-LIMIT." ...@@ -34,10 +34,10 @@ ARRAY-DIMENSION-LIMIT."
type type
(if (equal range-beg ''*) inf (ensure-car range-beg)) (if (equal range-beg ''*) inf (ensure-car range-beg))
(if (equal range-end ''*) inf (ensure-car range-end)))))) (if (equal range-end ''*) inf (ensure-car range-end))))))
(let* ((negative-name (make-subtype-name "NEGATIVE-~A")) (let* ((negative-name (make-subtype-name '#:negative-~A))
(non-positive-name (make-subtype-name "NON-POSITIVE-~A")) (non-positive-name (make-subtype-name '#:non-positive-~A))
(non-negative-name (make-subtype-name "NON-NEGATIVE-~A")) (non-negative-name (make-subtype-name '#:non-negative-~A))
(positive-name (make-subtype-name "POSITIVE-~A")) (positive-name (make-subtype-name '#:positive-~A))
(negative-p-name (make-predicate-name negative-name)) (negative-p-name (make-predicate-name negative-name))
(non-positive-p-name (make-predicate-name non-positive-name)) (non-positive-p-name (make-predicate-name non-positive-name))
(non-negative-p-name (make-predicate-name non-negative-name)) (non-negative-p-name (make-predicate-name non-negative-name))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment