Move source properties out to a module

* module/ice-9/source-properties.scm: New file, providing the
source-properties API, as well as a replacement for `read' that always
attaches source properties, regardless of the 'positions option on the
port.

* am/bootstrap.am (SOURCES): Add the new file.

* libguile/srcprop.c:
* libguile/srcprop.h: Remove.

* libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES):
(DOT_X_FILES):
(DOT_DOC_FILES):
(modinclude_HEADERS):
* libguile.h: Remove srcprop.h.

* libguile/deprecated.c:
* libguile/deprecated.h: Add deprecation shims for srcprop.h interface.

* libguile/backtrace.c:
* libguile/debug.c:
* libguile/eval.c:
* libguile/init.c:
* libguile/memoize.c:
* libguile/promises.c:
* libguile/read.c:
* libguile/syntax.c: Remove needless srcprop.h includes.

* module/ice-9/boot-9.scm: Reorder some definitions so that deprecated
modules can use the (system syntax internal) module.

* module/ice-9/deprecated.scm: Add shims for Scheme source-properties
interface.

* module/ice-9/read.scm (read): Never attach source properties.  Users
that want source can use read-syntax.

* module/language/cps.scm:
* module/language/cps/spec.scm:
* module/language/ecmascript/compile-tree-il.scm:
* module/language/elisp/compile-tree-il.scm:
* module/language/elisp/lexer.scm:
* module/language/elisp/parser.scm:
* module/language/tree-il.scm:
* module/language/tree-il/spec.scm:
* module/language/wisp.scm:
* module/system/base/lalr.scm:
* test-suite/tests/elisp-reader.test:
* test-suite/tests/reader.test:
* test-suite/tests/srcprop.test:
* test-suite/tests/srfi-105.test:
* test-suite/tests/srfi-119.test: Use the (ice-9 source-properties)
module to get access to source properties.

am/bootstrap.am

@@ -191,6 +191,7 @@ SOURCES =					\
   ice-9/session.scm				\
   ice-9/slib.scm				\
   ice-9/soft-ports.scm				\
+  ice-9/source-properties.scm			\
   ice-9/stack-catch.scm				\
   ice-9/streams.scm				\
   ice-9/string-fun.scm				\

libguile.h

@@ -95,7 +95,6 @@ extern "C" {
 #include "libguile/snarf.h"
 #include "libguile/socket.h"
 #include "libguile/sort.h"
-#include "libguile/srcprop.h"
 #include "libguile/stackchk.h"
 #include "libguile/stime.h"
 #include "libguile/strings.h"

libguile/Makefile.am

@@ -214,7 +214,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES =				\
 	simpos.c				\
 	smob.c					\
 	sort.c					\
-	srcprop.c				\
 	srfi-4.c				\
 	srfi-13.c				\
 	srfi-14.c				\
@@ -326,7 +325,6 @@ DOT_X_FILES =					\
 	simpos.x				\
 	smob.x					\
 	sort.x					\
-	srcprop.x				\
 	srfi-4.x				\
 	srfi-13.x				\
 	srfi-14.x				\
@@ -425,7 +423,6 @@ DOT_DOC_FILES = 				\
 	simpos.doc				\
 	smob.doc				\
 	sort.doc				\
-	srcprop.doc				\
 	srfi-4.doc				\
 	srfi-13.doc				\
 	srfi-14.doc				\
@@ -684,7 +681,6 @@ modinclude_HEADERS =				\
 	snarf.h					\
 	socket.h				\
 	sort.h					\
-	srcprop.h				\
 	srfi-4.h				\
 	srfi-13.h				\
 	srfi-14.h				\

libguile/backtrace.c

@@ -1,6 +1,6 @@
 /* Printing of backtraces and error messages
 
-   Copyright 1996-2001,2003-2004,2006,2009-2011,2014,2018
+   Copyright 1996-2001,2003-2004,2006,2009-2011,2014,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -46,7 +46,6 @@
 #include "ports.h"
 #include "posix.h"
 #include "private-options.h"
-#include "srcprop.h"
 #include "stacks.h"
 #include "strings.h"
 #include "strports.h"

libguile/debug.c

@@ -1,6 +1,6 @@
 /* Debugging extensions for Guile
 
-   Copyright 1995-2003,2006,2008-2013,2018
+   Copyright 1995-2003,2006,2008-2013,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -55,7 +55,6 @@
 #include "programs.h"
 #include "read.h"
 #include "smob.h"
-#include "srcprop.h"
 #include "stackchk.h"
 #include "strports.h"
 #include "struct.h"

libguile/deprecated.c

@@ -28,6 +28,7 @@
 #include "gsubr.h"
 #include "modules.h"
 #include "numbers.h"
+#include "symbols.h"
 #include "threads.h"
 #include "variable.h"
 
@@ -230,6 +231,80 @@ scm_set_object_property_x (SCM obj, SCM key, SCM value)
 }
 
 
+
+
+SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename");
+SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
+SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
+
+static SCM source_properties_var;
+static SCM set_source_properties_var;
+static SCM source_property_var;
+static SCM set_source_property_var;
+static SCM cons_source_var;
+
+static void
+init_source_properties_vars (void)
+{
+  source_properties_var =
+    scm_c_public_lookup ("ice-9 source-properties", "source-properties");
+  set_source_properties_var =
+    scm_c_public_lookup ("ice-9 source-properties", "set-source-properties!");
+  source_property_var =
+    scm_c_public_lookup ("ice-9 source-properties", "source-property");
+  set_source_property_var =
+    scm_c_public_lookup ("ice-9 source-properties", "set-source-property!");
+  cons_source_var =
+    scm_c_public_lookup ("ice-9 source-properties", "cons-source");
+}
+
+static void
+init_source_properties (void)
+{
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_c_issue_deprecation_warning
+    ("The source properties C interface is deprecated.  Invoke the Scheme "
+     "procedures from (ice-9 source-properties) instead.");
+  scm_i_pthread_once (&once, init_source_properties_vars);
+}
+
+SCM
+scm_source_properties (SCM obj)
+{
+  init_source_properties ();
+  return scm_call_1 (scm_variable_ref (source_properties_var), obj);
+}
+
+
+SCM
+scm_set_source_properties_x (SCM obj, SCM alist)
+{
+  init_source_properties ();
+  return scm_call_2 (scm_variable_ref (set_source_properties_var), obj, alist);
+}
+
+SCM
+scm_source_property (SCM obj, SCM key)
+{
+  init_source_properties ();
+  return scm_call_2 (scm_variable_ref (source_property_var), obj, key);
+}
+
+SCM
+scm_set_source_property_x (SCM obj, SCM key, SCM value)
+{
+  init_source_properties ();
+  return scm_call_3 (scm_variable_ref (set_source_property_var), obj, key, value);
+}
+
+SCM
+scm_cons_source (SCM orig, SCM x, SCM y)
+{
+  init_source_properties ();
+  return scm_call_3 (scm_variable_ref (cons_source_var), orig, x, y);
+}
+
+
 
 
 void

libguile/deprecated.h

@@ -46,6 +46,16 @@ SCM_DEPRECATED SCM scm_set_object_properties_x (SCM obj, SCM plist);
 SCM_DEPRECATED SCM scm_object_property (SCM obj, SCM key);
 SCM_DEPRECATED SCM scm_set_object_property_x (SCM obj, SCM key, SCM val);
 
+SCM_DEPRECATED SCM scm_sym_filename;
+SCM_DEPRECATED SCM scm_sym_line;
+SCM_DEPRECATED SCM scm_sym_column;
+SCM_DEPRECATED SCM scm_supports_source_properties_p (SCM obj);
+SCM_DEPRECATED SCM scm_source_property (SCM obj, SCM key);
+SCM_DEPRECATED SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
+SCM_DEPRECATED SCM scm_source_properties (SCM obj);
+SCM_DEPRECATED SCM scm_set_source_properties_x (SCM obj, SCM props);
+SCM_DEPRECATED SCM scm_cons_source (SCM xorig, SCM x, SCM y);
+
 /* Deprecated declarations go here.  */
 
 void scm_i_init_deprecated (void);

libguile/eval.c

@@ -56,7 +56,6 @@
 #include "procprop.h"
 #include "programs.h"
 #include "smob.h"
-#include "srcprop.h"
 #include "stackchk.h"
 #include "strings.h"
 #include "symbols.h"

libguile/init.c

@@ -124,7 +124,6 @@
 #include "smob.h"
 #include "socket.h"
 #include "sort.h"
-#include "srcprop.h"
 #include "srfi-13.h"
 #include "srfi-14.h"
 #include "srfi-4.h"
@@ -431,7 +430,6 @@ scm_i_init_guile (struct gc_stack_addr base)
   scm_init_socket ();
 #endif
   scm_init_sort ();
-  scm_init_srcprop ();     /* requires smob_prehistory */
   scm_init_stackchk ();
 
   scm_init_generalized_vectors ();

libguile/memoize.c

@@ -1,4 +1,4 @@
-/* Copyright 1995-2015,2018
+/* Copyright 1995-2015,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -40,7 +40,6 @@
 #include "pairs.h"
 #include "ports.h"
 #include "print.h"
-#include "srcprop.h"
 #include "strings.h"
 #include "symbols.h"
 #include "threads.h"

libguile/promises.c

@@ -1,4 +1,4 @@
-/* Copyright 1995-2011,2018
+/* Copyright 1995-2011,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -49,7 +49,6 @@
 #include "procs.h"
 #include "programs.h"
 #include "smob.h"
-#include "srcprop.h"
 #include "stackchk.h"
 #include "strings.h"
 #include "threads.h"

libguile/read.c

@@ -1,4 +1,4 @@
-/* Copyright 1995-1997,1999-2001,2003-2004,2006-2012,2014-2021
+/* Copyright 1995-1997,1999-2001,2003-2004,2006-2012,2014-2021,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -54,7 +54,6 @@
 #include "ports.h"
 #include "private-options.h"
 #include "procs.h"
-#include "srcprop.h"
 #include "srfi-13.h"
 #include "srfi-4.h"
 #include "strings.h"

libguile/srcprop.c

@@ -1,326 +0,0 @@
-/* Copyright 1995-2002,2006,2008-2012,2018,2020
-     Free Software Foundation, Inc.
-
-   This file is part of Guile.
-
-   Guile is free software: you can redistribute it and/or modify it
-   under the terms of the GNU Lesser General Public License as published
-   by the Free Software Foundation, either version 3 of the License, or
-   (at your option) any later version.
-
-   Guile is distributed in the hope that it will be useful, but WITHOUT
-   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-   License for more details.
-
-   You should have received a copy of the GNU Lesser General Public
-   License along with Guile.  If not, see
-   <https://www.gnu.org/licenses/>.  */
-
-
-
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <errno.h>
-
-#include "alist.h"
-#include "async.h"
-#include "debug.h"
-#include "gc.h"
-#include "gsubr.h"
-#include "hash.h"
-#include "hashtab.h"
-#include "keywords.h"
-#include "list.h"
-#include "modules.h"
-#include "numbers.h"
-#include "pairs.h"
-#include "ports.h"
-#include "private-options.h"
-#include "smob.h"
-#include "symbols.h"
-#include "weak-table.h"
-
-#include "srcprop.h"
-
-
-
-/* {Source Properties}
- *
- * Properties of source list expressions.
- * Three of these have special meaning:
- *
- * filename    The name of the source file.
- * line	       The source code line number.
- * column      The source code column number.
- *
- * Most properties above can be set by the reader.
- *
- */
-
-SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename");
-SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
-SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
-
-static SCM scm_source_whash;
-
-
-/*
- *  Source properties are stored as double cells with the
- *  following layout:
-  
- * car = tag | col (untagged)
- * cbr = line
- * ccr = filename
- * cdr = alist
- */
-
-static scm_t_bits tc16_srcprops;
-
-#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (tc16_srcprops, (p)))
-#define SRCPROPCOL(p) (scm_from_int (SCM_SMOB_FLAGS (p)))
-#define SRCPROPLINE(p) (SCM_SMOB_OBJECT_1 (p))
-#define SRCPROPFNAME(p) (SCM_SMOB_OBJECT_2 (p))
-#define SRCPROPALIST(p) (SCM_SMOB_OBJECT_3 (p))
-#define SETSRCPROPCOL(p, c) (SCM_SET_SMOB_FLAGS (p, scm_to_int (c)))
-#define SETSRCPROPLINE(p, l) (SCM_SET_SMOB_OBJECT_1 (p, l))
-#define SETSRCPROPFNAME(p, x) (SCM_SET_SMOB_OBJECT_2 (p, x))
-#define SETSRCPROPALIST(p, x) (SCM_SET_SMOB_OBJECT_3 (p, x))
-
-
-static SCM scm_srcprops_to_alist (SCM obj);
-
-
-
-static int
-supports_source_props (SCM obj)
-{
-  return SCM_NIMP (obj) && !scm_is_symbol (obj) && !scm_is_keyword (obj);
-}
-
-
-static int
-srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
-{
-  int writingp = SCM_WRITINGP (pstate);
-  scm_puts ("#<srcprops ", port);
-  SCM_SET_WRITINGP (pstate, 1);
-  scm_iprin1 (scm_srcprops_to_alist (obj), port, pstate);
-  SCM_SET_WRITINGP (pstate, writingp);
-  scm_putc ('>', port);
-  return 1;
-}
-
-
-SCM
-scm_i_make_srcprops (SCM line, SCM col, SCM filename, SCM alist)
-{
-  SCM_RETURN_NEWSMOB3 (tc16_srcprops | (scm_to_int (col) << 16),
-                       SCM_UNPACK (line),
-                       SCM_UNPACK (filename),
-                       SCM_UNPACK (alist));
-}
-
-static SCM
-scm_srcprops_to_alist (SCM obj)
-{
-  SCM alist = SRCPROPALIST (obj);
-  if (scm_is_true (SRCPROPFNAME (obj)))
-    alist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), alist);
-  alist = scm_acons (scm_sym_column, SRCPROPCOL (obj), alist);
-  alist = scm_acons (scm_sym_line, SRCPROPLINE (obj), alist);
-  return alist;
-}
-
-SCM_DEFINE (scm_supports_source_properties_p, "supports-source-properties?", 1, 0, 0,
-            (SCM obj),
-            "Return #t if @var{obj} supports adding source properties,\n"
-            "otherwise return #f.")
-#define FUNC_NAME s_scm_supports_source_properties_p
-{
-  return scm_from_bool (supports_source_props (obj));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, 
-            (SCM obj),
-	    "Return the source property association list of @var{obj}.")
-#define FUNC_NAME s_scm_source_properties
-{
-  if (SCM_IMP (obj))
-    return SCM_EOL;
-  else
-    {
-      SCM p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL); 
-
-      if (SRCPROPSP (p))
-        return scm_srcprops_to_alist (p);
-      else
-        /* list from set-source-properties!, or SCM_EOL for not found */
-        return p;
-    }
-}
-#undef FUNC_NAME
-
-#define SCM_VALIDATE_NIM(pos, scm) \
-  SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate")
-
-/* Perhaps this procedure should look through an alist
-   and try to make a srcprops-object...? */
-SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
-            (SCM obj, SCM alist),
-	    "Install the association list @var{alist} as the source property\n"
-	    "list for @var{obj}.")
-#define FUNC_NAME s_scm_set_source_properties_x
-{
-  SCM_VALIDATE_NIM (1, obj);
-
-  scm_weak_table_putq_x (scm_source_whash, obj, alist);
-
-  return alist;
-}
-#undef FUNC_NAME
-
-int
-scm_i_has_source_properties (SCM obj)
-#define FUNC_NAME "%set-source-properties"
-{
-  if (SCM_IMP (obj))
-    return 0;
-  else
-    return scm_is_true (scm_weak_table_refq (scm_source_whash, obj, SCM_BOOL_F));
-}
-#undef FUNC_NAME
-  
-
-void
-scm_i_set_source_properties_x (SCM obj, SCM line, SCM col, SCM fname)
-#define FUNC_NAME "%set-source-properties"
-{
-  SCM_VALIDATE_NIM (1, obj);
-
-  scm_weak_table_putq_x (scm_source_whash, obj,
-                         scm_i_make_srcprops (line, col, fname, SCM_EOL));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
-            (SCM obj, SCM key),
-	    "Return the source property specified by @var{key} from\n"
-	    "@var{obj}'s source property list.")
-#define FUNC_NAME s_scm_source_property
-{
-  SCM p;
-
-  if (SCM_IMP (obj))
-    return SCM_BOOL_F;
-
-  p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
-
-  if (!SRCPROPSP (p))
-    goto alist;
-  if (scm_is_eq (scm_sym_line, key))
-    return SRCPROPLINE (p);
-  else if (scm_is_eq (scm_sym_column, key))
-    return SRCPROPCOL (p);
-  else if (scm_is_eq (scm_sym_filename, key))
-    return SRCPROPFNAME (p);
-  else
-    {
-      p = SRCPROPALIST (p);
-    alist:
-      p = scm_assoc (key, p);
-      return (scm_is_pair (p) ? SCM_CDR (p) : SCM_BOOL_F);
-    }
-}
-#undef FUNC_NAME
-
-static scm_i_pthread_mutex_t source_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
-SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
-            (SCM obj, SCM key, SCM datum),
-	    "Set the source property of object @var{obj}, which is specified by\n"
-	    "@var{key} to @var{datum}.  Normally, the key will be a symbol.")
-#define FUNC_NAME s_scm_set_source_property_x
-{
-  SCM p;
-  SCM_VALIDATE_NIM (1, obj);
-
-  scm_i_pthread_mutex_lock (&source_mutex);
-  p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
-
-  if (scm_is_eq (scm_sym_line, key))
-    {
-      if (SRCPROPSP (p))
-	SETSRCPROPLINE (p, datum);
-      else
-	scm_weak_table_putq_x (scm_source_whash, obj,
-                               scm_i_make_srcprops (datum, SCM_INUM0,
-                                                    SCM_BOOL_F, p));
-    }
-  else if (scm_is_eq (scm_sym_column, key))
-    {
-      if (SRCPROPSP (p))
-	SETSRCPROPCOL (p, datum);
-      else
-	scm_weak_table_putq_x (scm_source_whash, obj,
-                               scm_i_make_srcprops (SCM_INUM0, datum,
-                                                    SCM_BOOL_F, p));
-    }
-  else if (scm_is_eq (scm_sym_filename, key))
-    {
-      if (SRCPROPSP (p))
-	SETSRCPROPFNAME (p, datum);
-      else
-	scm_weak_table_putq_x (scm_source_whash, obj,
-                               scm_i_make_srcprops (SCM_INUM0, SCM_INUM0,
-                                                    datum, p));
-    }
-  else
-    {
-      if (SRCPROPSP (p))
-	SETSRCPROPALIST (p, scm_acons (key, datum, SRCPROPALIST (p)));
-      else
-	scm_weak_table_putq_x (scm_source_whash, obj,
-                               scm_acons (key, datum, p));
-    }
-  scm_i_pthread_mutex_unlock (&source_mutex);
-
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0, 
-            (SCM xorig, SCM x, SCM y),
-	    "Create and return a new pair whose car and cdr are @var{x} and @var{y}.\n"
-	    "Any source properties associated with @var{xorig} are also associated\n"
-	    "with the new pair.")
-#define FUNC_NAME s_scm_cons_source
-{
-  SCM p, z;
-  z = scm_cons (x, y);
-  /* Copy source properties possibly associated with xorig. */
-  p = scm_weak_table_refq (scm_source_whash, xorig, SCM_BOOL_F);
-  if (scm_is_true (p))
-    scm_weak_table_putq_x (scm_source_whash, z, p);
-  return z;
-}
-#undef FUNC_NAME
-
-
-void
-scm_init_srcprop ()
-{
-  tc16_srcprops = scm_make_smob_type ("srcprops", 0);
-  scm_set_smob_print (tc16_srcprops, srcprops_print);
-
-  scm_source_whash = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
-  scm_c_define ("source-whash", scm_source_whash);
-
-#include "srcprop.x"
-}
-

libguile/srcprop.h

@@ -1,53 +0,0 @@
-#ifndef SCM_SRCPROP_H
-#define SCM_SRCPROP_H
-
-/* Copyright 1995-1996,2000-2001,2006,2008-2012,2018,2020
-     Free Software Foundation, Inc.
-
-   This file is part of Guile.
-
-   Guile is free software: you can redistribute it and/or modify it
-   under the terms of the GNU Lesser General Public License as published
-   by the Free Software Foundation, either version 3 of the License, or
-   (at your option) any later version.
-
-   Guile is distributed in the hope that it will be useful, but WITHOUT
-   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-   License for more details.
-
-   You should have received a copy of the GNU Lesser General Public
-   License along with Guile.  If not, see
-   <https://www.gnu.org/licenses/>.  */
-
-
-
-#include "libguile/boolean.h"
-
-
-
-/* {Source properties}
- */
-
-SCM_API SCM scm_sym_filename;
-SCM_API SCM scm_sym_line;
-SCM_API SCM scm_sym_column;
-
-
-
-SCM_API SCM scm_supports_source_properties_p (SCM obj);
-SCM_API SCM scm_source_property (SCM obj, SCM key);
-SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum);
-SCM_API SCM scm_source_properties (SCM obj);
-SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props);
-
-SCM_INTERNAL SCM scm_i_make_srcprops (SCM line, SCM col, SCM fname, SCM alist);
-SCM_INTERNAL int scm_i_has_source_properties (SCM obj);
-SCM_INTERNAL void scm_i_set_source_properties_x (SCM obj, SCM line, SCM col,
-                                                 SCM fname);
-
-SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y);
-SCM_INTERNAL void scm_init_srcprop (void);
-
-
-#endif  /* SCM_SRCPROP_H */

libguile/syntax.c

@@ -31,7 +31,6 @@
 #include "modules.h"
 #include "pairs.h"
 #include "ports.h"
-#include "srcprop.h"
 #include "threads.h"
 #include "variable.h"
 #include "vectors.h"

module/ice-9/boot-9.scm

@@ -4579,14 +4579,6 @@ R7RS."
 
 
 
-;;; {Deprecated stuff}
-;;;
-
-(begin-deprecated
- (module-use! the-scm-module (resolve-interface '(ice-9 deprecated))))
-
-
-
 ;;; {Ports}
 ;;;
 
@@ -4613,6 +4605,44 @@ R7RS."
 
 
 
+;;; A few identifiers that need to be defined in this file are really
+;;; internal implementation details.  We shove them off into internal
+;;; modules, removing them from the (guile) module.
+;;;
+
+(let ((syntax-internal (define-module* '(system syntax internal))))
+  (define (steal-bindings! from to ids)
+    (for-each
+     (lambda (sym)
+       (let ((v (module-local-variable from sym)))
+         (module-remove! from sym)
+         (module-add! to sym v)))
+     ids)
+    (module-export! to ids))
+
+  (steal-bindings! the-root-module
+                   syntax-internal
+                   '(syntax?
+                     syntax-local-binding
+                     %syntax-module
+                     syntax-locally-bound-identifiers
+                     syntax-session-id
+                     make-syntax
+                     syntax-expression
+                     syntax-wrap
+                     syntax-module)))
+
+
+
+
+;;; {Deprecated stuff}
+;;;
+
+(begin-deprecated
+ (module-use! the-scm-module (resolve-interface '(ice-9 deprecated))))
+
+
+
 ;;; {Threads}
 ;;;
 
@@ -4652,37 +4682,6 @@ R7RS."
 
 
 
-;;; A few identifiers that need to be defined in this file are really
-;;; internal implementation details.  We shove them off into internal
-;;; modules, removing them from the (guile) module.
-;;;
-
-(define-module (system syntax internal))
-
-(let ()
-  (define (steal-bindings! from to ids)
-    (for-each
-     (lambda (sym)
-       (let ((v (module-local-variable from sym)))
-         (module-remove! from sym)
-         (module-add! to sym v)))
-     ids)
-    (module-export! to ids))
-
-  (steal-bindings! the-root-module (resolve-module '(system syntax internal))
-                   '(syntax?
-                     syntax-local-binding
-                     %syntax-module
-                     syntax-locally-bound-identifiers
-                     syntax-session-id
-                     make-syntax
-                     syntax-expression
-                     syntax-wrap
-                     syntax-module)))
-
-
-
-
 ;;; Place the user in the guile-user module.
 ;;;
 

module/ice-9/deprecated.scm

@@ -18,6 +18,7 @@
 (define-module (ice-9 deprecated)
   #:use-module (ice-9 guardians)
   #:use-module (ice-9 object-properties)
+  #:use-module (ice-9 source-properties)
   #:use-module (ice-9 weak-tables)
   #:export ((make-guardian* . make-guardian)
             module-observe-weak
@@ -27,7 +28,13 @@
             (make-doubly-weak-hash-table* . make-doubly-weak-hash-table)
             (weak-key-hash-table?* . weak-key-hash-table?)
             (weak-value-hash-table?* . weak-value-hash-table?)
-            (doubly-weak-hash-table?* . doubly-weak-hash-table?)))
+            (doubly-weak-hash-table?* . doubly-weak-hash-table?)
+            (supports-source-properties?* . supports-source-properties?)
+            (source-properties* . source-properties)
+            (set-source-properties!* . set-source-properties!)
+            (source-property* . source-property)
+            (set-source-properties* . set-source-property!)
+            (cons-source* . cons-source)))
 
 #;
 (define-syntax-rule (define-deprecated name message exp)
@@ -115,3 +122,39 @@ Import it from (ice-9 weak-tables) instead.")
    "doubly-weak-hash-table? in the default environment is deprecated.
 Import it from (ice-9 weak-tables) instead.")
   (doubly-weak-hash-table? x))
+
+(define (supports-source-properties?* x)
+  (issue-deprecation-warning
+   "supports-source-properties? in the default environment is deprecated.
+Import it from (ice-9 source-properties) instead.")
+  (supports-source-properties? x))
+
+(define (source-properties* x)
+  (issue-deprecation-warning
+   "source-properties in the default environment is deprecated.
+Import it from (ice-9 source-properties) instead.")
+  (source-properties x))
+
+(define (set-source-properties!* x alist)
+  (issue-deprecation-warning
+   "set-source-properties! in the default environment is deprecated.
+Import it from (ice-9 source-properties) instead.")
+  (set-source-properties! x alist))
+
+(define (source-property* x k)
+  (issue-deprecation-warning
+   "source-property in the default environment is deprecated.
+Import it from (ice-9 source-properties) instead.")
+  (source-property x k))
+
+(define (set-source-property!* x k v)
+  (issue-deprecation-warning
+   "set-source-property! in the default environment is deprecated.
+Import it from (ice-9 source-properties) instead.")
+  (set-source-property! x k v))
+
+(define (cons-source* orig x y)
+  (issue-deprecation-warning
+   "cons-source in the default environment is deprecated.
+Import it from (ice-9 source-properties) instead.")
+  (cons-source orig x y))

module/ice-9/read.scm

@@ -1,5 +1,5 @@
 ;;; Scheme reader
-;;; Copyright (C) 1995-1997,1999-2001,2003-2004,2006-2012,2014-2021
+;;; Copyright (C) 1995-1997,1999-2001,2003-2004,2006-2012,2014-2021,2025
 ;;;   Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
@@ -857,24 +857,7 @@
 
 (define* (read #:optional (port (current-input-port)))
   (define filename (port-filename port))
-  (define annotate
+  (define (annotate line column datum) datum)
-    (if (memq 'positions (read-options))
-        (lambda (line column datum)
-          (when (and (supports-source-properties? datum)
-                     ;; Line or column can be invalid via
-                     ;; set-port-column! or ungetting chars beyond start
-                     ;; of line.
-                     (<= 0 line)
-                     (<= 1 column))
-            ;; We always capture the column after one char of lookahead;
-            ;; subtract off that lookahead value.
-            (set-source-properties! datum
-                                    `((filename . ,filename)
-                                      (line . ,line)
-                                      (column . ,(1- column)))))
-          datum)
-        (lambda (line column datum)
-          datum)))
   (%read port annotate identity))
 
 (define* (read-syntax #:optional (port (current-input-port)))

module/ice-9/source-properties.scm

@@ -0,0 +1,107 @@
+;;; Copyright (C) 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 the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; Code:
+
+
+(define-module (ice-9 source-properties)
+  #:use-module (ice-9 weak-tables)
+  #:use-module (system syntax internal)
+  #:use-module (ice-9 match)
+  ;; FIXME: Change to #:export when deprecated bindings removed.
+  #:replace (supports-source-properties?
+             source-property
+             set-source-property!
+             source-properties
+             set-source-properties!
+             read))
+
+(define global-source-properties (make-weak-key-hash-table))
+
+(define (immediate? x)
+  (cond
+   ((exact-integer? x) (<= most-negative-fixnum x most-positive-fixnum))
+   ((char? x)          #t)
+   ((eq? x #f)         #t)
+   ((eq? x #nil)       #t)
+   ((eq? x '())        #t)
+   ((eq? x #t)         #t)
+   ((unspecified? x)   #t)
+   ((eof-object? x)    #t)
+   (else               #f)))
+
+(define (supports-source-properties? x)
+  (cond
+   ((immediate? x) #f)
+   ((symbol? x) #f)
+   ((keyword? x) #f)
+   (else #t)))
+
+(define (source-properties obj)
+  (if (supports-source-properties? obj)
+      (hashq-ref global-source-properties obj '())
+      '()))
+
+(define (set-source-properties! obj props)
+  (unless (supports-source-properties? obj)
+    (scm-error 'wrong-type-arg "set-source-properties!"
+               "Unexpected immediate value: ~S"
+               (list obj) #f))
+  (hashq-set! global-source-properties obj props))
+
+(define (source-property obj key)
+  (and (supports-source-properties? obj)
+       (assq-ref (source-properties obj) key)))
+
+(define (set-source-property! obj key value)
+  (unless (supports-source-properties? obj)
+    (scm-error 'wrong-type-arg "set-source-properties!"
+               "Unexpected immediate value: ~S"
+               (list obj) #f))
+  (set-source-properties! obj (assq-set! (source-properties obj) key value)))
+
+(define (cons-source orig x y)
+  (let ((pair (cons x y))
+        (src (source-properties orig)))
+    (when (pair? src)
+      (set-source-properties! pair src))
+    pair))
+
+(define* (read #:optional (port (current-input-port)))
+  (define (annotate x src)
+    (when (supports-source-properties? x)
+      (match src
+        (#(filename line column)
+         (set-source-properties! x `((filename . ,filename)
+                                     (line . ,line)
+                                     (column . ,column))))
+        (#f (values))))
+    x)
+  (define (strip-and-annotate x)
+    (cond
+     ((syntax? x)
+      (annotate (strip-and-annotate (syntax-expression x))
+                (syntax-source x)))
+     ((pair? x)
+      (cons (strip-and-annotate (car x))
+            (strip-and-annotate (cdr x))))
+     ((vector? x)
+      (list->vector (map strip-and-annotate (vector->list x))))
+     (else
+      x)))
+  (strip-and-annotate (read-syntax port)))

module/language/cps.scm

@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013-2015,2017-2018,2020,2021 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015,2017-2018,2020,2021,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
@@ -116,6 +116,7 @@
 
 (define-module (language cps)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 source-properties)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-11)

module/language/cps/spec.scm

@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 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
@@ -20,6 +20,7 @@
 
 (define-module (language cps spec)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 source-properties)
   #:use-module (system base language)
   #:use-module (language cps)
   #:use-module (language cps intmap)

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

@@ -1,6 +1,6 @@
 ;;; ECMAScript for Guile
 
-;; Copyright (C) 2009, 2011, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011, 2016, 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,6 +21,7 @@
 (define-module (language ecmascript compile-tree-il)
   #:use-module (language tree-il)
   #:use-module (ice-9 receive)
+  #:use-module (ice-9 source-properties)
   #:use-module (system base pmatch)
   #:use-module (srfi srfi-1)
   #:export (compile-tree-il))

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

@@ -20,6 +20,7 @@
 ;;; Code:
 
 (define-module (language elisp compile-tree-il)
+  #:use-module (ice-9 source-properties)
   #:use-module (language elisp bindings)
   #:use-module (language elisp runtime)
   #:use-module (language tree-il)

module/language/elisp/lexer.scm

@@ -1,6 +1,6 @@
 ;;; Guile Emacs Lisp
 
-;;; Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009, 2010, 2013, 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
@@ -20,6 +20,7 @@
 
 (define-module (language elisp lexer)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 source-properties)
   #:export (get-lexer get-lexer/1))
 
 ;;; This is the lexical analyzer for the elisp reader.  It is

module/language/elisp/parser.scm

@@ -1,6 +1,6 @@
 ;;; Guile Emacs Lisp
 
-;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2009, 2010, 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
@@ -19,6 +19,7 @@
 ;;; Code:
 
 (define-module (language elisp parser)
+  #:use-module (ice-9 source-properties)
   #:use-module (language elisp lexer)
   #:export (read-elisp))
 

module/language/tree-il.scm

@@ -20,6 +20,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 source-properties)
   #:use-module (system base syntax)
   #:export (tree-il-src
             <void> void? make-void void-src

module/language/tree-il/spec.scm

@@ -1,6 +1,6 @@
 ;;; Tree Intermediate Language
 
-;; Copyright (C) 2009-2011,2013,2015,2020 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011,2013,2015,2020,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,6 +21,7 @@
 (define-module (language tree-il spec)
   #:use-module (system base language)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 source-properties)
   #:use-module (language tree-il)
   #:use-module ((language tree-il analyze) #:select (make-analyzer))
   #:use-module ((language tree-il optimize) #:select (make-lowerer))

module/language/wisp.scm

@@ -1,6 +1,6 @@
 ;;; Wisp
 
-;; Copyright (C) 2013, 2017, 2018, 2020, 2024 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2017, 2018, 2020, 2024, 2025, 2025 Free Software Foundation, Inc.
 ;; Copyright (C) 2014--2023 Arne Babenhauserheide.
 ;; Copyright (C) 2023 Maxime Devos <maximedevos@telenet.be>
 
@@ -37,6 +37,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11); for let-values
   #:use-module (srfi srfi-9); for records
+  #:use-module (ice-9 source-properties)
   #:use-module (ice-9 rw); for write-string/partial
   #:use-module (ice-9 match))
 

module/system/base/lalr.scm

@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 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
@@ -21,6 +21,7 @@
   ;; compiler) complains about `lexical-token' being unbound when expanding
   ;; `(define-record-type lexical-token ...)' if we omit it.
   #:use-module (srfi srfi-9)
+  #:use-module (ice-9 source-properties)
 
   #:export (lalr-parser print-states
 

test-suite/tests/elisp-reader.test

@@ -1,6 +1,7 @@
+;;;; -*- scheme -*-
 ;;;; elisp-reader.test --- Test the reader used by the Elisp compiler.
 ;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2025 Free Software Foundation, Inc.
 ;;;; Daniel Kraft
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -18,9 +19,10 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-elisp-reader)
-  :use-module (test-suite lib)
+  #:use-module (test-suite lib)
-  :use-module (language elisp lexer)
+  #:use-module (ice-9 source-properties)
-  :use-module (language elisp parser))
+  #:use-module (language elisp lexer)
+  #:use-module (language elisp parser))
 
 
 ; ==============================================================================

test-suite/tests/reader.test

@@ -20,6 +20,7 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite reader)
+  #:use-module (ice-9 source-properties)
   #:use-module (srfi srfi-1)
   #:use-module (test-suite lib)
   #:use-module (system syntax internal))
@@ -304,30 +305,18 @@
          (with-read-options '(keywords postfix)
            (lambda ()
              (read-string ":")))))
-  (pass-if "no positions"
-    (let ((sexp (with-read-options '()
-                  (lambda ()
-                    (read-string "(+ 1 2 3)")))))
-      (and (not (source-property sexp 'line))
-           (not (source-property sexp 'column)))))
   (pass-if "positions"
-    (let ((sexp (with-read-options '(positions)
+    (let ((sexp (read-string "(+ 1 2 3)")))
-                  (lambda ()
-                    (read-string "(+ 1 2 3)")))))
       (and (equal? (source-property sexp 'line) 0)
            (equal? (source-property sexp 'column) 0))))
   (pass-if "positions on quote"
-    (let ((sexp (with-read-options '(positions)
+    (let ((sexp (read-string "'abcde")))
-                   (lambda ()
-                    (read-string "'abcde")))))
       (and (equal? (source-property sexp 'line) 0)
            (equal? (source-property sexp 'column) 0))))
   (pass-if "position of SCSH block comment"
     ;; In Guile 2.0.0 the reader would not update the port's position
     ;; when reading an SCSH block comment.
-    (let ((sexp (with-read-options '(positions)
+    (let ((sexp (read-string "#!foo\nbar\nbaz\n!#\n(hello world)\n")))
-                  (lambda ()
-                    (read-string "#!foo\nbar\nbaz\n!#\n(hello world)\n")))))
       (= 4 (source-property sexp 'line))))
 
   (with-test-prefix "r6rs-hex-escapes"

test-suite/tests/srcprop.test

@@ -1,6 +1,6 @@
 ;;;; srcprop.test --- test Guile source properties    -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2003, 2006, 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006, 2009, 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
@@ -17,7 +17,8 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite test-srcprop)
-  :use-module (test-suite lib))
+  #:use-module (ice-9 source-properties)
+  #:use-module (test-suite lib))
 
 
 ;;;
@@ -29,7 +30,6 @@
   (pass-if "no props"
     (null? (source-properties (list 1 2 3))))
 
-  (read-enable 'positions)
   (with-test-prefix "read properties"
     (define (reads-with-srcprops? str)
       (let ((x (read (open-input-string str))))
@@ -76,8 +76,6 @@
 ;;;
 
 (with-test-prefix "set-source-property!"
-  (read-enable 'positions)
-
   (pass-if "setting the breakpoint property works"
     (let ((s (read (open-input-string "(+ 3 4)"))))
       (throw 'unresolved)
@@ -100,8 +98,6 @@
 ;;;
 
 (with-test-prefix "set-source-properties!"
-  (read-enable 'positions)
-
   (pass-if "setting the breakpoint property works"
     (let ((s (read (open-input-string "(+ 3 4)"))))
       (throw 'unresolved)

test-suite/tests/srfi-105.test

@@ -1,6 +1,6 @@
 ;;;; srfi-105.test --- Test suite for Guile's SRFI-105 reader. -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2012, 2013, 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
@@ -18,6 +18,7 @@
 
 (define-module (test-srfi-105)
   #:use-module (test-suite lib)
+  #:use-module (ice-9 source-properties)
   #:use-module (srfi srfi-1))
 
 (define (read-string s)
@@ -139,50 +140,22 @@
   (pass-if (equal? '{e[1 2]}                '($bracket-apply$ e 1 2)))
   (pass-if (equal? '{e[1 . 2]}              '($bracket-apply$ e 1 . 2)))
 
-  ;; Verify that source position information is not recorded if not
-  ;; asked for.
-  (with-test-prefix "no positions"
-    (pass-if "simple curly-infix list"
-      (let ((sexp (with-read-options '(curly-infix)
-                    (lambda ()
-                      (read-string " {1 + 2 + 3}")))))
-        (and (not (source-property sexp 'line))
-             (not (source-property sexp 'column)))))
-    (pass-if "mixed curly-infix list"
-      (let ((sexp (with-read-options '(curly-infix)
-                    (lambda ()
-                      (read-string " {1 + 2 * 3}")))))
-        (and (not (source-property sexp 'line))
-             (not (source-property sexp 'column)))))
-    (pass-if "singleton curly-infix list"
-      (let ((sexp (with-read-options '(curly-infix)
-                    (lambda ()
-                      (read-string " { 1.0 }")))))
-        (and (not (source-property sexp 'line))
-             (not (source-property sexp 'column)))))
-    (pass-if "neoteric expression"
-      (let ((sexp (with-read-options '(curly-infix)
-                    (lambda ()
-                      (read-string " { f(x) }")))))
-        (and (not (source-property sexp 'line))
-             (not (source-property sexp 'column))))))
-
   ;; Verify that source position information is properly recorded.
   (with-test-prefix "positions"
     (pass-if "simple curly-infix list"
-      (let ((sexp (with-read-options '(curly-infix positions)
+      (let ((sexp (with-read-options '(curly-infix)
                     (lambda ()
                       (read-string " {1 + 2 + 3}")))))
         (and (equal? (source-property sexp 'line) 0)
              (equal? (source-property sexp 'column) 1))))
     (pass-if "mixed curly-infix list"
-      (let ((sexp (with-read-options '(curly-infix positions)
+      (let ((sexp (with-read-options '(curly-infix)
                     (lambda ()
                       (read-string " {1 + 2 * 3}")))))
         (and (equal? (source-property sexp 'line) 0)
              (equal? (source-property sexp 'column) 1))))
     (pass-if "singleton curly-infix list"
-      (let ((sexp (with-read-options '(curly-infix positions)
+      (let ((sexp (with-read-options '(curly-infix)
                     (lambda ()
                       (read-string " { 1.0 }")))))
         (and (equal? (source-property sexp 'line) 0)
@@ -191,7 +164,7 @@
                ((3) #t)
                (else #f)))))
     (pass-if "neoteric expression"
-      (let ((sexp (with-read-options '(curly-infix positions)
+      (let ((sexp (with-read-options '(curly-infix)
                     (lambda ()
                       (read-string " { f(x) }")))))
         (and (equal? (source-property sexp 'line) 0)

test-suite/tests/srfi-119.test

@@ -1,6 +1,6 @@
 ;;;; srfi-119.test --- Test suite for Guile's SRFI-119 reader. -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2023 Free Software Foundation, Inc.
+;;;; Copyright (C) 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
@@ -20,20 +20,12 @@
   #:use-module (test-suite lib)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26) ;; cut
+  #:use-module (ice-9 source-properties)
   #:use-module (language wisp))
 
 (define (read-string s)
   (with-input-from-string s read))
 
-(define (with-read-options opts thunk)
-  (let ((saved-options (read-options)))
-    (dynamic-wind
-      (lambda ()
-        (read-options opts))
-      thunk
-      (lambda ()
-        (read-options saved-options)))))
-
 (define (wisp->list str)
   (wisp-scheme-read-string str))
 
@@ -97,14 +89,18 @@ _  display \"hello\n\"
   (pass-if-equal '((1 . 2)(3 4 (5 . 6)))
       (wisp->list "1 . 2\n3 4\n   5 . 6")))
 
+(define (source-line props)
+  (or (assq 'line props) (error "expected a line" props)))
+
 (with-test-prefix "wisp-source-properties"
   ;; has properties
   (pass-if (every pair? (map source-properties (wisp->list "1 . 2\n3 4\n   5 . 6"))))
   (pass-if (every pair? (map source-properties (wisp->list "1 2\n3 4\n   5 6"))))
   ;; has the same properties
   (pass-if-equal
-      (map source-properties (scheme->list "(1 . 2)\n(3 4\n   (5 . 6))\n(1 4)\n\n(7 8)"))
+      (map source-line
-      (map (cut cons '(filename . #f) <>)
+           (map source-properties (scheme->list "(1 . 2)\n(3 4\n   (5 . 6))\n(1 4)\n\n(7 8)")))
+      (map source-line
            (map source-properties (wisp->list "1 . 2\n3 4\n   5 . 6\n1 4\n\n7 8")))))
 
 (with-test-prefix "btest"