From: <cli...@li...> - 2004-06-17 03:12:15
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src lambdalist.lisp,1.2,1.3 ChangeLog,1.3186,1.3187 (Bruno Haible) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src lambdalist.lisp,1.2,1.3 ChangeLog,1.3186,1.3187 Date: Wed, 16 Jun 2004 11:13:30 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24051/src Modified Files: lambdalist.lisp ChangeLog Log Message: Improved error messages. Index: lambdalist.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/lambdalist.lisp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- lambdalist.lisp 15 Jun 2004 11:59:49 -0000 1.2 +++ lambdalist.lisp 16 Jun 2004 11:13:27 -0000 1.3 @@ -5,7 +5,32 @@ (in-package "SYSTEM") (macrolet ((push (element-form list-var) - `(setq ,list-var (cons ,element-form ,list-var)))) + `(setq ,list-var (cons ,element-form ,list-var))) + (err-misplaced (item) + `(funcall errfunc (TEXT "Lambda list marker ~S not allowed here.") + ,item)) + (err-invalid (item) + `(funcall errfunc (if (or (symbolp ,item) (listp ,item)) + (TEXT "Invalid lambda list element ~S") + (TEXT "Invalid lambda list element ~S. A lambda list may only contain symbols and lists.")) + ,item)) + (check-item (item permissible) + `(if (memq ,item ,permissible) + (return) + (err-misplaced ,item))) + (skip-L (lastseen items) + `(loop + (when (atom L) (return)) + (let ((item (car L))) + (if (memq item lambda-list-keywords) + (check-item item ,items) + (funcall errfunc ,(case lastseen + (&REST '(TEXT "Lambda list element ~S is superfluous. Only one variable is allowed after &REST.")) + (&ALLOW-OTHER-KEYS '(TEXT "Lambda list element ~S is superfluous. No variable is allowed right after &ALLOW-OTHER-KEYS.")) + (&ENVIRONMENT '(TEXT "Lambda list element ~S is superfluous. Only one variable is allowed after &ENVIRONMENT.")) + (t '(TEXT "Lambda list element ~S is superfluous."))) + item))) + (setq L (cdr L))))) ;;; Analyzes a lambda-list of a function (CLtL2 p. 76, ANSI CL 3.4.1.). ;;; Reports errors through errfunc (a function taking an error format string @@ -24,41 +49,22 @@ ;; 11. flag, if other keywords are allowed ;; 12. list of &aux variables ;; 13. list of init-forms of the &aux variables -(defun analyze-lambdalist (lambdalist errfunc) - (let ((L lambdalist) ; rest of the lambda-list - (reqvar nil) - (optvar nil) - (optinit nil) - (optsvar nil) - (rest 0) - (keyflag nil) - (keyword nil) - (keyvar nil) - (keyinit nil) - (keysvar nil) - (allow-other-keys nil) - (auxvar nil) - (auxinit nil)) - ;; The lists are all accumulated in reversed order. - (macrolet ((err-misplaced (item) - `(funcall errfunc (TEXT "Lambda list marker ~S not allowed here.") - ,item)) - (err-invalid (item) - `(funcall errfunc (TEXT "Invalid lambda list element ~S") - ,item)) - (check-item (item permissible) - `(if (memq ,item ,permissible) - (return) - (err-misplaced ,item))) - (skip-L (items) - `(loop - (when (atom L) (return)) - (let ((item (car L))) - (if (memq item lambda-list-keywords) - (check-item item ,items) - (funcall errfunc (TEXT "Lambda list element ~S is superfluous.") - item))) - (setq L (cdr L))))) + (defun analyze-lambdalist (lambdalist errfunc) + (let ((L lambdalist) ; rest of the lambda-list + (reqvar nil) + (optvar nil) + (optinit nil) + (optsvar nil) + (rest 0) + (keyflag nil) + (keyword nil) + (keyvar nil) + (keyinit nil) + (keysvar nil) + (allow-other-keys nil) + (auxvar nil) + (auxinit nil)) + ;; The lists are all accumulated in reversed order. ;; Required parameters: (loop (if (atom L) (return)) @@ -113,9 +119,9 @@ (progn (err-norest) (return)) (setq rest item)) (err-invalid item)) - (setq L (cdr L)))))) - ;; Move forward to the next &KEY or &AUX: - (skip-L '(&key &aux)) + (setq L (cdr L))))) + ;; Move forward to the next &KEY or &AUX: + (skip-L &rest '(&key &aux))) ;; Now (or (atom L) (member (car L) '(&key &aux))). ;; Keyword parameters: (when (and (consp L) (eq (car L) '&key)) @@ -164,9 +170,9 @@ ;; Now (or (atom L) (member (car L) '(&allow-other-keys &aux))). (when (and (consp L) (eq (car L) '&allow-other-keys)) (setq allow-other-keys t) - (setq L (cdr L)))) - ;; Move forward to the next &AUX: - (skip-L '(&aux)) + (setq L (cdr L)) + ;; Move forward to the next &AUX: + (skip-L &allow-other-keys '(&aux)))) ;; Now (or (atom L) (member (car L) '(&aux))). ;; &aux variables: (when (and (consp L) (eq (car L) '&aux)) @@ -189,15 +195,15 @@ ;; Now (atom L). (if L (funcall errfunc (TEXT "Lambda lists with dots are only allowed in macros, not here: ~S") - lambdalist))) - (values - (nreverse reqvar) - (nreverse optvar) (nreverse optinit) (nreverse optsvar) - rest - keyflag - (nreverse keyword) (nreverse keyvar) (nreverse keyinit) (nreverse keysvar) - allow-other-keys - (nreverse auxvar) (nreverse auxinit)))) + lambdalist)) + (values + (nreverse reqvar) + (nreverse optvar) (nreverse optinit) (nreverse optsvar) + rest + keyflag + (nreverse keyword) (nreverse keyvar) (nreverse keyinit) (nreverse keysvar) + allow-other-keys + (nreverse auxvar) (nreverse auxinit)))) ;;; Analyzes a defsetf lambda-list (ANSI CL 3.4.7.). ;;; Reports errors through errfunc (a function taking an error format string @@ -215,40 +221,21 @@ ;; 10. list of supplied-vars for the keyword parameters (0 for the missing) ;; 11. flag, if other keywords are allowed ;; 12. &environment parameter or 0 -(defun analyze-defsetf-lambdalist (lambdalist errfunc) - (let ((L lambdalist) ; rest of the lambda-list - (reqvar nil) - (optvar nil) - (optinit nil) - (optsvar nil) - (rest 0) - (keyflag nil) - (keyword nil) - (keyvar nil) - (keyinit nil) - (keysvar nil) - (allow-other-keys nil) - (env 0)) - ;; The lists are all accumulated in reversed order. - (macrolet ((err-misplaced (item) - `(funcall errfunc (TEXT "Lambda list marker ~S not allowed here.") - ,item)) - (err-invalid (item) - `(funcall errfunc (TEXT "Invalid lambda list element ~S") - ,item)) - (check-item (item permissible) - `(if (memq ,item ,permissible) - (return) - (err-misplaced ,item))) - (skip-L (items) - `(loop - (when (atom L) (return)) - (let ((item (car L))) - (if (memq item lambda-list-keywords) - (check-item item ,items) - (funcall errfunc (TEXT "Lambda list element ~S is superfluous.") - item))) - (setq L (cdr L))))) + (defun analyze-defsetf-lambdalist (lambdalist errfunc) + (let ((L lambdalist) ; rest of the lambda-list + (reqvar nil) + (optvar nil) + (optinit nil) + (optsvar nil) + (rest 0) + (keyflag nil) + (keyword nil) + (keyvar nil) + (keyinit nil) + (keysvar nil) + (allow-other-keys nil) + (env 0)) + ;; The lists are all accumulated in reversed order. ;; Required parameters: (loop (if (atom L) (return)) @@ -303,9 +290,9 @@ (progn (err-norest) (return)) (setq rest item)) (err-invalid item)) - (setq L (cdr L)))))) - ;; Move forward to the next &KEY or &ENVIRONMENT: - (skip-L '(&key &environment)) + (setq L (cdr L))))) + ;; Move forward to the next &KEY or &ENVIRONMENT: + (skip-L &rest '(&key &environment))) ;; Now (or (atom L) (member (car L) '(&key &environment))). ;; Keyword parameters: (when (and (consp L) (eq (car L) '&key)) @@ -354,9 +341,9 @@ ;; Now (or (atom L) (member (car L) '(&allow-other-keys &environment))). (when (and (consp L) (eq (car L) '&allow-other-keys)) (setq allow-other-keys t) - (setq L (cdr L)))) - ;; Move forward to the next &ENVIRONMENT: - (skip-L '(&environment)) + (setq L (cdr L)) + ;; Move forward to the next &ENVIRONMENT: + (skip-L &allow-other-keys '(&environment)))) ;; Now (or (atom L) (member (car L) '(&environment))). ;; &environment parameter: (when (and (consp L) (eq (car L) '&environment)) @@ -372,20 +359,20 @@ (progn (err-noenvironment) (return)) (setq env item)) (err-invalid item)) - (setq L (cdr L)))))) - ;; Move forward to the end: - (skip-L '()) + (setq L (cdr L))))) + ;; Move forward to the end: + (skip-L &environment '())) ;; Now (atom L). (if L (funcall errfunc (TEXT "Lambda lists with dots are only allowed in macros, not here: ~S") - lambdalist))) - (values - (nreverse reqvar) - (nreverse optvar) (nreverse optinit) (nreverse optsvar) - rest - keyflag - (nreverse keyword) (nreverse keyvar) (nreverse keyinit) (nreverse keysvar) - allow-other-keys - env))) + lambdalist)) + (values + (nreverse reqvar) + (nreverse optvar) (nreverse optinit) (nreverse optsvar) + rest + keyflag + (nreverse keyword) (nreverse keyvar) (nreverse keyinit) (nreverse keysvar) + allow-other-keys + env))) ) ; macrolet Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3186 retrieving revision 1.3187 diff -u -d -r1.3186 -r1.3187 --- ChangeLog 16 Jun 2004 11:12:27 -0000 1.3186 +++ ChangeLog 16 Jun 2004 11:13:27 -0000 1.3187 @@ -1,3 +1,8 @@ +2004-06-13 Bruno Haible <br...@cl...> + + * lambdalist.lisp (analyze-lambdalist, analyze-defsetf-lambdalist): + Improved error messages. + 2004-06-05 Bruno Haible <br...@cl...> * clos-genfun5.lisp (missing-required-method): New function. --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |