From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 7 Mar 2018 04:48:07 +0000 (-0800)
Subject: Guarantee that capture-syntactic-environment preserves error context.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~216
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=de04d4f5ec7a45d5539671b3873e92f24494ac44;p=mit-scheme.git

Guarantee that capture-syntactic-environment preserves error context.
---

diff --git a/src/runtime/syntax.scm b/src/runtime/syntax.scm
index a55171869..8ccc85352 100644
--- a/src/runtime/syntax.scm
+++ b/src/runtime/syntax.scm
@@ -296,22 +296,28 @@ USA.
   (make-unsettable-parameter unspecific))
 
 (define (with-error-context form senv hist thunk)
-  (parameterize* (list (cons error-context (list form senv hist)))
+  (parameterize* (list (cons error-context (vector form senv hist)))
 		 thunk))
 
 ;;; External signaller for macros.
 (define (syntax-error message . irritants)
   (let ((context (error-context)))
-    (error:syntax (car context) (cadr context) (caddr context)
-		  message irritants)))
+    (error:syntax (vector-ref context 0)
+		  (vector-ref context 1)
+		  (vector-ref context 2)
+		  message
+		  irritants)))
 
 ;;;; Utilities
 
-(define (capture-syntactic-environment expander)
+(define (capture-syntactic-environment procedure)
   `(,(classifier->keyword
       (lambda (form senv hist)
-	(declare (ignore form))
-	(classify-form (expander senv) senv hist)))))
+	(classify-form (with-error-context form senv hist
+			 (lambda ()
+			   (procedure senv)))
+		       senv
+		       hist)))))
 
 (define (reverse-syntactic-environments senv procedure)
   (capture-syntactic-environment