From e0814eee6f6dea52db010b45a330100f2fe65832 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 12 Jan 2002 19:33:12 +0000 Subject: [PATCH] 0.pre7.124: lotso s/#'(lambda/(lambda/ --- src/code/interr.lisp | 34 ++-- src/code/late-format.lisp | 40 ++-- src/code/late-type.lisp | 16 +- src/code/load.lisp | 4 +- src/code/loop.lisp | 26 +-- src/code/macros.lisp | 6 +- src/code/ntrace.lisp | 130 ++++++------- src/code/numbers.lisp | 22 +-- src/code/package.lisp | 11 +- src/code/pp-backq.lisp | 4 +- src/code/pprint.lisp | 18 +- src/code/print.lisp | 2 +- src/code/purify.lisp | 20 +- src/code/reader.lisp | 4 +- src/code/room.lisp | 376 ++++++++++++++++++------------------- src/code/run-program.lisp | 92 ++++----- src/code/seq.lisp | 2 +- src/code/serve-event.lisp | 6 +- src/code/setf-funs.lisp | 4 +- src/code/target-alieneval.lisp | 8 +- src/code/target-error.lisp | 70 +++---- src/code/target-format.lisp | 35 ++-- src/code/target-package.lisp | 14 +- src/code/target-pathname.lisp | 68 +++---- src/code/time.lisp | 2 +- src/compiler/alpha/arith.lisp | 28 +-- src/compiler/alpha/array.lisp | 2 +- src/compiler/alpha/call.lisp | 24 +-- src/compiler/alpha/insts.lisp | 154 +++++++-------- src/compiler/alpha/macros.lisp | 12 +- src/compiler/alpha/type-vops.lisp | 6 +- src/compiler/alpha/vm.lisp | 15 +- src/compiler/array-tran.lisp | 16 +- src/compiler/assem.lisp | 42 ++--- src/compiler/backend.lisp | 20 +- src/compiler/checkgen.lisp | 48 ++--- src/compiler/ctype.lisp | 28 +-- src/compiler/debug-dump.lisp | 4 +- version.lisp-expr | 2 +- 39 files changed, 709 insertions(+), 706 deletions(-) diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 10f50d4..231992d 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -38,20 +38,20 @@ ;; he ended up inside the system error-handling logic. (declare (ignorable name ,fp ,context ,sc-offsets)) (let (,@(let ((offset -1)) - (mapcar #'(lambda (var) - `(,var (sb!di::sub-access-debug-var-slot - ,fp - (nth ,(incf offset) - ,sc-offsets) - ,context))) + (mapcar (lambda (var) + `(,var (sb!di::sub-access-debug-var-slot + ,fp + (nth ,(incf offset) + ,sc-offsets) + ,context))) required)) ,@(when rest-pos `((,(nth (1+ rest-pos) args) - (mapcar #'(lambda (sc-offset) - (sb!di::sub-access-debug-var-slot - ,fp - sc-offset - ,context)) + (mapcar (lambda (sc-offset) + (sb!di::sub-access-debug-var-slot + ,fp + sc-offset + ,context)) (nthcdr ,rest-pos ,sc-offsets)))))) ,@body)) (setf (svref *internal-errors* ,(error-number-or-lose name)) @@ -471,9 +471,9 @@ "unknown internal error, ~D, args=~S" :format-arguments (list error-number - (mapcar #'(lambda (sc-offset) - (sb!di::sub-access-debug-var-slot - fp sc-offset alien-context)) + (mapcar (lambda (sc-offset) + (sb!di::sub-access-debug-var-slot + fp sc-offset alien-context)) arguments)))) ((not (functionp handler)) (error 'simple-error @@ -481,9 +481,9 @@ :format-arguments (list error-number handler - (mapcar #'(lambda (sc-offset) - (sb!di::sub-access-debug-var-slot - fp sc-offset alien-context)) + (mapcar (lambda (sc-offset) + (sb!di::sub-access-debug-var-slot + fp sc-offset alien-context)) arguments)))) (t (funcall handler name fp alien-context arguments))))))))) diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp index 27d2b3a..998468b 100644 --- a/src/code/late-format.lisp +++ b/src/code/late-format.lisp @@ -655,14 +655,14 @@ (expand-bind-defaults () params `(handler-bind ((format-error - #'(lambda (condition) - (error 'format-error - :complaint - "~A~%while processing indirect format string:" - :arguments (list condition) - :print-banner nil - :control-string ,string - :offset ,(1- end))))) + (lambda (condition) + (error 'format-error + :complaint + "~A~%while processing indirect format string:" + :arguments (list condition) + :print-banner nil + :control-string ,string + :offset ,(1- end))))) ,(if atsignp (if *orig-args-available* `(setf args (%format stream ,(expand-next-arg) orig-args args)) @@ -867,14 +867,14 @@ (if *orig-args-available* `((handler-bind ((format-error - #'(lambda (condition) - (error 'format-error - :complaint - "~A~%while processing indirect format string:" - :arguments (list condition) - :print-banner nil - :control-string ,string - :offset ,(1- end))))) + (lambda (condition) + (error 'format-error + :complaint + "~A~%while processing indirect format string:" + :arguments (list condition) + :print-banner nil + :control-string ,string + :offset ,(1- end))))) (setf args (%format stream inside-string orig-args args)))) (throw 'need-orig-args nil)) @@ -1104,10 +1104,10 @@ (line-len '(or (sb!impl::line-length stream) 72))) (format-directive-params first-semi) `(setf extra-space ,extra line-len ,line-len)))) - ,@(mapcar #'(lambda (segment) - `(push (with-output-to-string (stream) - ,@(expand-directive-list segment)) - segments)) + ,@(mapcar (lambda (segment) + `(push (with-output-to-string (stream) + ,@(expand-directive-list segment)) + segments)) segments)) (format-justification stream ,@(if newline-segment-p diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 5950822..1563ca5 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -381,12 +381,12 @@ (defun fixed-values-op (types1 types2 rest2 operation) (declare (list types1 types2) (type ctype rest2) (type function operation)) (let ((exact t)) - (values (mapcar #'(lambda (t1 t2) - (multiple-value-bind (res win) - (funcall operation t1 t2) - (unless win - (setq exact nil)) - res)) + (values (mapcar (lambda (t1 t2) + (multiple-value-bind (res win) + (funcall operation t1 t2) + (unless win + (setq exact nil)) + res)) types1 (append types2 (make-list (- (length types1) (length types2)) @@ -1714,8 +1714,8 @@ ;; See whether dimensions are compatible. (cond ((not (or (eq dims1 '*) (eq dims2 '*) (and (= (length dims1) (length dims2)) - (every #'(lambda (x y) - (or (eq x '*) (eq y '*) (= x y))) + (every (lambda (x y) + (or (eq x '*) (eq y '*) (= x y))) dims1 dims2)))) (values nil t)) ;; See whether complexpness is compatible. diff --git a/src/code/load.lisp b/src/code/load.lisp index caa2706..92f188d 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -387,8 +387,8 @@ (let ((n (svref ,vec i))) (push (cons (svref *fop-names* i) n) ,lvar) (incf ,tvar n))) - (setq ,lvar (subseq (sort ,lvar #'(lambda (x y) - (> (cdr x) (cdr y)))) + (setq ,lvar (subseq (sort ,lvar (lambda (x y) + (> (cdr x) (cdr y)))) 0 10))))) (breakdown counts total-count *fop-counts*) diff --git a/src/code/loop.lisp b/src/code/loop.lisp index b3a79ae..3e413fc 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -356,17 +356,17 @@ code to be loaded. (typecase var (null (when (consp val) - ;; don't lose possible side-effects + ;; Don't lose possible side-effects. (if (eq (car val) 'prog1) - ;; these can come from psetq or desetq below. - ;; throw away the value, keep the side-effects. - ;;Special case is for handling an expanded POP. - (mapcan #'(lambda (x) - (and (consp x) - (or (not (eq (car x) 'car)) - (not (symbolp (cadr x))) - (not (symbolp (setq x (sb!xc:macroexpand x env))))) - (cons x nil))) + ;; These can come from psetq or desetq below. + ;; Throw away the value, keep the side-effects. + ;; Special case is for handling an expanded POP. + (mapcan (lambda (x) + (and (consp x) + (or (not (eq (car x) 'car)) + (not (symbolp (cadr x))) + (not (symbolp (setq x (sb!xc:macroexpand x env))))) + (cons x nil))) (cdr val)) `(,val)))) (cons @@ -1594,9 +1594,9 @@ code to be loaded. (this-group nil nil) (this-prep nil nil) (disallowed-prepositions - (mapcan #'(lambda (x) - (copy-list - (find (car x) preposition-groups :test #'in-group-p))) + (mapcan (lambda (x) + (copy-list + (find (car x) preposition-groups :test #'in-group-p))) initial-phrases)) (used-prepositions (mapcar #'car initial-phrases))) ((null *loop-source-code*) (nreverse prepositional-phrases)) diff --git a/src/code/macros.lisp b/src/code/macros.lisp index bc9ba0e..f7ddd36 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -31,8 +31,8 @@ some locations known to SETF, starting over with test-form. Returns NIL." `(do () (,test-form) (assert-error ',test-form ',places ,datum ,@arguments) - ,@(mapcar #'(lambda (place) - `(setf ,place (assert-prompt ',place ,place))) + ,@(mapcar (lambda (place) + `(setf ,place (assert-prompt ',place ,place))) places))) (defun assert-prompt (name value) @@ -448,7 +448,7 @@ the usual naming convention (names like *FOO*) for special variables" code in BODY to provide possible further output." `(%print-unreadable-object ,object ,stream ,type ,identity ,(if body - `#'(lambda () ,@body) + `(lambda () ,@body) nil))) (defmacro-mundanely ignore-errors (&rest forms) diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index 1c8b58a..fd96b83 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -155,9 +155,9 @@ (if (sb-di:code-location-p loc) (let ((fun (sb-di:preprocess-for-eval exp loc))) (cons exp - #'(lambda (frame) - (let ((*current-frame* frame)) - (funcall fun frame))))) + (lambda (frame) + (let ((*current-frame* frame)) + (funcall fun frame))))) (let* ((bod (ecase loc ((nil) exp) (:encapsulated @@ -168,13 +168,13 @@ ,exp)))) (fun (coerce `(lambda () ,bod) 'function))) (cons exp - #'(lambda (frame) - (declare (ignore frame)) - (let ((*current-frame* nil)) - (funcall fun))))))))) + (lambda (frame) + (declare (ignore frame)) + (let ((*current-frame* nil)) + (funcall fun))))))))) (defun coerce-form-list (forms loc) - (mapcar #'(lambda (x) (coerce-form x loc)) forms)) + (mapcar (lambda (x) (coerce-form x loc)) forms)) ;;; Print indentation according to the number of trace entries. ;;; Entries whose condition was false don't count. @@ -236,34 +236,34 @@ (let (conditionp) (values - #'(lambda (frame bpt) - (declare (ignore bpt)) - (discard-invalid-entries frame) - (let ((condition (trace-info-condition info)) - (wherein (trace-info-wherein info))) - (setq conditionp - (and (not *in-trace*) - (or (not condition) - (funcall (cdr condition) frame)) - (or (not wherein) - (trace-wherein-p frame wherein))))) - (when conditionp - (let ((sb-kernel:*current-level* 0) - (*standard-output* *trace-output*) - (*in-trace* t)) - (fresh-line) - (print-trace-indentation) - (if (trace-info-encapsulated info) - (locally (declare (special basic-definition argument-list)) - (prin1 `(,(trace-info-what info) ,@argument-list))) - (print-frame-call frame)) - (terpri) - (trace-print frame (trace-info-print info))) - (trace-maybe-break info (trace-info-break info) "before" frame))) - - #'(lambda (frame cookie) - (declare (ignore frame)) - (push (cons cookie conditionp) *traced-entries*))))) + (lambda (frame bpt) + (declare (ignore bpt)) + (discard-invalid-entries frame) + (let ((condition (trace-info-condition info)) + (wherein (trace-info-wherein info))) + (setq conditionp + (and (not *in-trace*) + (or (not condition) + (funcall (cdr condition) frame)) + (or (not wherein) + (trace-wherein-p frame wherein))))) + (when conditionp + (let ((sb-kernel:*current-level* 0) + (*standard-output* *trace-output*) + (*in-trace* t)) + (fresh-line) + (print-trace-indentation) + (if (trace-info-encapsulated info) + (locally (declare (special basic-definition argument-list)) + (prin1 `(,(trace-info-what info) ,@argument-list))) + (print-frame-call frame)) + (terpri) + (trace-print frame (trace-info-print info))) + (trace-maybe-break info (trace-info-break info) "before" frame))) + + (lambda (frame cookie) + (declare (ignore frame)) + (push (cons cookie conditionp) *traced-entries*))))) ;;; This prints a representation of the return values delivered. ;;; First, this checks to see that cookie is at the top of @@ -272,35 +272,35 @@ ;;; see whether the function is still traced and that the condition ;;; succeeded before printing anything. (defun trace-end-breakpoint-fun (info) - #'(lambda (frame bpt *trace-values* cookie) - (declare (ignore bpt)) - (unless (eq cookie (caar *traced-entries*)) - (setf *traced-entries* - (member cookie *traced-entries* :key #'car))) - - (let ((entry (pop *traced-entries*))) - (when (and (not (trace-info-untraced info)) - (or (cdr entry) - (let ((cond (trace-info-condition-after info))) - (and cond (funcall (cdr cond) frame))))) - (let ((sb-kernel:*current-level* 0) - (*standard-output* *trace-output*) - (*in-trace* t)) - (fresh-line) - (pprint-logical-block (*standard-output* nil) - (print-trace-indentation) - (pprint-indent :current 2) - (format t "~S returned" (trace-info-what info)) - (dolist (v *trace-values*) - (write-char #\space) - (pprint-newline :linear) - (prin1 v))) - (terpri) - (trace-print frame (trace-info-print-after info))) - (trace-maybe-break info - (trace-info-break-after info) - "after" - frame))))) + (lambda (frame bpt *trace-values* cookie) + (declare (ignore bpt)) + (unless (eq cookie (caar *traced-entries*)) + (setf *traced-entries* + (member cookie *traced-entries* :key #'car))) + + (let ((entry (pop *traced-entries*))) + (when (and (not (trace-info-untraced info)) + (or (cdr entry) + (let ((cond (trace-info-condition-after info))) + (and cond (funcall (cdr cond) frame))))) + (let ((sb-kernel:*current-level* 0) + (*standard-output* *trace-output*) + (*in-trace* t)) + (fresh-line) + (pprint-logical-block (*standard-output* nil) + (print-trace-indentation) + (pprint-indent :current 2) + (format t "~S returned" (trace-info-what info)) + (dolist (v *trace-values*) + (write-char #\space) + (pprint-newline :linear) + (prin1 v))) + (terpri) + (trace-print frame (trace-info-print-after info))) + (trace-maybe-break info + (trace-info-break-after info) + "after" + frame))))) ;;; This function is called by the trace encapsulation. It calls the ;;; breakpoint hook functions with NIL for the breakpoint and cookie, diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp index 1e93c38..fac1b02 100644 --- a/src/code/numbers.lisp +++ b/src/code/numbers.lisp @@ -67,11 +67,11 @@ (let ((var (first vars)) (cases (sort cases #'type-test-order :key #'car))) `((typecase ,var - ,@(mapcar #'(lambda (case) - `(,(first case) - ,@(generate-number-dispatch (rest vars) - (rest error-tags) - (cdr case)))) + ,@(mapcar (lambda (case) + `(,(first case) + ,@(generate-number-dispatch (rest vars) + (rest error-tags) + (cdr case)))) cases) (t (go ,(first error-tags)))))) cases)) @@ -879,12 +879,12 @@ nil (macrolet ((foo (&rest stuff) `(typecase obj2 - ,@(mapcar #'(lambda (foo) - (let ((type (car foo)) - (fn (cadr foo))) - `(,type - (and (typep obj1 ',type) - (,fn obj1 obj2))))) + ,@(mapcar (lambda (foo) + (let ((type (car foo)) + (fn (cadr foo))) + `(,type + (and (typep obj1 ',type) + (,fn obj1 obj2))))) stuff)))) (foo (single-float eql) diff --git a/src/code/package.lisp b/src/code/package.lisp index 8af6ad8..b290abb 100644 --- a/src/code/package.lisp +++ b/src/code/package.lisp @@ -227,10 +227,10 @@ (inherited-symbol-p (gensym)) (BLOCK (gensym))) `(let* ((,these-packages ,package-list) - (,packages `,(mapcar #'(lambda (package) - (if (packagep package) - package - (find-package package))) + (,packages `,(mapcar (lambda (package) + (if (packagep package) + package + (find-package package))) (if (consp ,these-packages) ,these-packages (list ,these-packages)))) @@ -253,7 +253,8 @@ (car ,',packages)))) (when ,symbols (setf ,',vector (package-hashtable-table ,symbols)) - (setf ,',hash-vector (package-hashtable-hash ,symbols))))) + (setf ,',hash-vector + (package-hashtable-hash ,symbols))))) (:external `(let ((,symbols (package-external-symbols (car ,',packages)))) diff --git a/src/code/pp-backq.lisp b/src/code/pp-backq.lisp index b1d5cc4..2552673 100644 --- a/src/code/pp-backq.lisp +++ b/src/code/pp-backq.lisp @@ -49,10 +49,10 @@ (backq-unparse (car tail) t))) (push (backq-unparse (car tail)) accum))) (backq-append - (mapcan #'(lambda (el) (backq-unparse el t)) + (mapcan (lambda (el) (backq-unparse el t)) (cdr form))) (backq-nconc - (mapcan #'(lambda (el) (backq-unparse el :nconc)) + (mapcan (lambda (el) (backq-unparse el :nconc)) (cdr form))) (backq-cons (cons (backq-unparse (cadr form) nil) diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp index 9b3f51e..d268aca 100644 --- a/src/code/pprint.lisp +++ b/src/code/pprint.lisp @@ -847,7 +847,7 @@ (pprint-dispatch-entry-priority e2))))) (macrolet ((frob (x) - `(cons ',x #'(lambda (object) ,x)))) + `(cons ',x (lambda (object) ,x)))) (defvar *precompiled-pprint-dispatch-funs* (list (frob (typep object 'array)) (frob (and (consp object) @@ -876,12 +876,12 @@ (destructuring-bind (type) (cdr type) `(not ,(compute-test-expr type object)))) (and - `(and ,@(mapcar #'(lambda (type) - (compute-test-expr type object)) + `(and ,@(mapcar (lambda (type) + (compute-test-expr type object)) (cdr type)))) (or - `(or ,@(mapcar #'(lambda (type) - (compute-test-expr type object)) + `(or ,@(mapcar (lambda (type) + (compute-test-expr type object)) (cdr type)))) (t `(typep ,object ',type))) @@ -898,8 +898,8 @@ (new (make-pprint-dispatch-table :entries (copy-list (pprint-dispatch-table-entries orig)))) (new-cons-entries (pprint-dispatch-table-cons-entries new))) - (maphash #'(lambda (key value) - (setf (gethash key new-cons-entries) value)) + (maphash (lambda (key value) + (setf (gethash key new-cons-entries) value)) (pprint-dispatch-table-cons-entries orig)) new)) @@ -919,8 +919,8 @@ (return entry))))) (if entry (values (pprint-dispatch-entry-fun entry) t) - (values #'(lambda (stream object) - (output-ugly-object object stream)) + (values (lambda (stream object) + (output-ugly-object object stream)) nil)))) (defun set-pprint-dispatch (type function &optional diff --git a/src/code/print.lisp b/src/code/print.lisp index 03bfd1b..ad0e294 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -94,7 +94,7 @@ *READ-EVAL* T *READ-SUPPRESS* NIL *READTABLE* the standard readtable" - `(%with-standard-io-syntax #'(lambda () ,@body))) + `(%with-standard-io-syntax (lambda () ,@body))) (defun %with-standard-io-syntax (function) (let ((*package* (find-package "COMMON-LISP-USER")) diff --git a/src/code/purify.lisp b/src/code/purify.lisp index 15199fa..4d27fe5 100644 --- a/src/code/purify.lisp +++ b/src/code/purify.lisp @@ -47,17 +47,17 @@ (when environment-name (compact-environment-aux environment-name 200)) (let ((*gc-notify-before* - #'(lambda (notify-stream bytes-in-use) - (declare (ignore bytes-in-use)) - (write-string "[doing purification: " notify-stream) - (force-output notify-stream))) + (lambda (notify-stream bytes-in-use) + (declare (ignore bytes-in-use)) + (write-string "[doing purification: " notify-stream) + (force-output notify-stream))) (*internal-gc* - #'(lambda () - (%purify (get-lisp-obj-address root-structures) - (get-lisp-obj-address nil)))) + (lambda () + (%purify (get-lisp-obj-address root-structures) + (get-lisp-obj-address nil)))) (*gc-notify-after* - #'(lambda (notify-stream &rest ignore) - (declare (ignore ignore)) - (write-line "done]" notify-stream)))) + (lambda (notify-stream &rest ignore) + (declare (ignore ignore)) + (write-line "done]" notify-stream)))) (gc)) nil) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 953ab92..dacf6b2 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -162,8 +162,8 @@ (replace (character-macro-table really-to-readtable) (character-macro-table really-from-readtable)) (setf (dispatch-tables really-to-readtable) - (mapcar #'(lambda (pair) (cons (car pair) - (copy-seq (cdr pair)))) + (mapcar (lambda (pair) (cons (car pair) + (copy-seq (cdr pair)))) (dispatch-tables really-from-readtable))) (setf (readtable-case really-to-readtable) (readtable-case really-from-readtable)) diff --git a/src/code/room.lisp b/src/code/room.lisp index 0b9a24a..90a7ece 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -249,10 +249,10 @@ (let ((sizes (make-array 256 :initial-element 0 :element-type 'fixnum)) (counts (make-array 256 :initial-element 0 :element-type 'fixnum))) (map-allocated-objects - #'(lambda (obj type size) - (declare (fixnum size) (optimize (speed 3) (safety 0)) (ignore obj)) - (incf (aref sizes type) size) - (incf (aref counts type))) + (lambda (obj type size) + (declare (fixnum size) (optimize (speed 3) (safety 0)) (ignore obj)) + (incf (aref sizes type) size) + (incf (aref counts type))) space) (let ((totals (make-hash-table :test 'eq))) @@ -270,9 +270,9 @@ (list total-size total-count name)))))))) (collect ((totals-list)) - (maphash #'(lambda (k v) - (declare (ignore k)) - (totals-list v)) + (maphash (lambda (k v) + (declare (ignore k)) + (totals-list v)) totals) (sort (totals-list) #'> :key #'first))))) @@ -287,13 +287,13 @@ (gethash (third total) summary)))) (collect ((summary-totals)) - (maphash #'(lambda (k v) - (declare (ignore k)) - (let ((sum 0)) - (declare (fixnum sum)) - (dolist (space-total v) - (incf sum (first (cdr space-total)))) - (summary-totals (cons sum v)))) + (maphash (lambda (k v) + (declare (ignore k)) + (let ((sum 0)) + (declare (fixnum sum)) + (dolist (space-total v) + (incf sum (first (cdr space-total)))) + (summary-totals (cons sum v)))) summary) (format t "~2&Summary of spaces: ~(~{~A ~}~)~%" spaces) @@ -366,8 +366,8 @@ (let* ((spaces (if (eq count-spaces t) '(:static :dynamic :read-only) count-spaces)) - (totals (mapcar #'(lambda (space) - (cons space (type-breakdown space))) + (totals (mapcar (lambda (space) + (cons space (type-breakdown space))) spaces))) (dolist (space-total totals) @@ -388,17 +388,17 @@ (declare (fixnum code-words no-ops) (type unsigned-byte total-bytes)) (map-allocated-objects - #'(lambda (obj type size) - (declare (fixnum size) (optimize (safety 0))) - (when (eql type code-header-widetag) - (incf total-bytes size) - (let ((words (truly-the fixnum (%code-code-size obj))) - (sap (truly-the system-area-pointer - (%primitive code-instructions obj)))) - (incf code-words words) - (dotimes (i words) - (when (zerop (sap-ref-32 sap (* i n-word-bytes))) - (incf no-ops)))))) + (lambda (obj type size) + (declare (fixnum size) (optimize (safety 0))) + (when (eql type code-header-widetag) + (incf total-bytes size) + (let ((words (truly-the fixnum (%code-code-size obj))) + (sap (truly-the system-area-pointer + (%primitive code-instructions obj)))) + (incf code-words words) + (dotimes (i words) + (when (zerop (sap-ref-32 sap (* i n-word-bytes))) + (incf no-ops)))))) space) (format t @@ -417,55 +417,55 @@ (dolist (space (or spaces '(:read-only :static :dynamic))) (declare (inline map-allocated-objects)) (map-allocated-objects - #'(lambda (obj type size) - (declare (fixnum size) (optimize (safety 0))) - (case type - (#.code-header-widetag - (let ((inst-words (truly-the fixnum (%code-code-size obj)))) - (declare (type fixnum inst-words)) - (incf non-descriptor-bytes (* inst-words n-word-bytes)) - (incf descriptor-words - (- (truncate size n-word-bytes) inst-words)))) - ((#.bignum-widetag - #.single-float-widetag - #.double-float-widetag - #.simple-string-widetag - #.simple-bit-vector-widetag - #.simple-array-unsigned-byte-2-widetag - #.simple-array-unsigned-byte-4-widetag - #.simple-array-unsigned-byte-8-widetag - #.simple-array-unsigned-byte-16-widetag - #.simple-array-unsigned-byte-32-widetag - #.simple-array-signed-byte-8-widetag - #.simple-array-signed-byte-16-widetag - #.simple-array-signed-byte-30-widetag - #.simple-array-signed-byte-32-widetag - #.simple-array-single-float-widetag - #.simple-array-double-float-widetag - #.simple-array-complex-single-float-widetag - #.simple-array-complex-double-float-widetag) - (incf non-descriptor-headers) - (incf non-descriptor-bytes (- size n-word-bytes))) - ((#.list-pointer-lowtag - #.instance-pointer-lowtag - #.ratio-widetag - #.complex-widetag - #.simple-array-widetag - #.simple-vector-widetag - #.complex-string-widetag - #.complex-bit-vector-widetag - #.complex-vector-widetag - #.complex-array-widetag - #.closure-header-widetag - #.funcallable-instance-header-widetag - #.value-cell-header-widetag - #.symbol-header-widetag - #.sap-widetag - #.weak-pointer-widetag - #.instance-header-widetag) - (incf descriptor-words (truncate size n-word-bytes))) - (t - (error "bogus widetag: ~W" type)))) + (lambda (obj type size) + (declare (fixnum size) (optimize (safety 0))) + (case type + (#.code-header-widetag + (let ((inst-words (truly-the fixnum (%code-code-size obj)))) + (declare (type fixnum inst-words)) + (incf non-descriptor-bytes (* inst-words n-word-bytes)) + (incf descriptor-words + (- (truncate size n-word-bytes) inst-words)))) + ((#.bignum-widetag + #.single-float-widetag + #.double-float-widetag + #.simple-string-widetag + #.simple-bit-vector-widetag + #.simple-array-unsigned-byte-2-widetag + #.simple-array-unsigned-byte-4-widetag + #.simple-array-unsigned-byte-8-widetag + #.simple-array-unsigned-byte-16-widetag + #.simple-array-unsigned-byte-32-widetag + #.simple-array-signed-byte-8-widetag + #.simple-array-signed-byte-16-widetag + #.simple-array-signed-byte-30-widetag + #.simple-array-signed-byte-32-widetag + #.simple-array-single-float-widetag + #.simple-array-double-float-widetag + #.simple-array-complex-single-float-widetag + #.simple-array-complex-double-float-widetag) + (incf non-descriptor-headers) + (incf non-descriptor-bytes (- size n-word-bytes))) + ((#.list-pointer-lowtag + #.instance-pointer-lowtag + #.ratio-widetag + #.complex-widetag + #.simple-array-widetag + #.simple-vector-widetag + #.complex-string-widetag + #.complex-bit-vector-widetag + #.complex-vector-widetag + #.complex-array-widetag + #.closure-header-widetag + #.funcallable-instance-header-widetag + #.value-cell-header-widetag + #.symbol-header-widetag + #.sap-widetag + #.weak-pointer-widetag + #.instance-header-widetag) + (incf descriptor-words (truncate size n-word-bytes))) + (t + (error "bogus widetag: ~W" type)))) space)) (format t "~:D words allocated for descriptor objects.~%" descriptor-words) @@ -484,25 +484,25 @@ (total-bytes 0)) (declare (fixnum total-objects total-bytes)) (map-allocated-objects - #'(lambda (obj type size) - (declare (fixnum size) (optimize (speed 3) (safety 0))) - (when (eql type instance-header-widetag) - (incf total-objects) - (incf total-bytes size) - (let* ((class (layout-class (%instance-ref obj 0))) - (found (gethash class totals))) - (cond (found - (incf (the fixnum (car found))) - (incf (the fixnum (cdr found)) size)) - (t - (setf (gethash class totals) (cons 1 size))))))) + (lambda (obj type size) + (declare (fixnum size) (optimize (speed 3) (safety 0))) + (when (eql type instance-header-widetag) + (incf total-objects) + (incf total-bytes size) + (let* ((class (layout-class (%instance-ref obj 0))) + (found (gethash class totals))) + (cond (found + (incf (the fixnum (car found))) + (incf (the fixnum (cdr found)) size)) + (t + (setf (gethash class totals) (cons 1 size))))))) space) (collect ((totals-list)) - (maphash #'(lambda (class what) - (totals-list (cons (prin1-to-string - (class-proper-name class)) - what))) + (maphash (lambda (class what) + (totals-list (cons (prin1-to-string + (class-proper-name class)) + what))) totals) (let ((sorted (sort (totals-list) #'> :key #'cddr)) (printed-bytes 0) @@ -537,19 +537,19 @@ (declare (type (or null (unsigned-byte 32)) start-addr) (type (unsigned-byte 32) total-bytes)) (map-allocated-objects - #'(lambda (object typecode bytes) - (declare (ignore typecode) - (type (unsigned-byte 32) bytes)) - (if (and (consp object) - (eql (car object) 0) - (eql (cdr object) 0)) - (if start-addr - (incf total-bytes bytes) - (setf start-addr (sb!di::get-lisp-obj-address object) - total-bytes bytes)) - (when start-addr - (format t "~:D bytes at #X~X~%" total-bytes start-addr) - (setf start-addr nil)))) + (lambda (object typecode bytes) + (declare (ignore typecode) + (type (unsigned-byte 32) bytes)) + (if (and (consp object) + (eql (car object) 0) + (eql (cdr object) 0)) + (if start-addr + (incf total-bytes bytes) + (setf start-addr (sb!di::get-lisp-obj-address object) + total-bytes bytes)) + (when start-addr + (format t "~:D bytes at #X~X~%" total-bytes start-addr) + (setf start-addr nil)))) space) (when start-addr (format t "~:D bytes at #X~X~%" total-bytes start-addr)))) @@ -581,58 +581,58 @@ (note-conses (car x)) (note-conses (cdr x))))) (map-allocated-objects - #'(lambda (obj obj-type size) - (declare (optimize (safety 0))) - (let ((addr (get-lisp-obj-address obj))) - (when (>= addr start) - (when (if count - (> count-so-far count) - (> pages-so-far pages)) - (return-from print-allocated-objects (values))) - - (unless count - (let ((this-page (* (the (values (unsigned-byte 32) t) - (truncate addr pagesize)) - pagesize))) - (declare (type (unsigned-byte 32) this-page)) - (when (/= this-page last-page) - (when (< pages-so-far pages) - ;; FIXME: What is this? (ERROR "Argh..")? or - ;; a warning? or code that can be removed - ;; once the system is stable? or what? - (format stream "~2&**** Page ~W, address ~X:~%" - pages-so-far addr)) - (setq last-page this-page) - (incf pages-so-far)))) - - (when (and (or (not type) (eql obj-type type)) - (or (not smaller) (<= size smaller)) - (or (not larger) (>= size larger))) - (incf count-so-far) - (case type - (#.code-header-widetag - (let ((dinfo (%code-debug-info obj))) - (format stream "~&Code object: ~S~%" - (if dinfo - (sb!c::compiled-debug-info-name dinfo) - "No debug info.")))) - (#.symbol-header-widetag - (format stream "~&~S~%" obj)) - (#.list-pointer-lowtag - (unless (gethash obj printed-conses) - (note-conses obj) - (let ((*print-circle* t) - (*print-level* 5) - (*print-length* 10)) - (format stream "~&~S~%" obj)))) - (t - (fresh-line stream) - (let ((str (write-to-string obj :level 5 :length 10 - :pretty nil))) - (unless (eql type instance-header-widetag) - (format stream "~S: " (type-of obj))) - (format stream "~A~%" - (subseq str 0 (min (length str) 60)))))))))) + (lambda (obj obj-type size) + (declare (optimize (safety 0))) + (let ((addr (get-lisp-obj-address obj))) + (when (>= addr start) + (when (if count + (> count-so-far count) + (> pages-so-far pages)) + (return-from print-allocated-objects (values))) + + (unless count + (let ((this-page (* (the (values (unsigned-byte 32) t) + (truncate addr pagesize)) + pagesize))) + (declare (type (unsigned-byte 32) this-page)) + (when (/= this-page last-page) + (when (< pages-so-far pages) + ;; FIXME: What is this? (ERROR "Argh..")? or + ;; a warning? or code that can be removed + ;; once the system is stable? or what? + (format stream "~2&**** Page ~W, address ~X:~%" + pages-so-far addr)) + (setq last-page this-page) + (incf pages-so-far)))) + + (when (and (or (not type) (eql obj-type type)) + (or (not smaller) (<= size smaller)) + (or (not larger) (>= size larger))) + (incf count-so-far) + (case type + (#.code-header-widetag + (let ((dinfo (%code-debug-info obj))) + (format stream "~&Code object: ~S~%" + (if dinfo + (sb!c::compiled-debug-info-name dinfo) + "No debug info.")))) + (#.symbol-header-widetag + (format stream "~&~S~%" obj)) + (#.list-pointer-lowtag + (unless (gethash obj printed-conses) + (note-conses obj) + (let ((*print-circle* t) + (*print-level* 5) + (*print-length* 10)) + (format stream "~&~S~%" obj)))) + (t + (fresh-line stream) + (let ((str (write-to-string obj :level 5 :length 10 + :pretty nil))) + (unless (eql type instance-header-widetag) + (format stream "~S: " (type-of obj))) + (format stream "~A~%" + (subseq str 0 (min (length str) 60)))))))))) space)))) (values)) @@ -656,15 +656,15 @@ (collect ((counted 0 1+)) (let ((res ())) (map-allocated-objects - #'(lambda (obj obj-type size) - (declare (optimize (safety 0))) - (when (and (or (not type) (eql obj-type type)) - (or (not smaller) (<= size smaller)) - (or (not larger) (>= size larger)) - (or (not test) (funcall test obj))) - (setq res (maybe-cons space obj res)) - (when (and count (>= (counted) count)) - (return-from list-allocated-objects res)))) + (lambda (obj obj-type size) + (declare (optimize (safety 0))) + (when (and (or (not type) (eql obj-type type)) + (or (not smaller) (<= size smaller)) + (or (not larger) (>= size larger)) + (or (not test) (funcall test obj))) + (setq res (maybe-cons space obj res)) + (when (and count (>= (counted) count)) + (return-from list-allocated-objects res)))) space) res))) @@ -675,27 +675,27 @@ (flet ((res (x) (setq res (maybe-cons space x res)))) (map-allocated-objects - #'(lambda (obj obj-type size) - (declare (optimize (safety 0)) (ignore obj-type size)) - (typecase obj - (cons - (when (or (eq (car obj) object) (eq (cdr obj) object)) - (res obj))) - (instance - (dotimes (i (%instance-length obj)) - (when (eq (%instance-ref obj i) object) - (res obj) - (return)))) - (simple-vector - (dotimes (i (length obj)) - (when (eq (svref obj i) object) - (res obj) - (return)))) - (symbol - (when (or (eq (symbol-name obj) object) - (eq (symbol-package obj) object) - (eq (symbol-plist obj) object) - (eq (symbol-value obj) object)) - (res obj))))) + (lambda (obj obj-type size) + (declare (optimize (safety 0)) (ignore obj-type size)) + (typecase obj + (cons + (when (or (eq (car obj) object) (eq (cdr obj) object)) + (res obj))) + (instance + (dotimes (i (%instance-length obj)) + (when (eq (%instance-ref obj i) object) + (res obj) + (return)))) + (simple-vector + (dotimes (i (length obj)) + (when (eq (svref obj i) object) + (res obj) + (return)))) + (symbol + (when (or (eq (symbol-name obj) object) + (eq (symbol-package obj) object) + (eq (symbol-plist obj) object) + (eq (symbol-value obj) object)) + (res obj))))) space)) res)) diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 6fcfa55..4dbcc55 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -669,54 +669,54 @@ (setf handler (sb-sys:add-fd-handler descriptor - :input #'(lambda (fd) - (declare (ignore fd)) - (loop - (unless handler - (return)) - (multiple-value-bind - (result readable/errno) - (sb-unix:unix-select (1+ descriptor) - (ash 1 descriptor) - 0 0 0) - (cond ((null result) - (error "~@" - (strerror readable/errno))) - ((zerop result) - (return)))) - (sb-alien:with-alien ((buf (sb-alien:array - sb-c-call:char - 256))) - (multiple-value-bind - (count errno) - (sb-unix:unix-read descriptor - (alien-sap buf) - 256) - (cond ((or (and (null count) - (eql errno sb-unix:eio)) - (eql count 0)) - (sb-sys:remove-fd-handler handler) - (setf handler nil) - (decf (car cookie)) - (sb-unix:unix-close descriptor) - (return)) - ((null count) - (sb-sys:remove-fd-handler handler) - (setf handler nil) - (decf (car cookie)) - (error - "~@" - (strerror errno))) - (t - (sb-kernel:copy-from-system-area - (alien-sap buf) 0 - string (* sb-vm:vector-data-offset - sb-vm:n-word-bits) - (* count sb-vm:n-byte-bits)) - (write-string string stream - :end count))))))))))) + (strerror errno))) + (t + (sb-kernel:copy-from-system-area + (alien-sap buf) 0 + string (* sb-vm:vector-data-offset + sb-vm:n-word-bits) + (* count sb-vm:n-byte-bits)) + (write-string string stream + :end count))))))))))) ;;; Find a file descriptor to use for object given the direction. ;;; Returns the descriptor. If object is :STREAM, returns the created diff --git a/src/code/seq.lisp b/src/code/seq.lisp index 8463694..12df112 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -830,7 +830,7 @@ (dotimes (index len) (setf (elt result-sequence index) (apply really-fun - (mapcar #'(lambda (seq) (elt seq index)) + (mapcar (lambda (seq) (elt seq index)) sequences)))))) result-sequence) diff --git a/src/code/serve-event.lisp b/src/code/serve-event.lisp index c4d856d..a6cb763 100644 --- a/src/code/serve-event.lisp +++ b/src/code/serve-event.lisp @@ -185,9 +185,9 @@ (values sec usec)))) (values 0 0)) (declare (type (unsigned-byte 31) stop-sec stop-usec)) - (with-fd-handler (fd direction #'(lambda (fd) - (declare (ignore fd)) - (setf usable t))) + (with-fd-handler (fd direction (lambda (fd) + (declare (ignore fd)) + (setf usable t))) (loop (sub-serve-event to-sec to-usec) diff --git a/src/code/setf-funs.lisp b/src/code/setf-funs.lisp index cdeba89..16c0878 100644 --- a/src/code/setf-funs.lisp +++ b/src/code/setf-funs.lisp @@ -23,8 +23,8 @@ (cond ((null (intersection args sb!xc:lambda-list-keywords)) `(defun (setf ,name) ,arglist - (declare ,@(mapcar #'(lambda (arg type) - `(type ,type ,arg)) + (declare ,@(mapcar (lambda (arg type) + `(type ,type ,arg)) arglist (cons res args))) (setf (,name ,@(rest arglist)) ,(first arglist)))) diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp index f399057..3150c14 100644 --- a/src/code/target-alieneval.lisp +++ b/src/code/target-alieneval.lisp @@ -436,10 +436,10 @@ (alien-sap (alien-sap alien))) (finalize alien - #'(lambda () - (alien-funcall - (extern-alien "free" (function (values) system-area-pointer)) - alien-sap))) + (lambda () + (alien-funcall + (extern-alien "free" (function (values) system-area-pointer)) + alien-sap))) alien)) (defun note-local-alien-type (info alien) diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp index 380a3de..76643d8 100644 --- a/src/code/target-error.lisp +++ b/src/code/target-error.lisp @@ -26,7 +26,7 @@ function report-function interactive-function - (test-function #'(lambda (cond) (declare (ignore cond)) t))) + (test-function (lambda (cond) (declare (ignore cond)) t))) (def!method print-object ((restart restart) stream) (if *print-escape* (print-unreadable-object (restart stream :type t :identity t) @@ -62,9 +62,9 @@ (defun restart-report (restart stream) (funcall (or (restart-report-function restart) (let ((name (restart-name restart))) - #'(lambda (stream) - (if name (format stream "~S" name) - (format stream "~S" restart))))) + (lambda (stream) + (if name (format stream "~S" name) + (format stream "~S" restart))))) stream)) (defmacro with-condition-restarts (condition-form restarts-form &body body) @@ -90,18 +90,18 @@ the same restart name, FIND-RESTART will find the first such clause." `(let ((*restart-clusters* (cons (list - ,@(mapcar #'(lambda (binding) - (unless (or (car binding) - (member :report-function - binding - :test #'eq)) - (warn "Unnamed restart does not have a ~ + ,@(mapcar (lambda (binding) + (unless (or (car binding) + (member :report-function + binding + :test #'eq)) + (warn "Unnamed restart does not have a ~ report function: ~S" - binding)) - `(make-restart :name ',(car binding) - :function ,(cadr binding) - ,@(cddr binding))) - bindings)) + binding)) + `(make-restart :name ',(car binding) + :function ,(cadr binding) + ,@(cddr binding))) + bindings)) *restart-clusters*))) ,@forms)) @@ -112,9 +112,9 @@ returned. It is an error to supply NIL as a name. If CONDITION is specified and not NIL, then only restarts associated with that condition (or with no condition) will be returned." - (find-if #'(lambda (x) - (or (eq x name) - (eq (restart-name x) name))) + (find-if (lambda (x) + (or (eq x name) + (eq (restart-name x) name))) (compute-restarts condition))) (defun invoke-restart (restart &rest values) @@ -259,25 +259,25 @@ (let ((,temp-var nil)) (tagbody (restart-bind - ,(mapcar #'(lambda (datum) - (let ((name (nth 0 datum)) - (tag (nth 1 datum)) - (keys (nth 2 datum))) - `(,name #'(lambda (&rest temp) - (setq ,temp-var temp) - (go ,tag)) - ,@keys))) + ,(mapcar (lambda (datum) + (let ((name (nth 0 datum)) + (tag (nth 1 datum)) + (keys (nth 2 datum))) + `(,name #'(lambda (&rest temp) + (setq ,temp-var temp) + (go ,tag)) + ,@keys))) data) (return-from ,block-tag ,(munge-restart-case-expression expression data))) - ,@(mapcan #'(lambda (datum) - (let ((tag (nth 1 datum)) - (bvl (nth 3 datum)) - (body (nth 4 datum))) - (list tag - `(return-from ,block-tag - (apply #'(lambda ,bvl ,@body) - ,temp-var))))) + ,@(mapcan (lambda (datum) + (let ((tag (nth 1 datum)) + (bvl (nth 3 datum)) + (body (nth 4 datum))) + (list tag + `(return-from ,block-tag + (apply (lambda ,bvl ,@body) + ,temp-var))))) data))))))) (defmacro with-simple-restart ((restart-name format-string @@ -315,7 +315,7 @@ (when member-if (error "ill-formed handler binding: ~S" (first member-if)))) `(let ((*handler-clusters* - (cons (list ,@(mapcar #'(lambda (x) `(cons ',(car x) ,(cadr x))) + (cons (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x))) bindings)) *handler-clusters*))) (multiple-value-prog1 diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index 8a69dab..b4b6bf5 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -862,14 +862,14 @@ (interpret-bind-defaults () params (handler-bind ((format-error - #'(lambda (condition) - (error 'format-error - :complaint - "~A~%while processing indirect format string:" - :arguments (list condition) - :print-banner nil - :control-string string - :offset (1- end))))) + (lambda (condition) + (error 'format-error + :complaint + "~A~%while processing indirect format string:" + :arguments (list condition) + :print-banner nil + :control-string string + :offset (1- end))))) (if atsignp (setf args (%format stream (next-arg) orig-args args)) (%format stream (next-arg) (next-arg)))))) @@ -1002,14 +1002,15 @@ (if (zerop posn) (handler-bind ((format-error - #'(lambda (condition) - (error 'format-error - :complaint + (lambda (condition) + (error + 'format-error + :complaint "~A~%while processing indirect format string:" - :arguments (list condition) - :print-banner nil - :control-string string - :offset (1- end))))) + :arguments (list condition) + :print-banner nil + :control-string string + :offset (1- end))))) (%format stream insides orig-args args)) (interpret-directive-list stream insides orig-args args))) @@ -1141,13 +1142,13 @@ (if per-line-p (pprint-logical-block (stream arg :per-line-prefix prefix :suffix suffix) - (let ((*logical-block-popper* #'(lambda () (pprint-pop)))) + (let ((*logical-block-popper* (lambda () (pprint-pop)))) (catch 'up-and-out (interpret-directive-list stream insides (if atsignp orig-args arg) arg)))) (pprint-logical-block (stream arg :prefix prefix :suffix suffix) - (let ((*logical-block-popper* #'(lambda () (pprint-pop)))) + (let ((*logical-block-popper* (lambda () (pprint-pop)))) (catch 'up-and-out (interpret-directive-list stream insides (if atsignp orig-args arg) diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index 035da80..8ef4ca9 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -427,9 +427,9 @@ #!+sb-doc "Return a list of all existing packages." (let ((res ())) - (maphash #'(lambda (k v) - (declare (ignore k)) - (pushnew v res)) + (maphash (lambda (k v) + (declare (ignore k)) + (pushnew v res)) *package-names*) res)) @@ -851,10 +851,10 @@ "Return a list of all symbols in the system having the specified name." (let ((string (string string-or-symbol)) (res ())) - (maphash #'(lambda (k v) - (declare (ignore k)) - (multiple-value-bind (s w) (find-symbol string v) - (when w (pushnew s res)))) + (maphash (lambda (k v) + (declare (ignore k)) + (multiple-value-bind (s w) (find-symbol string v) + (when w (pushnew s res)))) *package-names*) res)) diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index 25cf000..f8a688b 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -120,22 +120,22 @@ (let ((pieces1 (pattern-pieces pattern1)) (pieces2 (pattern-pieces pattern2))) (and (= (length pieces1) (length pieces2)) - (every #'(lambda (piece1 piece2) - (typecase piece1 - (simple-string - (and (simple-string-p piece2) - (string= piece1 piece2))) - (cons - (and (consp piece2) - (eq (car piece1) (car piece2)) - (string= (cdr piece1) (cdr piece2)))) - (t - (eq piece1 piece2)))) + (every (lambda (piece1 piece2) + (typecase piece1 + (simple-string + (and (simple-string-p piece2) + (string= piece1 piece2))) + (cons + (and (consp piece2) + (eq (car piece1) (car piece2)) + (string= (cdr piece1) (cdr piece2)))) + (t + (eq piece1 piece2)))) pieces1 pieces2)))) -;;; If the string matches the pattern returns the multiple values T and a -;;; list of the matched strings. +;;; If the string matches the pattern returns the multiple values T +;;; and a list of the matched strings. (defun pattern-matches (pattern string) (declare (type pattern pattern) (type simple-string string)) @@ -335,19 +335,19 @@ (typecase thing (pattern (make-pattern - (mapcar #'(lambda (piece) - (typecase piece - (simple-base-string - (funcall fun piece)) - (cons - (case (car piece) - (:character-set - (cons :character-set - (funcall fun (cdr piece)))) - (t - piece))) - (t - piece))) + (mapcar (lambda (piece) + (typecase piece + (simple-base-string + (funcall fun piece)) + (cons + (case (car piece) + (:character-set + (cons :character-set + (funcall fun (cdr piece)))) + (t + piece))) + (t + piece))) (pattern-pieces thing)))) (list (mapcar fun thing)) @@ -358,20 +358,20 @@ (let ((any-uppers (check-for #'upper-case-p thing)) (any-lowers (check-for #'lower-case-p thing))) (cond ((and any-uppers any-lowers) - ;; Mixed case, stays the same. + ;; mixed case, stays the same thing) (any-uppers - ;; All uppercase, becomes all lower case. - (diddle-with #'(lambda (x) (if (stringp x) - (string-downcase x) - x)) thing)) + ;; all uppercase, becomes all lower case + (diddle-with (lambda (x) (if (stringp x) + (string-downcase x) + x)) thing)) (any-lowers - ;; All lowercase, becomes all upper case. + ;; all lowercase, becomes all upper case (diddle-with #'(lambda (x) (if (stringp x) (string-upcase x) x)) thing)) (t - ;; No letters? I guess just leave it. + ;; no letters? I guess just leave it. thing)))) thing)) @@ -950,7 +950,7 @@ a host-structure or string." (collect ((subs)) (loop (unless source - (unless (every #'(lambda (x) (eq x :wild-inferiors)) from) + (unless (every (lambda (x) (eq x :wild-inferiors)) from) (didnt-match-error orig-source orig-from)) (subs ()) (return)) diff --git a/src/code/time.lisp b/src/code/time.lisp index 2d7b0f7..f9acccc 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -235,7 +235,7 @@ (defmacro time (form) #!+sb-doc "Execute FORM and print timing information on *TRACE-OUTPUT*." - `(%time #'(lambda () ,form))) + `(%time (lambda () ,form))) ;;; Return all the data that we want TIME to report. (defun time-get-sys-info () diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index d4b6df7..9c96308 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -338,20 +338,20 @@ (defmacro define-conditional-vop (translate &rest generator) `(progn - ,@(mapcar #'(lambda (suffix cost signed) - (unless (and (member suffix '(/fixnum -c/fixnum)) - (eq translate 'eql)) - `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" - translate suffix)) - ,(intern - (format nil "~:@(FAST-CONDITIONAL~A~)" - suffix))) - (:translate ,translate) - (:generator ,cost - (let* ((signed ,signed) - (-c/fixnum ,(eq suffix '-c/fixnum)) - (y (if -c/fixnum (fixnumize y) y))) - ,@generator))))) + ,@(mapcar (lambda (suffix cost signed) + (unless (and (member suffix '(/fixnum -c/fixnum)) + (eq translate 'eql)) + `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" + translate suffix)) + ,(intern + (format nil "~:@(FAST-CONDITIONAL~A~)" + suffix))) + (:translate ,translate) + (:generator ,cost + (let* ((signed ,signed) + (-c/fixnum ,(eq suffix '-c/fixnum)) + (y (if -c/fixnum (fixnumize y) y))) + ,@generator))))) '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) '(3 2 5 4 5 4) '(t t t t nil nil)))) diff --git a/src/compiler/alpha/array.lisp b/src/compiler/alpha/array.lisp index a74b898..ab99060 100644 --- a/src/compiler/alpha/array.lisp +++ b/src/compiler/alpha/array.lisp @@ -100,7 +100,7 @@ (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type) ,type vector-data-offset other-pointer-lowtag - ,(remove-if #'(lambda (x) (member x '(null zero))) scs) + ,(remove-if (lambda (x) (member x '(null zero))) scs) ,element-type data-vector-ref) (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index 8b38643..a571adf 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -661,11 +661,11 @@ default-value-8 nargs-pass) ,@(when variable - (mapcar #'(lambda (name offset) - `(:temporary (:sc descriptor-reg - :offset ,offset - :to :eval) - ,name)) + (mapcar (lambda (name offset) + `(:temporary (:sc descriptor-reg + :offset ,offset + :to :eval) + ,name)) register-arg-names *register-arg-offsets*)) ,@(when (eq return :fixed) '((:temporary (:scs (descriptor-reg) :from :eval) move-temp))) @@ -709,11 +709,11 @@ default-value-8 ,@(if variable `((inst subq csp-tn new-fp nargs-pass) ,@(let ((index -1)) - (mapcar #'(lambda (name) - `(inst ldl ,name - ,(ash (incf index) - word-shift) - new-fp)) + (mapcar (lambda (name) + `(inst ldl ,name + ,(ash (incf index) + word-shift) + new-fp)) register-arg-names))) '((inst li (fixnumize nargs) nargs-pass)))) ,@(if (eq return :tail) @@ -1201,8 +1201,8 @@ default-value-8 ,@(when translate `((:policy :fast-safe) (:translate ,translate))) - (:args ,@(mapcar #'(lambda (arg) - `(,arg :scs (any-reg descriptor-reg))) + (:args ,@(mapcar (lambda (arg) + `(,arg :scs (any-reg descriptor-reg))) args)) (:vop-var vop) (:save-p :compute-only) diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index f456c41..54c79cc 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -49,21 +49,21 @@ (defparameter reg-symbols (map 'vector - #'(lambda (name) - (cond ((null name) nil) - (t (make-symbol (concatenate 'string "$" name))))) + (lambda (name) + (cond ((null name) nil) + (t (make-symbol (concatenate 'string "$" name))))) *register-names*)) (sb!disassem:define-argument-type reg - :printer #'(lambda (value stream dstate) - (declare (stream stream) (fixnum value)) - (let ((regname (aref reg-symbols value))) - (princ regname stream) - (sb!disassem:maybe-note-associated-storage-ref - value - 'registers - regname - dstate)))) + :printer (lambda (value stream dstate) + (declare (stream stream) (fixnum value)) + (let ((regname (aref reg-symbols value))) + (princ regname stream) + (sb!disassem:maybe-note-associated-storage-ref + value + 'registers + regname + dstate)))) (defparameter float-reg-symbols (coerce @@ -71,22 +71,22 @@ 'vector)) (sb!disassem:define-argument-type fp-reg - :printer #'(lambda (value stream dstate) - (declare (stream stream) (fixnum value)) - (let ((regname (aref float-reg-symbols value))) - (princ regname stream) - (sb!disassem:maybe-note-associated-storage-ref - value - 'float-registers - regname - dstate)))) + :printer (lambda (value stream dstate) + (declare (stream stream) (fixnum value)) + (let ((regname (aref float-reg-symbols value))) + (princ regname stream) + (sb!disassem:maybe-note-associated-storage-ref + value + 'float-registers + regname + dstate)))) (sb!disassem:define-argument-type relative-label :sign-extend t - :use-label #'(lambda (value dstate) - (declare (type (signed-byte 21) value) - (type sb!disassem:disassem-state dstate)) - (+ (ash value 2) (sb!disassem:dstate-cur-addr dstate)))) + :use-label (lambda (value dstate) + (declare (type (signed-byte 21) value) + (type sb!disassem:disassem-state dstate)) + (+ (ash value 2) (sb!disassem:dstate-cur-addr dstate)))) @@ -244,14 +244,14 @@ '((ra nil :type 'fp-reg))))) (:emitter (emit-back-patch segment 4 - #'(lambda (segment posn) - (emit-branch segment ,op - ,@(if float - '((fp-reg-tn-encoding ra)) + (lambda (segment posn) + (emit-branch segment ,op + ,@(if float + '((fp-reg-tn-encoding ra)) '((reg-tn-encoding ra))) - (ash (- (label-position target) - (+ posn 4)) - -2)))))))) + (ash (- (label-position target) + (+ posn 4)) + -2)))))))) (define-branch br #x30) (define-branch bsr #x34) (define-branch blbc #x38) @@ -533,11 +533,11 @@ (defun emit-header-data (segment type) (emit-back-patch segment 4 - #'(lambda (segment posn) - (emit-lword segment - (logior type - (ash (+ posn (component-header-length)) - (- n-widetag-bits word-shift))))))) + (lambda (segment posn) + (emit-lword segment + (logior type + (ash (+ posn (component-header-length)) + (- n-widetag-bits word-shift))))))) (define-instruction simple-fun-header-word (segment) (:cost 0) @@ -554,36 +554,36 @@ (emit-chooser ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments. segment 12 3 - #'(lambda (segment posn delta-if-after) - (let ((delta (funcall calc label posn delta-if-after))) - (when (<= (- (ash 1 15)) delta (1- (ash 1 15))) - (emit-back-patch segment 4 - #'(lambda (segment posn) - (assemble (segment vop) - (inst lda dst - (funcall calc label posn 0) - src)))) - t))) - #'(lambda (segment posn) - (assemble (segment vop) - (flet ((se (x n) - (let ((x (logand x (lognot (ash -1 n))))) - (if (logbitp (1- n) x) - (logior (ash -1 (1- n)) x) - x)))) - (let* ((value (se (funcall calc label posn 0) 32)) - (low (ldb (byte 16 0) value)) - (tmp1 (- value (se low 16))) - (high (ldb (byte 16 16) tmp1)) - (tmp2 (- tmp1 (se (ash high 16) 32))) - (extra 0)) - (unless (= tmp2 0) - (setf extra #x4000) - (setf tmp1 (- tmp1 #x40000000)) - (setf high (ldb (byte 16 16) tmp1))) - (inst lda dst low src) - (inst ldah dst extra dst) - (inst ldah dst high dst))))))) + (lambda (segment posn delta-if-after) + (let ((delta (funcall calc label posn delta-if-after))) + (when (<= (- (ash 1 15)) delta (1- (ash 1 15))) + (emit-back-patch segment 4 + (lambda (segment posn) + (assemble (segment vop) + (inst lda dst + (funcall calc label posn 0) + src)))) + t))) + (lambda (segment posn) + (assemble (segment vop) + (flet ((se (x n) + (let ((x (logand x (lognot (ash -1 n))))) + (if (logbitp (1- n) x) + (logior (ash -1 (1- n)) x) + x)))) + (let* ((value (se (funcall calc label posn 0) 32)) + (low (ldb (byte 16 0) value)) + (tmp1 (- value (se low 16))) + (high (ldb (byte 16 16) tmp1)) + (tmp2 (- tmp1 (se (ash high 16) 32))) + (extra 0)) + (unless (= tmp2 0) + (setf extra #x4000) + (setf tmp1 (- tmp1 #x40000000)) + (setf high (ldb (byte 16 16) tmp1))) + (inst lda dst low src) + (inst ldah dst extra dst) + (inst ldah dst high dst))))))) ;; code = fn - header - label-offset + other-pointer-tag (define-instruction compute-code-from-fn (segment dst src label temp) @@ -591,10 +591,10 @@ (:vop-var vop) (:emitter (emit-compute-inst segment vop dst src label temp - #'(lambda (label posn delta-if-after) - (- other-pointer-lowtag - (label-position label posn delta-if-after) - (component-header-length)))))) + (lambda (label posn delta-if-after) + (- other-pointer-lowtag + (label-position label posn delta-if-after) + (component-header-length)))))) ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag ;; = lra - (header + label-offset) @@ -603,9 +603,9 @@ (:vop-var vop) (:emitter (emit-compute-inst segment vop dst src label temp - #'(lambda (label posn delta-if-after) - (- (+ (label-position label posn delta-if-after) - (component-header-length))))))) + (lambda (label posn delta-if-after) + (- (+ (label-position label posn delta-if-after) + (component-header-length))))))) ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag (define-instruction compute-lra-from-code (segment dst src label temp) @@ -613,6 +613,6 @@ (:vop-var vop) (:emitter (emit-compute-inst segment vop dst src label temp - #'(lambda (label posn delta-if-after) - (+ (label-position label posn delta-if-after) - (component-header-length)))))) + (lambda (label posn delta-if-after) + (+ (label-position label posn delta-if-after) + (component-header-length)))))) diff --git a/src/compiler/alpha/macros.lisp b/src/compiler/alpha/macros.lisp index 958e05a..96eb188 100644 --- a/src/compiler/alpha/macros.lisp +++ b/src/compiler/alpha/macros.lisp @@ -200,12 +200,12 @@ (inst gentrap ,kind) (with-adjustable-vector (,vector) (write-var-integer (error-number-or-lose ',code) ,vector) - ,@(mapcar #'(lambda (tn) - `(let ((tn ,tn)) - (write-var-integer (make-sc-offset (sc-number - (tn-sc tn)) - (tn-offset tn)) - ,vector))) + ,@(mapcar (lambda (tn) + `(let ((tn ,tn)) + (write-var-integer (make-sc-offset (sc-number + (tn-sc tn)) + (tn-offset tn)) + ,vector))) values) (inst byte (length ,vector)) (dotimes (i (length ,vector)) diff --git a/src/compiler/alpha/type-vops.lisp b/src/compiler/alpha/type-vops.lisp index 4b31c6a..2f34a88 100644 --- a/src/compiler/alpha/type-vops.lisp +++ b/src/compiler/alpha/type-vops.lisp @@ -68,9 +68,9 @@ (error "must supply at least one type for test-type")) (cond (fixnump - (when (remove-if #'(lambda (x) - (or (= x even-fixnum-lowtag) - (= x odd-fixnum-lowtag))) + (when (remove-if (lambda (x) + (or (= x even-fixnum-lowtag) + (= x odd-fixnum-lowtag))) lowtags) (error "can't mix fixnum testing with other lowtags")) (when function-p diff --git a/src/compiler/alpha/vm.lisp b/src/compiler/alpha/vm.lisp index 6d5bcf7..3dd28ab 100644 --- a/src/compiler/alpha/vm.lisp +++ b/src/compiler/alpha/vm.lisp @@ -20,12 +20,13 @@ (let ((offset-sym (symbolicate name "-OFFSET"))) `(eval-when (:compile-toplevel :load-toplevel :execute) (defconstant ,offset-sym ,offset) - (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) + (setf (svref *register-names* ,offset-sym) + ,(symbol-name name))))) (defregset (name &rest regs) `(eval-when (:compile-toplevel :load-toplevel :execute) (defparameter ,name - (list ,@(mapcar #'(lambda (name) - (symbolicate name "-OFFSET")) + (list ,@(mapcar (lambda (name) + (symbolicate name "-OFFSET")) regs)))))) ;; c.f. src/runtime/alpha-lispregs.h @@ -329,10 +330,10 @@ ;;; a list of TN's describing the register arguments (defparameter *register-arg-tns* - (mapcar #'(lambda (n) - (make-random-tn :kind :normal - :sc (sc-or-lose 'descriptor-reg) - :offset n)) + (mapcar (lambda (n) + (make-random-tn :kind :normal + :sc (sc-or-lose 'descriptor-reg) + :offset n)) *register-arg-offsets*)) ;;; This is used by the debugger. diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 0e1990d..61bd015 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -146,11 +146,11 @@ (n -1)) (once-only ((n-vec `(make-array ,len))) `(progn - ,@(mapcar #'(lambda (el) - (once-only ((n-val el)) - `(locally (declare (optimize (safety 0))) - (setf (svref ,n-vec ,(incf n)) - ,n-val)))) + ,@(mapcar (lambda (el) + (once-only ((n-val el)) + `(locally (declare (optimize (safety 0))) + (setf (svref ,n-vec ,(incf n)) + ,n-val)))) elements) ,n-vec)))) @@ -339,9 +339,9 @@ '(:initial-element initial-element)))) (setf (%array-displaced-p header) nil) ,@(let ((axis -1)) - (mapcar #'(lambda (dim) - `(setf (%array-dimension header ,(incf axis)) - ,dim)) + (mapcar (lambda (dim) + `(setf (%array-dimension header ,(incf axis)) + ,dim)) dims)) (truly-the ,spec header)))))) diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp index fbe7d5b..3033cb4 100644 --- a/src/compiler/assem.lisp +++ b/src/compiler/assem.lisp @@ -1110,17 +1110,17 @@ p ;; the branch has two dependents and one of them dpends on `((**current-segment** ,seg-var))) ,@(when vop `((**current-vop** ,vop-var))) - ,@(mapcar #'(lambda (name) - `(,name (gen-label))) + ,@(mapcar (lambda (name) + `(,name (gen-label))) new-labels)) (symbol-macrolet ((**current-segment** ,seg-var) (**current-vop** ,vop-var) ,@(when (or inherited-labels nested-labels) `((..inherited-labels.. ,nested-labels)))) - ,@(mapcar #'(lambda (form) - (if (label-name-p form) - `(emit-label ,form) - form)) + ,@(mapcar (lambda (form) + (if (label-name-p form) + `(emit-label ,form) + form)) body)))))) #+sb-xc-host (sb!xc:defmacro assemble ((&optional segment vop &key labels) @@ -1152,17 +1152,17 @@ p ;; the branch has two dependents and one of them dpends on `((**current-segment** ,seg-var))) ,@(when vop `((**current-vop** ,vop-var))) - ,@(mapcar #'(lambda (name) - `(,name (gen-label))) + ,@(mapcar (lambda (name) + `(,name (gen-label))) new-labels)) (symbol-macrolet ((**current-segment** ,seg-var) (**current-vop** ,vop-var) ,@(when (or inherited-labels nested-labels) `((..inherited-labels.. ,nested-labels)))) - ,@(mapcar #'(lambda (form) - (if (label-name-p form) - `(emit-label ,form) - form)) + ,@(mapcar (lambda (form) + (if (label-name-p form) + `(emit-label ,form) + form)) body)))))) (defmacro inst (&whole whole instruction &rest args &environment env) @@ -1452,11 +1452,11 @@ p ;; the branch has two dependents and one of them dpends on reconstructor)))))) (defun extract-nths (index glue list-of-lists-of-lists) - (mapcar #'(lambda (list-of-lists) - (cons glue - (mapcar #'(lambda (list) - (nth index list)) - list-of-lists))) + (mapcar (lambda (list-of-lists) + (cons glue + (mapcar (lambda (list) + (nth index list)) + list-of-lists))) list-of-lists-of-lists)) (defmacro define-instruction (name lambda-list &rest options) @@ -1624,10 +1624,10 @@ p ;; the branch has two dependents and one of them dpends on :environment env) `(eval-when (:compile-toplevel :load-toplevel :execute) (%define-instruction ,(symbol-name name) - #'(lambda (,whole ,env) - ,@local-defs - (block ,name - ,body))))))) + (lambda (,whole ,env) + ,@local-defs + (block ,name + ,body))))))) (defun %define-instruction (name defun) (setf (gethash name *assem-instructions*) defun) diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index 04c4e35..3866886 100644 --- a/src/compiler/backend.lisp +++ b/src/compiler/backend.lisp @@ -151,19 +151,19 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *vm-support-routines* ',routines)) (defstruct (vm-support-routines (:copier nil)) - ,@(mapcar #'(lambda (routine) - `(,routine nil :type (or function null))) + ,@(mapcar (lambda (routine) + `(,routine nil :type (or function null))) routines)) ,@(mapcar - #'(lambda (name) - `(defun ,name (&rest args) - (apply (or (,(symbolicate "VM-SUPPORT-ROUTINES-" - name) - *backend-support-routines*) - (error "machine-specific support ~S ~ + (lambda (name) + `(defun ,name (&rest args) + (apply (or (,(symbolicate "VM-SUPPORT-ROUTINES-" + name) + *backend-support-routines*) + (error "machine-specific support ~S ~ routine undefined" - ',name)) - args))) + ',name)) + args))) routines)))) (def-vm-support-routines diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 3d1dae3..3986bf6 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -113,10 +113,10 @@ (defun no-function-values-types (type) (declare (type ctype type)) (multiple-value-bind (res count) (values-types type) - (values (mapcar #'(lambda (type) - (if (fun-type-p type) - (specifier-type 'function) - type)) + (values (mapcar (lambda (type) + (if (fun-type-p type) + (specifier-type 'function) + type)) res) count))) @@ -150,18 +150,18 @@ (if (and (every #'type-check-template types) (not force-hairy)) (values :simple types) (values :hairy - (mapcar #'(lambda (x) - (list nil (maybe-weaken-check x cont) x)) + (mapcar (lambda (x) + (list nil (maybe-weaken-check x cont) x)) types))) - (let ((res (mapcar #'(lambda (p c) - (let ((diff (type-difference p c)) - (weak (maybe-weaken-check c cont))) - (if (and diff - (< (type-test-cost diff) - (type-test-cost weak)) - *complement-type-checks*) - (list t diff c) - (list nil weak c)))) + (let ((res (mapcar (lambda (p c) + (let ((diff (type-difference p c)) + (weak (maybe-weaken-check c cont))) + (if (and diff + (< (type-test-cost diff) + (type-test-cost weak)) + *complement-type-checks*) + (list t diff c) + (list nil weak c)))) ptypes types))) (cond ((or force-hairy (find-if #'first res)) (values :hairy res)) @@ -300,15 +300,15 @@ (defun make-type-check-form (types) (let ((temps (make-gensym-list (length types)))) `(multiple-value-bind ,temps 'dummy - ,@(mapcar #'(lambda (temp type) - (let* ((spec - (let ((*unparse-fun-type-simplify* t)) - (type-specifier (second type)))) - (test (if (first type) `(not ,spec) spec))) - `(unless (typep ,temp ',test) - (%type-check-error - ,temp - ',(type-specifier (third type)))))) + ,@(mapcar (lambda (temp type) + (let* ((spec + (let ((*unparse-fun-type-simplify* t)) + (type-specifier (second type)))) + (test (if (first type) `(not ,spec) spec))) + `(unless (typep ,temp ',test) + (%type-check-error + ,temp + ',(type-specifier (third type)))))) temps types) (values ,@temps)))) diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp index a7ebd89..8614e92 100644 --- a/src/compiler/ctype.lisp +++ b/src/compiler/ctype.lisp @@ -362,10 +362,10 @@ (types (approximate-fun-type-types type)) (args (combination-args call)) (nargs (length args)) - (allowp (some #'(lambda (x) - (and (constant-continuation-p x) - (eq (continuation-value x) :allow-other-keys))) - args))) + (allowp (some (lambda (x) + (and (constant-continuation-p x) + (eq (continuation-value x) :allow-other-keys))) + args))) (setf (approximate-fun-type-min-args type) (min (approximate-fun-type-min-args type) nargs)) @@ -377,8 +377,8 @@ ((null old) (setf (approximate-fun-type-types type) (nconc types - (mapcar #'(lambda (x) - (list (continuation-type x))) + (mapcar (lambda (x) + (list (continuation-type x))) arg)))) (when (null arg) (return)) (pushnew (continuation-type (car arg)) @@ -396,10 +396,10 @@ (let ((name (continuation-value key))) (when (keywordp name) (let ((old (find-if - #'(lambda (x) - (and (eq (approximate-key-info-name x) name) - (= (approximate-key-info-position x) - pos))) + (lambda (x) + (and (eq (approximate-key-info-name x) name) + (= (approximate-key-info-position x) + pos))) (keys))) (val-type (continuation-type val))) (cond (old @@ -664,10 +664,10 @@ (dolist (key keys) (unless (find (key-info-name key) arglist - :key #'(lambda (x) - (let ((info (lambda-var-arg-info x))) - (when info - (arg-info-key info))))) + :key (lambda (x) + (let ((info (lambda-var-arg-info x))) + (when info + (arg-info-key info))))) (note-lossage "The definition lacks the ~S key present in ~A." (key-info-name key) where)))) diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 5a0df42..8d7b718 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -375,8 +375,8 @@ (frob-lambda let (= level 3))))) (let ((sorted (sort (vars) #'string< - :key #'(lambda (x) - (symbol-name (leaf-debug-name (car x)))))) + :key (lambda (x) + (symbol-name (leaf-debug-name (car x)))))) (prev-name nil) (id 0) (i 0) diff --git a/version.lisp-expr b/version.lisp-expr index 848a908..24138f4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.123" +"0.pre7.124" -- 1.7.10.4