diff --git a/am/bootstrap.am b/am/bootstrap.am index f38a98032..4736d04b6 100644 --- a/am/bootstrap.am +++ b/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 \ diff --git a/libguile.h b/libguile.h index fedaff9a3..b7211f4f3 100644 --- a/libguile.h +++ b/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" diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 6a615ab1d..1cc0d34b8 100644 --- a/libguile/Makefile.am +++ b/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 \ diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 4a19d4b8a..73b80075e 100644 --- a/libguile/backtrace.c +++ b/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" diff --git a/libguile/debug.c b/libguile/debug.c index 8b6122642..d0978adf7 100644 --- a/libguile/debug.c +++ b/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" diff --git a/libguile/deprecated.c b/libguile/deprecated.c index b2f941912..8078b680d 100644 --- a/libguile/deprecated.c +++ b/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 diff --git a/libguile/deprecated.h b/libguile/deprecated.h index df785d871..ab99d6581 100644 --- a/libguile/deprecated.h +++ b/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); diff --git a/libguile/eval.c b/libguile/eval.c index de62613b3..21b2e8c17 100644 --- a/libguile/eval.c +++ b/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" diff --git a/libguile/init.c b/libguile/init.c index 4653b5d87..fc86a6145 100644 --- a/libguile/init.c +++ b/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 (); diff --git a/libguile/memoize.c b/libguile/memoize.c index d9e614f62..59a0ffd06 100644 --- a/libguile/memoize.c +++ b/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" diff --git a/libguile/promises.c b/libguile/promises.c index c47bd9086..415842570 100644 --- a/libguile/promises.c +++ b/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" diff --git a/libguile/read.c b/libguile/read.c index 3030b27ed..506fd2e21 100644 --- a/libguile/read.c +++ b/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" diff --git a/libguile/srcprop.c b/libguile/srcprop.c deleted file mode 100644 index 4c2a77b54..000000000 --- a/libguile/srcprop.c +++ /dev/null @@ -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 - . */ - - - - -#ifdef HAVE_CONFIG_H -# include -#endif - -#include - -#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 ("#', 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" -} - diff --git a/libguile/srcprop.h b/libguile/srcprop.h deleted file mode 100644 index ea1631bbf..000000000 --- a/libguile/srcprop.h +++ /dev/null @@ -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 - . */ - - - -#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 */ diff --git a/libguile/syntax.c b/libguile/syntax.c index c68b01963..6e298e5e9 100644 --- a/libguile/syntax.c +++ b/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" diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 2e8e25970..101a2755a 100644 --- a/module/ice-9/boot-9.scm +++ b/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. ;;; diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm index 71414b570..6ff24c4c6 100644 --- a/module/ice-9/deprecated.scm +++ b/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)) diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm index 283933064..b77d85552 100644 --- a/module/ice-9/read.scm +++ b/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 - (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))) + (define (annotate line column datum) datum) (%read port annotate identity)) (define* (read-syntax #:optional (port (current-input-port))) diff --git a/module/ice-9/source-properties.scm b/module/ice-9/source-properties.scm new file mode 100644 index 000000000..0fa5336a6 --- /dev/null +++ b/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 +;;; . + +;;; 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))) diff --git a/module/language/cps.scm b/module/language/cps.scm index 42ebb0fe6..aefb68e0e 100644 --- a/module/language/cps.scm +++ b/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) diff --git a/module/language/cps/spec.scm b/module/language/cps/spec.scm index 5864203cb..780b982e0 100644 --- a/module/language/cps/spec.scm +++ b/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) diff --git a/module/language/ecmascript/compile-tree-il.scm b/module/language/ecmascript/compile-tree-il.scm index d61f7120d..6acdd3b4f 100644 --- a/module/language/ecmascript/compile-tree-il.scm +++ b/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)) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index 431d42bdc..81211a0a1 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/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) diff --git a/module/language/elisp/lexer.scm b/module/language/elisp/lexer.scm index 5a0e6b3ff..f77f0c1c2 100644 --- a/module/language/elisp/lexer.scm +++ b/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 diff --git a/module/language/elisp/parser.scm b/module/language/elisp/parser.scm index a7aeff014..586abbf7e 100644 --- a/module/language/elisp/parser.scm +++ b/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)) diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 78c08c200..43f5f985e 100644 --- a/module/language/tree-il.scm +++ b/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? make-void void-src diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm index 05decf1a9..57f67bc9b 100644 --- a/module/language/tree-il/spec.scm +++ b/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)) diff --git a/module/language/wisp.scm b/module/language/wisp.scm index d53a886a1..97bb508a6 100644 --- a/module/language/wisp.scm +++ b/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 @@ -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)) diff --git a/module/system/base/lalr.scm b/module/system/base/lalr.scm index 49e7e8d46..55e5e6c87 100644 --- a/module/system/base/lalr.scm +++ b/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 diff --git a/test-suite/tests/elisp-reader.test b/test-suite/tests/elisp-reader.test index cf7c15c52..f6d385a27 100644 --- a/test-suite/tests/elisp-reader.test +++ b/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 (language elisp lexer) - :use-module (language elisp parser)) + #:use-module (test-suite lib) + #:use-module (ice-9 source-properties) + #:use-module (language elisp lexer) + #:use-module (language elisp parser)) ; ============================================================================== diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index c0f424e9a..8d2a3d415 100644 --- a/test-suite/tests/reader.test +++ b/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) - (lambda () - (read-string "(+ 1 2 3)"))))) + (let ((sexp (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) - (lambda () - (read-string "'abcde"))))) + (let ((sexp (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) - (lambda () - (read-string "#!foo\nbar\nbaz\n!#\n(hello world)\n"))))) + (let ((sexp (read-string "#!foo\nbar\nbaz\n!#\n(hello world)\n"))) (= 4 (source-property sexp 'line)))) (with-test-prefix "r6rs-hex-escapes" diff --git a/test-suite/tests/srcprop.test b/test-suite/tests/srcprop.test index 4afc31802..d5f27744f 100644 --- a/test-suite/tests/srcprop.test +++ b/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) diff --git a/test-suite/tests/srfi-105.test b/test-suite/tests/srfi-105.test index 34ea47b55..201a6b824 100644 --- a/test-suite/tests/srfi-105.test +++ b/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) diff --git a/test-suite/tests/srfi-119.test b/test-suite/tests/srfi-119.test index 5390a25b3..f52f9d8bc 100644 --- a/test-suite/tests/srfi-119.test +++ b/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 (cut cons '(filename . #f) <>) + (map source-line + (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"