\f
;;;; GENSYM tricks
-;;; GENSYM variant for easier debugging and better backtraces: append
-;;; the closest enclosing non-nil block name to the provided stem.
-(defun block-gensym (&optional (name "G") (env (when (boundp 'sb!c::*lexenv*)
- (symbol-value 'sb!c::*lexenv*))))
- (let ((block-name (when env
- (car (find-if #'car (sb!c::lexenv-blocks env))))))
- (if block-name
- (sb!xc:gensym (format nil "~A[~A]" name block-name))
- (sb!xc:gensym name))))
-
;;; Compile a version of BODY for all TYPES, and dispatch to the
;;; correct one based on the value of VAR. This was originally used
;;; only for strings, hence the name. Renaming it to something more
(stem (if (every #'alpha-char-p symbol-name)
symbol-name
(concatenate 'string symbol-name "-"))))
- `(,symbol (block-gensym ,stem))))
+ `(,symbol (sb!xc:gensym ,stem))))
symbols)
,@body))
(declaim (ftype (function (index &optional t) (values list &optional))
make-gensym-list))
(defun make-gensym-list (n &optional name)
- (case name
- ((t)
- (loop repeat n collect (gensym)))
- ((nil)
- (loop repeat n collect (block-gensym)))
- (otherwise
- (loop repeat n collect (gensym name)))))
+ (when (eq t name)
+ (break))
+ (if name
+ (loop repeat n collect (sb!xc:gensym (string name)))
+ (loop repeat n collect (sb!xc:gensym))))
\f
;;;; miscellany
;; but it will immediately lead to undefined to behavior,
;; since almost any operation on a deleted package is
;; undefined.
- (package-name maybe-package))
+ #-sb-xc-host
+ (package-%name maybe-package))
maybe-package)
(t
;; We're in the undefined behavior zone. First, munge the
(1- max))))
(t nil)))
+(defun proper-list-p (x)
+ (unless (consp x)
+ (return-from proper-list-p (null x)))
+ (let ((rabbit (cdr x))
+ (turtle x))
+ (flet ((pop-rabbit ()
+ (when (eql rabbit turtle) ; circular
+ (return-from proper-list-p nil))
+ (when (atom rabbit)
+ (return-from proper-list-p (null rabbit)))
+ (pop rabbit)))
+ (loop (pop-rabbit)
+ (pop-rabbit)
+ (pop turtle)))))
+
;;; Helpers for defining error-signalling NOP's for "not supported
;;; here" operations.
(defmacro define-unsupported-fun (name &optional