1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00

syntax-source returns a vector

* libguile/syntax.c (HAS_SOURCE_WORD_FLAG): Remove; all syntax objects
now have a source word.
(sourcev_to_props, props_to_sourcev): Remove.
(scm_make_syntax): Require source to be a vector or #f.
(scm_syntax_source): Just return source object.
(scm_syntax_sourcev): Remove.
* libguile/syntax.h: Remove scm_syntax_sourcev.
* module/srfi/srfi-64.scm (syntax->source-properties):
* module/system/base/types.scm (cell->object):
* module/ice-9/boot-9.scm (case, current-source-location, current-filename)
(define-module, load): Adapt for syntax-source returning a vector.
* module/ice-9/psyntax-pp.scm: Regen.
* module/ice-9/psyntax.scm: Rename uses of syntax-sourcev to
syntax-source.
* module/system/syntax.scm (syntax-sourcev): Add deprecated shim.
(print-syntax): Use sourcev.
* module/system/vm/assembler.scm (intern-constant):
(link-data): Always write source word.
* test-suite/tests/reader.test ("read-syntax"): Update expectation.
This commit is contained in:
Andy Wingo 2025-05-12 15:01:35 +02:00
parent 71d112cdde
commit b6b6f62548
10 changed files with 120 additions and 163 deletions

View file

@ -1,4 +1,4 @@
/* Copyright 2017-2018,2021
/* Copyright 2017-2018,2021,2025
Free Software Foundation, Inc.
This file is part of Guile.
@ -41,12 +41,6 @@
/* The source field was added to syntax objects in Guile 3.0.6. However
there can be older syntax objects present in compiled files that
don't have the source field. If a syntax object has a source field,
its tag will have HAS_SOURCE_WORD_FLAG set. */
#define HAS_SOURCE_WORD_FLAG 0x100
enum
{
TAG_WORD,
@ -76,40 +70,17 @@ SCM_DEFINE (scm_syntax_p, "syntax?", 1, 0, 0,
}
#undef FUNC_NAME
static SCM
sourcev_to_props (SCM v)
{
SCM props = scm_acons (scm_sym_line, scm_c_vector_ref (v, 1),
scm_acons (scm_sym_column, scm_c_vector_ref (v, 2),
SCM_EOL));
if (scm_is_true (scm_c_vector_ref (v, 0)))
props = scm_acons (scm_sym_filename, scm_c_vector_ref (v, 0), props);
return props;
}
static SCM
props_to_sourcev (SCM props)
{
SCM v = scm_c_make_vector (3, SCM_BOOL_F);
scm_c_vector_set_x (v, 0, scm_assq_ref (props, scm_sym_filename));
scm_c_vector_set_x (v, 1, scm_assq_ref (props, scm_sym_line));
scm_c_vector_set_x (v, 2, scm_assq_ref (props, scm_sym_column));
return v;
}
SCM_DEFINE (scm_make_syntax, "make-syntax", 3, 1, 0,
(SCM exp, SCM wrap, SCM module, SCM source),
"Make a new syntax object.")
#define FUNC_NAME s_scm_make_syntax
{
if (SCM_UNBNDP (source))
source = scm_source_properties (exp);
if (scm_is_pair (source))
source = props_to_sourcev (source);
if (!scm_is_vector (source))
source = SCM_BOOL_F;
else if (!scm_is_eq (source, SCM_BOOL_F))
SCM_VALIDATE_VECTOR (1, source);
SCM ret = scm_words (scm_tc7_syntax | HAS_SOURCE_WORD_FLAG, WORD_COUNT);
SCM ret = scm_words (scm_tc7_syntax, WORD_COUNT);
SCM_SET_CELL_OBJECT (ret, EXPR_WORD, exp);
SCM_SET_CELL_OBJECT (ret, WRAP_WORD, wrap);
SCM_SET_CELL_OBJECT (ret, MODULE_WORD, module);
@ -158,30 +129,7 @@ SCM_DEFINE (scm_syntax_source, "syntax-source", 1, 0, 0,
#define FUNC_NAME s_scm_syntax_source
{
SCM_VALIDATE_SYNTAX (1, obj);
if (!(SCM_CELL_WORD (obj, TAG_WORD) & HAS_SOURCE_WORD_FLAG))
return SCM_BOOL_F;
SCM src = SCM_CELL_OBJECT (obj, SOURCE_WORD);
if (scm_is_vector (src))
src = sourcev_to_props (src);
return src;
}
#undef FUNC_NAME
SCM_DEFINE (scm_syntax_sourcev, "syntax-sourcev", 1, 0, 0,
(SCM obj),
"Return the source location information for syntax object\n"
"@var{obj}, as a vector of @code{#(@var{filename} @var{line}\n"
"@var{column})}, or @code{#f} if no source properties are\n"
"available.")
#define FUNC_NAME s_scm_syntax_sourcev
{
SCM_VALIDATE_SYNTAX (1, obj);
if (!(SCM_CELL_WORD (obj, TAG_WORD) & HAS_SOURCE_WORD_FLAG))
return SCM_BOOL_F;
SCM src = SCM_CELL_OBJECT (obj, SOURCE_WORD);
if (scm_is_null (src) || scm_is_pair (src))
src = props_to_sourcev (src);
return src;
return SCM_CELL_OBJECT (obj, SOURCE_WORD);
}
#undef FUNC_NAME