hackily fix another case where display-exception would be apropos

* module/system/repl/error-handling.scm (display-syntax-error)
  (error-string): Until we get the exception-printing patch merged in,
  copy display-syntax-error into error-handling so that we avoid
  display-error.  Fixes bug 32365.

diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index 7d30bf0..59c44a9 100644 (file)
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -1,6 +1,6 @@
 ;;; Error handling in the REPL
 
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -29,12 +29,38 @@
 
 \f
 
+;; Temporary hacked copy of repl.scm's display-syntax error, until we
+;; merge in the proper display-exception patches.
+(define (display-syntax-error port who what where form subform extra)
+  (display "Syntax error:" port)
+  (newline port)
+  (if where
+      (let ((file (or (assq-ref where 'filename) "unknown file"))
+            (line (and=> (assq-ref where 'line) 1+))
+            (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))
+
 ;;;
 ;;; Error handling via repl debugging
 ;;;
 
 (define (error-string stack key args)
   (pmatch args
+    ((,who ,message ,where ,form ,subform . ,rest)
+     (guard (eq? key 'syntax-error))
+     (with-output-to-string
+       (lambda ()
+         (display-syntax-error (current-output-port)
+                               who message where form subform rest))))
     ((,subr ,msg ,args . ,rest)
      (guard (> (vector-length stack) 0))
      (with-output-to-string