Commit f5df120e authored by Andreas Fuchs's avatar Andreas Fuchs Committed by Nikodemus Siivola

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