;;; producing a symbol in the current package.
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defun symbolicate (&rest things)
- (let ((name (case (length things)
- ;; Why isn't this just the value in the T branch?
- ;; Well, this is called early in cold-init, before
- ;; the type system is set up; however, now that we
- ;; check for bad lengths, the type system is needed
- ;; for calls to CONCATENATE. So we need to make sure
- ;; that the calls are transformed away:
- (1 (concatenate 'string
- (the simple-base-string
- (string (car things)))))
- (2 (concatenate 'string
- (the simple-base-string
- (string (car things)))
- (the simple-base-string
- (string (cadr things)))))
- (3 (concatenate 'string
- (the simple-base-string
- (string (car things)))
- (the simple-base-string
- (string (cadr things)))
- (the simple-base-string
- (string (caddr things)))))
- (t (apply #'concatenate 'string (mapcar #'string things))))))
- (values (intern name)))))
+ (let* ((length (reduce #'+ things
+ :key (lambda (x) (length (string x)))))
+ (name (make-array length :element-type 'character)))
+ (let ((index 0))
+ (dolist (thing things (values (intern name)))
+ (let* ((x (string thing))
+ (len (length x)))
+ (replace name x :start1 index)
+ (incf index len)))))))
;;; like SYMBOLICATE, but producing keywords
(defun keywordicate (&rest things)
0)
(1- max))))
(t nil)))
+
+;;; Helpers for defining error-signalling NOP's for "not supported
+;;; here" operations.
+(defmacro define-unsupported-fun (name &optional
+ (doc "Unsupported on this platform.")
+ (control
+ "~S is unsupported on this platform ~
+ (OS, CPU, whatever)."
+ controlp)
+ arguments)
+ `(defun ,name (&rest args)
+ ,doc
+ (declare (ignore args))
+ (error 'unsupported-operator
+ :format-control ,control
+ :format-arguments (if ,controlp ',arguments (list ',name)))))