summaryrefslogtreecommitdiff
path: root/module/ice-9/psyntax.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/ice-9/psyntax.scm')
-rw-r--r--module/ice-9/psyntax.scm52
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)))