summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-11-16 02:56:43 +0100
committerAndy Wingo <wingo@pobox.com>2010-11-16 02:57:27 +0100
commit2090f909b4675286b0de11936771a77a515d885e (patch)
tree7b09e68cb941d4a9443475b26177c153be88e053
parent6cb423613ebf6103d15be355041bdd789c3cb05a (diff)
downloadguile-2090f909b4675286b0de11936771a77a515d885e.tar.gz
add proper pretty-printing for syntax errors
* module/system/repl/repl.scm (display-syntax-error): New helper, displays a syntax error. (abort-on-error, run-repl): Use it. * libguile/throw.c (handler_message): Re-code the same thing in C.
-rw-r--r--libguile/throw.c55
-rw-r--r--module/system/repl/repl.scm27
2 files changed, 79 insertions, 3 deletions
diff --git a/libguile/throw.c b/libguile/throw.c
index 238c52c5e..623407749 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -341,7 +341,60 @@ handler_message (void *handler_data, SCM tag, SCM args)
char *prog_name = (char *) handler_data;
SCM p = scm_current_error_port ();
- if (scm_ilength (args) == 4)
+ if (scm_is_eq (tag, scm_from_locale_symbol ("syntax-error"))
+ && scm_ilength (args) >= 5)
+ {
+ SCM who = SCM_CAR (args);
+ SCM what = SCM_CADR (args);
+ SCM where = SCM_CADDR (args);
+ SCM form = SCM_CADDDR (args);
+ SCM subform = SCM_CAR (SCM_CDDDDR (args));
+
+ scm_puts ("Syntax error:\n", p);
+
+ if (scm_is_true (where))
+ {
+ SCM file, line, col;
+
+ file = scm_assq_ref (where, scm_sym_filename);
+ line = scm_assq_ref (where, scm_sym_line);
+ col = scm_assq_ref (where, scm_sym_column);
+
+ if (scm_is_true (file))
+ scm_display (file, p);
+ else
+ scm_puts ("unknown file", p);
+ scm_puts (": ", p);
+ scm_display (line, p);
+ scm_puts (": ", p);
+ scm_display (col, p);
+ scm_puts (": ", p);
+ }
+ else
+ scm_puts ("unknown location: ", p);
+
+ if (scm_is_true (who))
+ {
+ scm_display (who, p);
+ scm_puts (": ", p);
+ }
+
+ scm_display (what, p);
+
+ if (scm_is_true (subform))
+ {
+ scm_puts (" in subform ", p);
+ scm_write (subform, p);
+ scm_puts (" of ", p);
+ scm_write (form, p);
+ }
+ else if (scm_is_true (form))
+ {
+ scm_puts (" in form ", p);
+ scm_write (form, p);
+ }
+ }
+ else if (scm_ilength (args) == 4)
{
SCM stack = scm_make_stack (SCM_BOOL_T, SCM_EOL);
SCM subr = SCM_CAR (args);
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index fbe7b12bc..237919edb 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -90,6 +90,23 @@
(define* (start-repl #:optional (lang (current-language)) #:key debug)
(run-repl (make-repl lang debug)))
+(define (display-syntax-error port who what where form subform extra)
+ (format port "Syntax error:~%")
+ (if where
+ (let ((file (or (assq-ref where 'filename) "unknown file"))
+ (line (assq-ref where 'line))
+ (col (assq-ref where 'column)))
+ (format port "~a:~a:~a: " file line col))
+ (format port "unknown location: "))
+ (if who
+ (format port "~a: " who))
+ (format port "~a" what)
+ (if subform
+ (format port " in subform ~s of ~s" subform form)
+ (if form
+ (format port " in form ~s" form)))
+ (newline port))
+
;; (put 'abort-on-error 'scheme-indent-function 1)
(define-syntax abort-on-error
(syntax-rules ()
@@ -98,8 +115,11 @@
(lambda () exp)
(lambda (key . args)
(format #t "While ~A:~%" string)
- (pmatch args
- ((,subr ,msg ,args . ,rest)
+ (pmatch (cons key args)
+ ((syntax-error ,who ,message ,where ,form ,subform . ,rest)
+ (display-syntax-error (current-output-port)
+ who message where form subform rest))
+ ((_ ,subr ,msg ,args . ,rest)
(display-error #f (current-output-port) subr msg args rest))
(else
(format #t "ERROR: Throw to key `~a' with args `~s'.\n" key args)))
@@ -131,6 +151,9 @@
(begin
(format #t "While executing meta-command:~%")
(pmatch args
+ ((syntax-error ,who ,message ,where ,form ,subform . ,rest)
+ (display-syntax-error (current-output-port)
+ who message where form subform rest))
((,subr ,msg ,args . ,rest)
(display-error #f (current-output-port) subr msg args rest))
(else