From de04d4f5ec7a45d5539671b3873e92f24494ac44 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 6 Mar 2018 20:48:07 -0800 Subject: [PATCH] Guarantee that capture-syntactic-environment preserves error context. --- src/runtime/syntax.scm | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) 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 -- 2.25.1