diff options
| author | Mark H Weaver <mhw@netris.org> | 2013-08-15 03:59:15 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2013-08-15 04:07:55 -0400 |
| commit | 8d5d0425ce10dcf035fbf717852938291261bd7e (patch) | |
| tree | 1a8c9c628e357a45954a86d3d0b9323b4004c408 | |
| parent | b57162c3d21fdc9e48572d7a9d4009c37f2c647a (diff) | |
| download | guile-8d5d0425ce10dcf035fbf717852938291261bd7e.tar.gz | |
Improve run-time error reporting in (ice-9 match).
* module/Makefile.am: match.go depends on match.upstream.scm.
* module/ice-9/match.scm (error): Accept any number of arguments.
* module/ice-9/match.upstream.scm (match-next): Call 'error' in non-tail
context, and include the value that failed to match in the call.
| -rw-r--r-- | module/Makefile.am | 1 | ||||
| -rw-r--r-- | module/ice-9/match.scm | 4 | ||||
| -rw-r--r-- | module/ice-9/match.upstream.scm | 5 |
3 files changed, 7 insertions, 3 deletions
diff --git a/module/Makefile.am b/module/Makefile.am index d43be04d6..e8dcd4a13 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -33,6 +33,7 @@ EXTRA_DIST += ice-9/eval.scm ETAGS_ARGS += ice-9/eval.scm ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm ice-9/r6rs-libraries.scm +ice-9/match.go: ice-9/match.scm ice-9/match.upstream.scm # We can compile these in any order, but it's fastest if we compile # psyntax and boot-9 first, then the compiler itself, then the rest of diff --git a/module/ice-9/match.scm b/module/ice-9/match.scm index 7fd191a11..099afb53a 100644 --- a/module/ice-9/match.scm +++ b/module/ice-9/match.scm @@ -24,9 +24,9 @@ match-let* match-letrec)) -(define (error _ msg) +(define (error _ . args) ;; Error procedure for run-time "no matching pattern" errors. - (throw 'match-error "match" msg)) + (apply throw 'match-error "match" args)) ;; Support for record matching. diff --git a/module/ice-9/match.upstream.scm b/module/ice-9/match.upstream.scm index 29f9dbe2e..4609883d2 100644 --- a/module/ice-9/match.upstream.scm +++ b/module/ice-9/match.upstream.scm @@ -284,7 +284,10 @@ (syntax-rules (=>) ;; no more clauses, the match failed ((match-next v g+s) - (error 'match "no matching pattern")) + ;; Here we wrap error within a double set of parentheses, so that + ;; the call to 'error' won't be in tail position. This allows the + ;; backtrace to show the source location of the failing match form. + ((error 'match "no matching pattern" v))) ;; named failure continuation ((match-next v g+s (pat (=> failure) . body) . rest) (let ((failure (lambda () (match-next v g+s . rest)))) |