From 8d5d0425ce10dcf035fbf717852938291261bd7e Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Thu, 15 Aug 2013 03:59:15 -0400
Subject: [PATCH] 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.
---
 module/Makefile.am              | 1 +
 module/ice-9/match.scm          | 4 ++--
 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))))
-- 
2.20.1