diff options
Diffstat (limited to 'module/ice-9/psyntax.scm')
-rw-r--r-- | module/ice-9/psyntax.scm | 52 |
1 files changed, 11 insertions, 41 deletions
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 84fcd7262..da2fe8978 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -1,6 +1,6 @@ ;;;; -*-scheme-*- ;;;; -;;;; Copyright (C) 1997-1998,2000-2003,2005-2006,2008-2013,2015-2022,2024 +;;;; Copyright (C) 1997-1998,2000-2003,2005-2006,2008-2013,2015-2022,2024,2025 ;;;; Free Software Foundation, Inc. ;;;; ;;;; This library is free software: you can redistribute it and/or modify @@ -74,8 +74,7 @@ (make-syntax (module-ref (current-module) 'make-syntax)) (syntax-expression (module-ref (current-module) 'syntax-expression)) (syntax-wrap (module-ref (current-module) 'syntax-wrap)) - (syntax-module (module-ref (current-module) 'syntax-module)) - (syntax-sourcev (module-ref (current-module) 'syntax-sourcev))) + (syntax-module (module-ref (current-module) 'syntax-module))) (define-syntax define-expansion-constructors (lambda (x) @@ -303,17 +302,8 @@ (define no-source #f) - (define (datum-sourcev datum) - (let ((props (source-properties datum))) - (and (pair? props) - (vector (assq-ref props 'filename) - (assq-ref props 'line) - (assq-ref props 'column))))) - (define (source-annotation x) - (if (syntax? x) - (syntax-sourcev x) - (datum-sourcev x))) + (and (syntax? x) (syntax-source x))) (define-syntax-rule (arg-check pred? e who) (let ((x e)) @@ -898,7 +888,7 @@ (make-syntax (syntax-expression x) w (or (syntax-module x) defmod) - (syntax-sourcev x))) + (syntax-source x))) (define (source-wrap x w s defmod) (cond ((and (null? (wrap-marks w)) @@ -1863,14 +1853,9 @@ ;; strips syntax objects, recursively. (define (strip x) - (define (annotate proc datum) - (let ((s (proc x))) - (when (and s (supports-source-properties? datum)) - (set-source-properties! datum (sourcev->alist s))) - datum)) (cond ((syntax? x) - (annotate syntax-sourcev (strip (syntax-expression x)))) + (strip (syntax-expression x))) ((pair? x) (cons (strip (car x)) (strip (cdr x)))) ((vector? x) @@ -2179,7 +2164,7 @@ (make-syntax '#{ $sc-ellipsis }# (syntax-wrap #'dots) (syntax-module #'dots) - (syntax-sourcev #'dots))))) + (syntax-source #'dots))))) (let ((ids (list id)) (labels (list (gen-label))) (bindings (list (make-binding 'ellipsis (source-wrap #'dots w s mod))))) @@ -2327,7 +2312,7 @@ (syntax-wrap x) ;; hither the remodulation mod - (syntax-sourcev x))) + (syntax-source x))) ((vector? x) (let* ((n (vector-length x)) (v (make-vector n))) (do ((i 0 (1+ i))) @@ -2592,21 +2577,7 @@ ;; expanded, and the expanded definitions are also residualized into ;; the object file if we are compiling a file. (define*/override (macroexpand x #:optional (m 'e) (esew '(eval))) - (define (unstrip x) - (define (annotate result) - (let ((props (source-properties x))) - (if (pair? props) - (datum->syntax #f result #:source props) - result))) - (cond - ((pair? x) - (annotate (cons (unstrip (car x)) (unstrip (cdr x))))) - ((vector? x) - (let ((v (make-vector (vector-length x)))) - (annotate (list->vector (map unstrip (vector->list x)))))) - ((syntax? x) x) - (else (annotate x)))) - (expand-top-sequence (list (unstrip x)) null-env top-wrap #f m esew + (expand-top-sequence (list x) null-env top-wrap #f m esew (cons 'hygiene (module-name (current-module))))) (define/override (identifier? x) @@ -2626,13 +2597,12 @@ (syntax-module id) #f) (cond - ((not source) - (props->sourcev (source-properties datum))) + ((not source) #f) ((and (list? source) (and-map pair? source)) (props->sourcev source)) ((and (vector? source) (= 3 (vector-length source))) source) - (else (syntax-sourcev source))))) + (else (syntax-source source))))) (define/override (syntax->datum x) ;; accepts any object, since syntax objects may consist partially @@ -3086,7 +3056,7 @@ (define call-with-include-port (let ((syntax-dirname (lambda (stx) (define src (syntax-source stx)) - (define filename (and src (assq-ref src 'filename))) + (define filename (and src (vector-ref src 0))) (and (string? filename) (dirname filename))))) (lambda* (filename proc #:key (dirname (syntax-dirname filename))) |