From 7709a56a5467d8d78e1a2d86588be7dd60de3679 Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Fri, 3 May 2013 00:25:10 +0100 Subject: [PATCH] Better error reporting using basic format --- src/boot.lisp | 19 ++++++++++--------- src/compiler.lisp | 31 ++++++++++++++----------------- src/list.lisp | 2 +- src/package.lisp | 4 ++-- src/read.lisp | 8 +++++--- 5 files changed, 32 insertions(+), 32 deletions(-) diff --git a/src/boot.lisp b/src/boot.lisp index 71b98ff..5112039 100644 --- a/src/boot.lisp +++ b/src/boot.lisp @@ -191,11 +191,13 @@ clausules))))) (defmacro ecase (form &rest clausules) - `(case ,form - ,@(append - clausules - `((t - (error "ECASE expression failed.")))))) + (let ((g!form (gensym))) + `(let ((,g!form ,form)) + (case ,g!form + ,@(append + clausules + `((t + (error "ECASE expression failed for the object `~S'." ,g!form)))))))) (defmacro and (&rest forms) (cond @@ -493,7 +495,7 @@ ((symbolp x) (symbol-function x)) (t - (error "Invalid function")))) + (error "Invalid function `~S'." x)))) (defun disassemble (function) (write-line (lambda-code (fdefinition function))) @@ -507,7 +509,7 @@ (oget func "docstring"))) (variable (unless (symbolp x) - (error "Wrong argument type! it should be a symbol")) + (error "The type of documentation `~S' is not a symbol." type)) (oget x "vardoc")))) (defmacro multiple-value-bind (variables value-from &body body) @@ -540,7 +542,7 @@ (defmacro define-setf-expander (access-fn lambda-list &body body) (unless (symbolp access-fn) - (error "ACCESS-FN must be a symbol.")) + (error "ACCESS-FN `~S' must be a symbol." access-fn)) `(progn (push (cons ',access-fn (lambda ,lambda-list ,@body)) *setf-expanders*) ',access-fn)) @@ -616,4 +618,3 @@ (defun error (fmt &rest args) (%throw (apply #'format nil fmt args))) - diff --git a/src/compiler.lisp b/src/compiler.lisp index d802263..7d0a096 100644 --- a/src/compiler.lisp +++ b/src/compiler.lisp @@ -30,7 +30,7 @@ ((integerp arg) (integer-to-string arg)) ((floatp arg) (float-to-string arg)) ((stringp arg) arg) - (t (error "Unknown argument.")))) + (t (error "Unknown argument `~S'." arg)))) args)) ;;; Wrap X with a Javascript code to convert the result from @@ -102,7 +102,7 @@ ((and (listp sd) (car sd) (cddr sd)) sd) (t - (error "Bad slot accessor.")))) + (error "Bad slot description `~S'." sd)))) slots)) (predicate (intern (concat name-string "-P")))) `(progn @@ -124,7 +124,7 @@ (collect `(defun ,accessor-name (x) (unless (,predicate x) - (error ,(concat "The object is not a type " name-string))) + (error "The object `~S' is not of type `~S'" x ,name-string)) (nth ,index x))) ;; TODO: Implement this with a higher level ;; abstraction like defsetf or (defun (setf ..)) @@ -291,7 +291,7 @@ (defun ll-rest-argument (ll) (let ((rest (ll-section '&rest ll))) (when (cdr rest) - (error "Bad lambda-list")) + (error "Bad lambda-list `~S'." ll)) (car rest))) (defun ll-keyword-arguments-canonical (ll) @@ -528,7 +528,7 @@ (cond ((null pairs) (return)) ((null (cdr pairs)) - (error "Odd paris in SETQ")) + (error "Odd pairs in SETQ")) (t (concatf result (concat (setq-pair (car pairs) (cadr pairs)) @@ -830,7 +830,7 @@ (let* ((b (lookup-in-lexenv name *environment* 'block)) (multiple-value-p (member 'multiple-value (binding-declarations b)))) (when (null b) - (error (concat "Unknown block `" (symbol-name name) "'."))) + (error "Return from unknown block `~S'." (symbol-name name))) (push 'used (binding-declarations b)) ;; The binding value is the name of a variable, whose value is the ;; unique identifier of the block as exception. We can't use the @@ -934,7 +934,7 @@ ((symbolp label) (symbol-name label)) ((integerp label) (integer-to-string label))))) (when (null b) - (error (concat "Unknown tag `" n "'."))) + (error "Unknown tag `~S'" label)) (js!selfcall "throw ({" "type: 'tagbody', " @@ -988,7 +988,7 @@ (define-setf-expander %js-vref (var) (let ((new-value (gensym))) (unless (stringp var) - (error "a string was expected")) + (error "`~S' is not a string." var)) (values nil (list var) (list new-value) @@ -1071,8 +1071,7 @@ (bq-process (bq-completely-process (cadr x)))) ((eq (car x) *comma*) (cadr x)) ((eq (car x) *comma-atsign*) - ;; (error ",@~S after `" (cadr x)) - (error "ill-formed")) + (error ",@~S after `" (cadr x))) ;; ((eq (car x) *comma-dot*) ;; ;; (error ",.~S after `" (cadr x)) ;; (error "ill-formed")) @@ -1083,13 +1082,11 @@ (nreconc q (list (list *bq-quote* p))))) (when (eq (car p) *comma*) (unless (null (cddr p)) - ;; (error "Malformed ,~S" p) - (error "Malformed")) + (error "Malformed ,~S" p)) (return (cons *bq-append* (nreconc q (list (cadr p)))))) (when (eq (car p) *comma-atsign*) - ;; (error "Dotted ,@~S" p) - (error "Dotted")) + (error "Dotted ,@~S" p)) ;; (when (eq (car p) *comma-dot*) ;; ;; (error "Dotted ,.~S" p) ;; (error "Dotted")) @@ -1310,7 +1307,7 @@ (defmacro variable-arity (args &body body) (unless (symbolp args) - (error "Bad usage of VARIABLE-ARITY, you must pass a symbol")) + (error "`~S' is not a symbol." args)) `(variable-arity-call ,args (lambda (,args) (code "return " ,@body ";" *newline*)))) @@ -1670,7 +1667,7 @@ (unless (or (symbolp function) (and (consp function) (eq (car function) 'lambda))) - (error "Bad function")) + (error "Bad function designator `~S'" function)) (cond ((translate-function function) (concat (translate-function function) arglist)) @@ -1727,7 +1724,7 @@ (t (compile-funcall name args))))) (t - (error (concat "How should I compile " (prin1-to-string sexp) "?"))))))) + (error "How should I compile `~S'?" sexp)))))) (defvar *compile-print-toplevels* nil) diff --git a/src/list.lisp b/src/list.lisp index 64c03c9..af235dc 100644 --- a/src/list.lisp +++ b/src/list.lisp @@ -29,7 +29,7 @@ t (if (consp x) nil - (error "type-error")))) + (error "The value `~S' is not a type list." x)))) (defun car (x) "Return the CAR part of a cons, or NIL if X is null." diff --git a/src/package.lisp b/src/package.lisp index 7d54cc6..5745d07 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -41,7 +41,7 @@ (defun find-package-or-fail (package-designator) (or (find-package package-designator) - (error "Package unknown."))) + (error "The name `~S' does not designate any package." package-designator))) (defun package-name (package-designator) (let ((package (find-package-or-fail package-designator))) @@ -142,7 +142,7 @@ (defun symbol-package (symbol) (unless (symbolp symbol) - (error "it is not a symbol")) + (error "`~S' is not a symbol." symbol)) (oget symbol "package")) (defun export (symbols &optional (package *package*)) diff --git a/src/read.lisp b/src/read.lisp index 7478b37..bcc5bac 100644 --- a/src/read.lisp +++ b/src/read.lisp @@ -223,7 +223,7 @@ (find-symbol name package) (if (eq external :external) symbol - (error (concat "The symbol '" name "' is not external"))))))) + (error "The symbol `~S' is not external in the package ~S." name package)))))) (defun read-integer (string) (let ((sign 1) @@ -354,7 +354,7 @@ (!parse-integer string junk-allowed) (if num (values num index) - (error "junk detected.")))) + (error "Junk detected.")))) (defvar *eof* (gensym)) (defun ls-read-1 (stream) @@ -391,7 +391,9 @@ (defun ls-read (stream &optional (eof-error-p t) eof-value) (let ((x (ls-read-1 stream))) (if (eq x *eof*) - (if eof-error-p (error "EOF") eof-value) + (if eof-error-p + (error "End of file") + eof-value) x))) (defun ls-read-from-string (string &optional (eof-error-p t) eof-value) -- 1.7.10.4