X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-extensions.lisp;h=9ed8d28c4c5d6f4cdd748bea5581ef7b639cbe6b;hb=c712f88b26cd7547ee984b90e18c134401335bc3;hp=74f0b8fdaf851cd6512709eeb67b752d7d821102;hpb=ef0891e470ff35840def7a5717ede18a58266e76;p=sbcl.git diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 74f0b8f..9ed8d28 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -826,7 +826,7 @@ (let* ((name (first spec)) (exp-temp (gensym "ONCE-ONLY"))) `(let ((,exp-temp ,(second spec)) - (,name (gensym ,(symbol-name name)))) + (,name (sb!xc:gensym ,(symbol-name name)))) `(let ((,,name ,,exp-temp)) ,,(frob (rest specs) body)))))))) @@ -1166,19 +1166,22 @@ (defmacro define-deprecated-function (state since name replacements lambda-list &body body) (let* ((replacements (normalize-deprecation-replacements replacements)) - (doc (let ((*package* (find-package :keyword))) - (apply #'format nil - "~@<~S has been deprecated as of SBCL ~A.~ - ~#[~; Use ~S instead.~; ~ - Use ~S or ~S instead.~:; ~ - Use~@{~#[~; or~] ~S~^,~} instead.~]~@:>" - name since replacements)))) + (doc + (let ((*package* (find-package :keyword)) + (*print-pretty* nil)) + (apply #'format nil + "~S has been deprecated as of SBCL ~A.~ + ~#[~;~2%Use ~S instead.~;~2%~ + Use ~S or ~S instead.~:;~2%~ + Use~@{~#[~; or~] ~S~^,~} instead.~]" + name since replacements)))) `(progn ,(ecase state ((:early :late) - `(defun ,name ,lambda-list - ,doc - ,@body)) + `(progn + (defun ,name ,lambda-list + ,doc + ,@body))) ((:final) `(progn (declaim (ftype (function * nil) ,name)) @@ -1355,33 +1358,6 @@ to :INTERPRET, an interpreter will be used.") (make-unportable-float :long-float-negative-zero) 0.0l0)))) -;;; Like DEFUN, but replaces &REST with &MORE while hiding that from the -;;; lambda-list. -(defmacro define-more-fun (name lambda-list &body body) - (let* ((p (position '&rest lambda-list)) - (head (subseq lambda-list 0 p)) - (tail (subseq lambda-list p)) - (more-context (gensym "MORE-CONTEXT")) - (more-count (gensym "MORE-COUNT"))) - (aver (= 2 (length tail))) - `(progn - (macrolet ((more-count () - `(truly-the index ,',more-count)) - (more-p () - `(not (eql 0 ,',more-count))) - (more-arg (n) - `(sb!c:%more-arg ,',more-context ,n)) - (do-more ((arg &optional (start 0)) &body body) - (let ((i (gensym "I"))) - `(do ((,i (the index ,start) (truly-the index (1+ ,i)))) - ((>= ,i (more-count))) - (declare (index ,i)) - (let ((,arg (sb!c:%more-arg ,',more-context ,i))) - ,@body))))) - (defun ,name (,@head &more ,more-context ,more-count) - ,@body)) - (setf (%simple-fun-arglist #',name) ',lambda-list)))) - ;;; Signalling an error when trying to print an error condition is ;;; generally a PITA, so whatever the failure encountered when ;;; wondering about FILE-POSITION within a condition printer, 'tis