tree-il-src is a vector, replaces tree-il-srcv

* module/language/tree-il.scm (tree-il-src): Always a vector now;
tree-il-srcv is gone.  An incompatible change but we are in the
compiler.
(location): For parse-tree-il, make vector locations instead of alists.
* module/language/tree-il/analyze.scm:
* module/language/tree-il/compile-bytecode.scm:
* module/language/tree-il/compile-cps.scm:
* module/language/tree-il/debug.scm:
* module/language/tree-il/letrectify.scm:
* module/language/tree-il/peval.scm:
* module/system/vm/assembler.scm: Update all uses to expect vectors
instead of alists and to use tree-il-src instead of tree-il-srcv.
* module/language/elisp/compile-tree-il.scm (location): Create vectors,
not alists.
* test-suite/tests/compiler.test ("psyntax"): Update syntax-source
expectation.

module/language/elisp/compile-tree-il.scm

@@ -1,6 +1,6 @@
 ;;; Guile Emacs Lisp
 
-;; Copyright (C) 2009-2011, 2013, 2018 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011, 2013, 2018, 2025 Free Software Foundation, Inc.
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -69,7 +69,9 @@
   (and (pair? x)
        (let ((props (source-properties x)))
          (and (not (null? props))
-              props))))
+              (vector (assq-ref props 'filename)
+                      (assq-ref props 'line)
+                      (assq-ref props 'column))))))
 
 ;;; Values to use for Elisp's nil and t.
 

module/language/tree-il.scm

@@ -1,4 +1,4 @@
-;;;; 	Copyright (C) 2009-2014,2017-2020,2022-2023 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009-2014,2017-2020,2022-2023,2025 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
@@ -21,8 +21,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 match)
   #:use-module (system base syntax)
-  #:export ((tree-il-src/ensure-alist . tree-il-src)
+  #:export (tree-il-src
-            (tree-il-src . tree-il-srcv)
             <void> void? make-void void-src
             <const> const? make-const const-src const-exp
             <primitive-ref> primitive-ref? make-primitive-ref primitive-ref-src primitive-ref-name
@@ -136,19 +135,6 @@
   (<prompt> escape-only? tag body handler)
   (<abort> tag args tail))
 
-(define tree-il-src/ensure-alist
-  (make-procedure-with-setter
-   (lambda (tree)
-     "Return the source location of TREE as a source property alist."
-     ;; psyntax gives us "source vectors"; convert them lazily to reduce
-     ;; allocations.
-    (match (tree-il-src tree)
-      (#(file line column)
-       `((filename . ,file) (line . ,line) (column . ,column)))
-      (src
-       src)))
-   (lambda (tree src)
-     (set! (tree-il-src tree) src))))
 
 
 
@@ -166,7 +152,10 @@
 (define (location x)
   (and (pair? x)
        (let ((props (source-properties x)))
-	 (and (pair? props) props))))
+	 (and (pair? props)
+              (vector (assq-ref props 'filename)
+                      (assq-ref props 'line)
+                      (assq-ref props 'column))))))
 
 (define (parse-tree-il exp)
   (let ((loc (location exp))

module/language/tree-il/analyze.scm

@@ -71,7 +71,7 @@ given `tree-il' element."
                    (cdr results))))))
 
   ;; Extending and shrinking the location stack.
-  (define (extend-locs x locs) (cons (tree-il-srcv x) locs))
+  (define (extend-locs x locs) (cons (tree-il-src x) locs))
   (define (shrink-locs x locs) (cdr locs))
 
   (let ((results
@@ -114,7 +114,7 @@ given `tree-il' element."
      ;; accordingly.
      (let ((refs (binding-info-refs info))
            (vars (binding-info-vars info))
-           (src  (tree-il-srcv x)))
+           (src  (tree-il-src x)))
        (define (extend inner-vars inner-names)
          (fold (lambda (var name vars)
                  (vhash-consq var (list name src) vars))
@@ -525,7 +525,7 @@ given `tree-il' element."
         (match (vhash-assq name defs)
           ((_ . previous-definition)
            (warning 'shadowed-toplevel src name
-                    (tree-il-srcv previous-definition))
+                    (tree-il-src previous-definition))
            defs)
           (#f
            (vhash-consq name x defs))))
@@ -926,7 +926,7 @@ given `tree-il' element."
                     (values #f #f))))))))
 
   (let ((args (call-args call))
-        (src  (tree-il-srcv call)))
+        (src  (tree-il-src call)))
     (call-with-values (lambda () (arities proc))
       (lambda (name arities)
         (define matches?

module/language/tree-il/compile-bytecode.scm

@@ -1,6 +1,6 @@
 ;;; Lightweight compiler directly from Tree-IL to bytecode
 
-;; Copyright (C) 2020-2021,2023 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021,2023,2025 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 License as published by
@@ -604,7 +604,7 @@
     (()
      (let ()
        (define x-thunk
-         (let ((src (tree-il-srcv exp)))
+         (let ((src (tree-il-src exp)))
            (make-lambda src '()
                         (make-lambda-case src '() #f #f #f '() '() exp #f))))
        (values (cons (make-closure 'init x-thunk #f '())

module/language/tree-il/compile-cps.scm

@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013-2015,2017-2021,2023 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015,2017-2021,2023,2025 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
@@ -1309,7 +1309,7 @@ use as the proc slot."
 (define (init-default-value cps name sym subst init body)
   (match (hashq-ref subst sym)
     ((orig-var subst-var box?)
-     (let ((src (tree-il-srcv init)))
+     (let ((src (tree-il-src init)))
        (define (maybe-box cps k make-body)
          (if box?
              (with-cps cps
@@ -1964,10 +1964,10 @@ use as the proc slot."
                    (lambda (cps thunk)
                      (with-cps cps
                        (letk kbody ($kargs () ()
-                                     ($continue krest (tree-il-srcv body)
+                                     ($continue krest (tree-il-src body)
                                        ($primcall 'call-thunk/no-inline #f
                                                   (thunk)))))
-                       (build-term ($prompt kbody khargs (tree-il-srcv body)
+                       (build-term ($prompt kbody khargs (tree-il-src body)
                                      #f tag)))))))
            (with-cps cps
              (letv prim vals apply)
@@ -2223,7 +2223,7 @@ integer."
       (letk kclause ($kclause ('() '() #f '() #f) kbody #f))
       ($ ((lambda (cps)
             (let ((init (build-cont
-                          ($kfun (tree-il-srcv exp) '() init ktail kclause))))
+                          ($kfun (tree-il-src exp) '() init ktail kclause))))
               (with-cps (persistent-intmap (intmap-replace! cps kinit init))
                 kinit))))))))
 

module/language/tree-il/debug.scm

@@ -244,7 +244,7 @@
        (visit tail env))
       (_
        (error "unexpected tree-il" exp)))
-    (match (tree-il-srcv exp)
+    (match (tree-il-src exp)
       (#f #t)
       (#((or #f (? string?)) (? exact-integer?) (? exact-integer?)) #t)
       (src (error "bad src" src)))

module/language/tree-il/letrectify.scm

@@ -1,6 +1,6 @@
 ;;; transformation of top-level bindings into letrec*
 
-;; Copyright (C) 2019-2021,2023 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021,2023,2025 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
@@ -190,7 +190,7 @@
                     (cons name names) (cons var vars) (cons val vals)
                     tail))
       (_
-       (make-letrec (tree-il-srcv tail) #t
+       (make-letrec (tree-il-src tail) #t
                     (list name) (list var) (list val)
                     tail))))
 

module/language/tree-il/peval.scm

@@ -1,6 +1,6 @@
 ;;; Tree-IL partial evaluator
 
-;; Copyright (C) 2011-2014,2017,2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2014,2017,2019-2025 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
@@ -110,7 +110,7 @@
   "Discard all but the first value of X."
   (if (singly-valued-expression? x)
       x
-      (make-primcall (tree-il-srcv x) 'values (list x))))
+      (make-primcall (tree-il-src x) 'values (list x))))
 
 ;; Peval will do a one-pass analysis on the source program to determine
 ;; the set of assigned lexicals, and to identify unreferenced and

module/system/vm/assembler.scm

@@ -582,7 +582,7 @@ N-byte unit."
 
   ;; A list of (pos . source) pairs, indicating source information.  POS
   ;; is relative to the beginning of the text section, and SOURCE is in
-  ;; the same format that source-properties returns.
+  ;; the same format that syntax-sourcev returns.
   ;;
   (sources asm-sources set-asm-sources!)
 
@@ -2900,26 +2900,17 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
 
       (let lp ((sources (asm-sources asm)) (out '()))
         (match sources
-          (((pc . location) . sources)
+          (((pc . #(file line col)) . sources)
-           (let-values (((file line col)
+           (lp sources
-                         ;; Usually CPS records contain a "source
+               ;; Guile line and column numbers are 0-indexed, but
-                         ;; vector" coming from tree-il, but some might
+               ;; they are 1-indexed for DWARF.
-                         ;; contain a source property alist.
+               (if (and line col)
-                         (match location
+                   (cons (list pc
-                           (#(file line col) (values file line col))
+                               (if (string? file) (intern-file file) 0)
-                           (lst (values (assq-ref lst 'filename)
+                               (1+ line)
-                                        (assq-ref lst 'line)
+                               (1+ col))
-                                        (assq-ref lst 'column))))))
+                         out)
-             (lp sources
+                   out)))
-                 ;; Guile line and column numbers are 0-indexed, but
-                 ;; they are 1-indexed for DWARF.
-                 (if (and line col)
-                     (cons (list pc
-                                 (if (string? file) (intern-file file) 0)
-                                 (1+ line)
-                                 (1+ col))
-                           out)
-                     out))))
           (()
            ;; Compilation unit header for .debug_line.  We write in
            ;; DWARF 2 format because more tools understand it than DWARF

test-suite/tests/compiler.test

@@ -75,7 +75,7 @@
       (eq? round (module-ref m 'round))))
 
   (pass-if-equal "syntax-source with read-hash-extend"
-      '((filename . "sample.scm") (line . 2) (column . 5))
+      #("sample.scm" 2 5)
     (with-fluids ((%read-hash-procedures
                    (fluid-ref %read-hash-procedures)))
       (read-hash-extend #\~ (lambda (chr port)