From 702172bf0b9ab9b0c865f7a1a9dace6262cc013b Mon Sep 17 00:00:00 2001 From: pmai <pmai> Date: Mon, 26 Aug 2002 16:09:34 +0000 Subject: [PATCH] Slightly frobbed patch from Gerd Moellmann that eliminates the function EXTRACT-DECLARATIONS in favour of SYSTEM:PARSE-BODY. This also removes the ability for macros to expand into declarations, which isn't allowed anymore by ANSI CL. --- pcl/boot.lisp | 26 ++++++++++++++------------ pcl/defcombin.lisp | 7 ++++--- pcl/macros.lisp | 36 +++--------------------------------- 3 files changed, 21 insertions(+), 48 deletions(-) diff --git a/pcl/boot.lisp b/pcl/boot.lisp index b0819bc93..39537417f 100644 --- a/pcl/boot.lisp +++ b/pcl/boot.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.28 2002/08/26 02:23:10 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.29 2002/08/26 16:09:33 pmai Exp $") (in-package :pcl) @@ -421,8 +421,8 @@ work during bootstrapping. (multiple-value-bind (parameters unspecialized-lambda-list specializers) (parse-specialized-lambda-list lambda-list) (declare (ignore parameters)) - (multiple-value-bind (documentation declarations real-body) - (extract-declarations body env) + (multiple-value-bind (real-body declarations documentation) + (system:parse-body body env) (values `(lambda ,unspecialized-lambda-list ,@(when documentation `(,documentation)) (declare (method-name ,(list name qualifiers specializers))) @@ -451,8 +451,8 @@ work during bootstrapping. (unless (and (consp method-lambda) (eq (car method-lambda) 'lambda)) (error "The method-lambda argument to make-method-lambda, ~S,~ is not a lambda form" method-lambda)) - (multiple-value-bind (documentation declarations real-body) - (extract-declarations (cddr method-lambda) env) + (multiple-value-bind (real-body declarations documentation) + (system:parse-body (cddr method-lambda) env) (let* ((name-decl (get-declaration 'method-name declarations)) (sll-decl (get-declaration 'method-lambda-list declarations)) (method-name (when (consp name-decl) (car name-decl))) @@ -515,9 +515,10 @@ work during bootstrapping. next-method-p-p) (walk-method-lambda method-lambda required-parameters env slots calls) - (multiple-value-bind (ignore walked-declarations walked-lambda-body) - (extract-declarations (cddr walked-lambda)) - (declare (ignore ignore)) + (multiple-value-bind (walked-lambda-body walked-declarations + walked-documentation) + (system:parse-body (cddr walked-lambda) env) + (declare (ignore walked-documentation)) (when (or next-method-p-p call-next-method-p) (setq plist (list* :needs-next-methods-p t plist))) (when (some #'cdr slots) @@ -1012,10 +1013,11 @@ work during bootstrapping. method-name specializers) (flet ((ignoredp (symbol) - (dolist (decl (cdar declarations)) - (when (and (eq (car decl) 'ignore) - (memq symbol (cdr decl))) - (return t))))) + (dolist (form declarations) + (dolist (decl (cdr form)) + (when (and (eq (car decl) 'ignore) + (memq symbol (cdr decl))) + (return-from ignoredp t)))))) (loop for s in specialized-lambda-list and p in required-parameters when (listp s) diff --git a/pcl/defcombin.lisp b/pcl/defcombin.lisp index adaf1b7d2..c7cb789c3 100644 --- a/pcl/defcombin.lisp +++ b/pcl/defcombin.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defcombin.lisp,v 1.14 2002/08/26 02:23:12 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defcombin.lisp,v 1.15 2002/08/26 16:09:34 pmai Exp $") ;;; (in-package :pcl) @@ -287,8 +287,9 @@ (type ll method-group-specifiers arguments-option gf-var body) ;;(declare (values documentation function)) (declare (ignore type)) - (multiple-value-bind (documentation declarations real-body) - (extract-declarations body) + (multiple-value-bind (real-body declarations documentation) + ;; Note that PARSE-BODY ignores its second arg ENVIRONMENT. + (system:parse-body body nil) (let ((wrapped-body (wrap-method-group-specifier-bindings method-group-specifiers diff --git a/pcl/macros.lisp b/pcl/macros.lisp index 4424a059d..1fdee60e2 100644 --- a/pcl/macros.lisp +++ b/pcl/macros.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/macros.lisp,v 1.18 2002/08/26 02:23:14 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/macros.lisp,v 1.19 2002/08/26 16:09:34 pmai Exp $") ;;; ;;; Macros global variable definitions, and other random support stuff used ;;; by the rest of the system. @@ -98,36 +98,6 @@ (defun remtail (list tail) (if (eq list tail) () (cons (car list) (remtail (cdr list) tail)))) -(eval-when (compile load eval) -(defun extract-declarations (body &optional environment) - ;;(declare (values documentation declarations body)) - (let (documentation declarations form) - (when (and (stringp (car body)) - (cdr body)) - (setq documentation (pop body))) - (block outer - (loop - (when (null body) (return-from outer nil)) - (setq form (car body)) - (when (block inner - (loop (cond ((not (listp form)) - (return-from outer nil)) - ((eq (car form) 'declare) - (return-from inner t)) - (t - (multiple-value-bind (newform macrop) - (macroexpand-1 form environment) - (if (or (not (eq newform form)) macrop) - (setq form newform) - (return-from outer nil))))))) - (pop body) - (dolist (declaration (cdr form)) - (push declaration declarations))))) - (values documentation - (and declarations `((declare ,.(nreverse declarations)))) - body))) -) - (defun get-declaration (name declarations &optional default) (dolist (d declarations default) (dolist (form (cdr d)) @@ -167,8 +137,8 @@ (car ,alist))))) (defmacro doplist ((key val) plist &body body &environment env) - (multiple-value-bind (doc decls bod) - (extract-declarations body env) + (multiple-value-bind (bod decls doc) + (system:parse-body body env) (declare (ignore doc)) `(let ((.plist-tail. ,plist) ,key ,val) ,@decls -- GitLab