Commit 0429a045 authored by Pascal Costanza's avatar Pascal Costanza
Browse files

Removed several dynamic-extent declarations.

Ignore-this: bdb877b84b8b53d0da7c781833813219

darcs-hash:6eaf63cedfed2bc4c5bc15878e625fb5176a7b20
parent cfce66cc
......@@ -68,7 +68,6 @@
(cl:defmethod initialize-instance :around
((gf standard-generic-function) &rest initargs &key (method-class nil method-class-p))
(declare (dynamic-extent initargs))
(if (and method-class-p (symbolp method-class))
(apply #'call-next-method gf
:method-class (find-class method-class)
......@@ -77,7 +76,6 @@
(cl:defmethod reinitialize-instance :around
((gf standard-generic-function) &rest initargs &key (method-class nil method-class-p))
(declare (dynamic-extent initargs))
(if (and method-class-p (symbolp method-class))
(apply #'call-next-method gf
:method-class (find-class method-class)
......@@ -92,7 +90,6 @@
(cl:defmethod reinitialize-instance :after
((gf standard-generic-function) &rest initargs)
(declare (dynamic-extent initargs))
(set-funcallable-instance-function gf (compute-discriminating-function gf))
(map-dependents gf (lambda (dep) (apply #'update-dependent gf dep initargs))))
......
......@@ -45,8 +45,7 @@
((gf standard-generic-function) &rest initargs &key
(lambda-list '() lambda-list-p)
(argument-precedence-order '() argument-precedence-order-p))
(declare (dynamic-extent initargs)
(ignore argument-precedence-order))
(declare (ignore argument-precedence-order))
(if (and lambda-list-p (not argument-precedence-order-p))
(apply #'call-next-method gf
:argument-precedence-order (required-args lambda-list)
......@@ -138,7 +137,6 @@
(values
`(lambda (ccl::&method ,methvar ,@(cadr lambda-expression))
(flet ((call-next-method (&rest args)
(declare (dynamic-extent args))
(if args
(apply #'ccl::%call-next-method-with-args ,methvar args)
(ccl::%call-next-method ,methvar)))
......@@ -161,10 +159,8 @@
(if (or (eq proto #'ccl::gag-one-arg)
(eq proto #'ccl::gag-two-arg))
(lambda (&rest args)
(declare (dynamic-extent args))
(apply std-dfun dt args))
(lambda (&rest args)
(declare (dynamic-extent args))
(funcall std-dfun dt args)))))))
;; The following ensures that slot definitions have a documentation.
......
......@@ -38,14 +38,12 @@
(defmethod initialize-instance :around
((class standard-class) &rest initargs
&key (name (gensym)))
(declare (dynamic-extent initargs))
(prog1 (apply #'call-next-method class :name name initargs)
(modify-accessors class)))
(defmethod initialize-instance :around
((class funcallable-standard-class) &rest initargs
&key (name (gensym)))
(declare (dynamic-extent initargs))
(prog1 (apply #'call-next-method class :name name initargs)
(modify-accessors class)))
......@@ -71,7 +69,6 @@
(defmethod reinitialize-instance :after
((gf standard-generic-function) &rest initargs)
(declare (dynamic-extent initargs))
(set-funcallable-instance-function gf (compute-discriminating-function gf)))
;; The following ensures that effective slot definitions have a documentation in CMUCL.
......
......@@ -50,7 +50,6 @@
(if (only-standard-methods gf)
effective-method
(lambda (&rest args)
(declare (dynamic-extent args))
(funcall effective-method args nil))))
(cl:defgeneric find-method-combination (generic-function type options)
......@@ -72,28 +71,24 @@
'(t))))
(cl:defmethod initialize-instance :around ((class standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:optimize-slot-access
(optimize-slot-access-p class)
initargs))
(cl:defmethod reinitialize-instance :around ((class standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:optimize-slot-access
(optimize-slot-access-p class)
initargs))
(cl:defmethod initialize-instance :around ((class funcallable-standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:optimize-slot-access
(optimize-slot-access-p class)
initargs))
(cl:defmethod reinitialize-instance :around ((class funcallable-standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:optimize-slot-access
(optimize-slot-access-p class)
......@@ -180,11 +175,9 @@
(cl:defgeneric update-dependent (metaobject dependent &rest initargs))
(cl:defmethod reinitialize-instance :after ((metaobject standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(map-dependents metaobject (lambda (dep) (apply #'update-dependent metaobject dep initargs))))
(cl:defmethod reinitialize-instance :after ((metaobject funcallable-standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(map-dependents metaobject (lambda (dep) (apply #'update-dependent metaobject dep initargs))))
(cl:defmethod initialize-instance :after ((gf standard-generic-function) &rest initargs)
......@@ -199,7 +192,6 @@
new-gf)))
(cl:defmethod reinitialize-instance :after ((gf standard-generic-function) &rest initargs)
(declare (dynamic-extent initargs))
(set-funcallable-instance-function gf (compute-discriminating-function gf))
(map-dependents gf (lambda (dep) (apply #'update-dependent gf dep initargs))))
......
......@@ -61,7 +61,6 @@
((class standard-class) &rest initargs
#+lispworks4 &key
#+lispworks4 (direct-superclasses ()))
(declare (dynamic-extent initargs))
(apply #'call-next-method class
#+lispworks4 :direct-superclasses
#+lispworks4 (modify-superclasses direct-superclasses)
......@@ -72,7 +71,6 @@
((class standard-class) &rest initargs
#+lispworks4 &key
#+lispworks4 (direct-superclasses () direct-superclasses-p))
(declare (dynamic-extent initargs))
#+lispworks4
(progn
(when direct-superclasses-p
......@@ -97,7 +95,6 @@
((class funcallable-standard-class) &rest initargs
#+lispworks4 &key
#+lispworks4 (direct-superclasses ()))
(declare (dynamic-extent initargs))
(apply #'call-next-method class
#+lispworks4 :direct-superclasses
#+lispworks4 (modify-superclasses direct-superclasses nil)
......@@ -108,7 +105,6 @@
((class funcallable-standard-class) &rest initargs
#+lispworks4 &key
#+lispworks4 (direct-superclasses () direct-superclasses-p))
(declare (dynamic-extent initargs))
#+lispworks4
(progn
(when direct-superclasses-p
......@@ -140,7 +136,6 @@
(new-class funcallable-standard-class)
&rest initargs
&key (direct-superclasses ()))
(declare (dynamic-extent initargs))
(apply #'call-next-method class new-class
:optimize-slot-access (optimize-slot-access-p new-class)
:direct-superclasses (modify-superclasses direct-superclasses nil)
......@@ -384,7 +379,6 @@
(declaim (inline funcallable-instance-access))
(defun funcallable-instance-access (instance location &rest args)
(declare (dynamic-extent args))
(let* ((class (class-of instance))
(slot (find location (class-slots class)
:key #'slot-definition-location)))
......
......@@ -156,10 +156,8 @@
(assert (eq lambda 'lambda))
(values
`(lambda (,args ,next-methods &rest ,more-args)
(declare (dynamic-extent ,more-args)
(ignorable ,args ,next-methods ,more-args))
(declare (ignorable ,args ,next-methods ,more-args))
(flet ((call-next-method (&rest args)
(declare (dynamic-extent args))
(if ,next-methods
(apply (method-function (first ,next-methods))
(if args args ,args) (rest ,next-methods) ,more-args)
......@@ -250,7 +248,7 @@
(make-method-lambda
gf (class-prototype method-class)
`(lambda (&rest ,args)
(declare (dynamic-extent ,args) (ignorable ,args))
(declare (ignorable ,args))
,(transform-effective-method (cadr form))) nil)
(apply #'make-instance
method-class
......@@ -261,7 +259,7 @@
method-options))))
(t (mapcar #'transform-effective-method (the list form)))))))
(let ((emf-lambda `(lambda (&rest ,args)
(declare (dynamic-extent ,args) (ignorable ,args))
(declare (ignorable ,args))
,(transform-effective-method effective-method))))
(multiple-value-bind (function warnings failure)
(compile nil emf-lambda)
......@@ -296,7 +294,6 @@
applicable-methods)
(compute-effective-method-function gf effective-method options))
(lambda (&rest args)
(declare (dynamic-extent args))
(apply #'no-applicable-method gf args)))))
(defun get-emf-using-classes (gf args classes nof-required-args)
......@@ -317,7 +314,6 @@
applicable-methods)
(compute-effective-method-function gf effective-method options))
(lambda (&rest args)
(declare (dynamic-extent args))
(apply #'no-applicable-method gf args)))
validp)))
......@@ -327,7 +323,7 @@
#+allegro #'compute-discriminating-function))
(defun only-standard-methods (gf &rest other-gfs)
(declare (dynamic-extent other-gfs) (optimize (speed 3) (space 0) (compilation-speed 0)))
(declare (optimize (speed 3) (space 0) (compilation-speed 0)))
(loop for other-gf in (or other-gfs *standard-gfs*)
always (loop for method in (generic-function-methods other-gf)
for specializer = (first (method-specializers method))
......@@ -371,7 +367,6 @@
(declare (type list args classes) (type function emf-setter))
(multiple-value-bind (emf validp) (get-emf-using-classes gf args classes nof-required-args)
(funcall emf-setter (if validp emf (lambda (&rest args)
(declare (dynamic-extent args))
(apply (the function (get-emf gf args nof-required-args)) args))))
(apply (the function emf) args))))
(when (only-standard-methods gf #'compute-applicable-methods #'compute-applicable-methods-using-classes)
......@@ -385,15 +380,14 @@
#+(or clozure ecl lispworks) (argument-order gf)))
(cond ((null (generic-function-methods gf))
(lambda (&rest args)
(declare (dynamic-extent args))
(apply #'no-applicable-method gf args)))
((methods-all-the-same-specializers gf)
(let ((specializers (method-specializers (first (generic-function-methods gf))))
(effective-method-function nil))
(declare (type list specializers))
(lambda (&rest args)
(declare (dynamic-extent args) (optimize (speed 3) (safety 0) (debug 0)
(compilation-speed 0)))
(declare (optimize (speed 3) (safety 0) (debug 0)
(compilation-speed 0)))
(cond ((loop for arg in args
for spec in specializers
always (etypecase spec
......@@ -408,8 +402,8 @@
(emfs (make-hash-table :test #'eq)))
(declare (type hash-table emfs) (type fixnum dispatch-argument-index))
(lambda (&rest args)
(declare (dynamic-extent args) (optimize (speed 3) (safety 0) (debug 0)
(compilation-speed 0)))
(declare (optimize (speed 3) (safety 0) (debug 0)
(compilation-speed 0)))
(let* ((dispatch-class (class-of (nth dispatch-argument-index args)))
(effective-method-function (gethash dispatch-class emfs)))
(if effective-method-function
......@@ -419,8 +413,8 @@
(let ((emfs (make-hash-table :test #'equal)))
(declare (type hash-table emfs))
(lambda (&rest args)
(declare (dynamic-extent args) (optimize (speed 3) (safety 0) (debug 0)
(compilation-speed 0)))
(declare (optimize (speed 3) (safety 0) (debug 0)
(compilation-speed 0)))
(let* ((classes (loop for arg in args
repeat nof-required-args
collect (class-of arg)))
......@@ -433,7 +427,6 @@
(cl:defmethod compute-discriminating-function ((gf standard-generic-function))
(if (eq (class-of gf) (find-class 'standard-generic-function))
(lambda (&rest args)
(declare (dynamic-extent args))
(let ((discriminator (compute-discriminator gf #'call-next-method)))
(set-funcallable-instance-function gf discriminator)
(apply discriminator args)))
......@@ -663,7 +656,6 @@
;;
;; (defmethod direct-slot-definition-class
;; ((class my-standard-class) &rest initargs)
;; (declare (dynamic-extent initargs))
;; (destructuring-bind
;; (&key key-of-interest &allow-other-keys)
;; (fix-slot-initargs initargs)
......
......@@ -38,7 +38,6 @@
(defgeneric update-dependent (metaobject dependent &rest initargs))
(defmethod reinitialize-instance :after ((metaobject metaobject) &rest initargs)
(declare (dynamic-extent initargs))
(map-dependents metaobject (lambda (dep) (apply #'update-dependent metaobject dep initargs))))
(defmethod add-method :after
......
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