[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 09/13: Add syntax-sourcev
From: |
Andy Wingo |
Subject: |
[Guile-commits] 09/13: Add syntax-sourcev |
Date: |
Thu, 25 Feb 2021 15:39:10 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 07f63cf4f3282234fae83f9e9690e87e3b2d9ed4
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Feb 25 15:15:03 2021 +0100
Add syntax-sourcev
* libguile/syntax.c (sourcev_to_props, props_to_sourcev)
(scm_syntax_source, scm_syntax_sourcev): Add alternate source
representation for syntax objects.
---
libguile/syntax.c | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++---
libguile/syntax.h | 1 +
2 files changed, 53 insertions(+), 3 deletions(-)
diff --git a/libguile/syntax.c b/libguile/syntax.c
index 649e364..2f416d1 100644
--- a/libguile/syntax.c
+++ b/libguile/syntax.c
@@ -24,6 +24,7 @@
# include <config.h>
#endif
+#include "alist.h"
#include "eval.h"
#include "gsubr.h"
#include "keywords.h"
@@ -33,6 +34,7 @@
#include "srcprop.h"
#include "threads.h"
#include "variable.h"
+#include "vectors.h"
#include "syntax.h"
@@ -74,6 +76,27 @@ 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.")
@@ -81,7 +104,9 @@ SCM_DEFINE (scm_make_syntax, "make-syntax", 3, 1, 0,
{
if (SCM_UNBNDP (source))
source = scm_source_properties (exp);
- if (!scm_is_pair (source))
+ if (scm_is_pair (source))
+ source = props_to_sourcev (source);
+ if (!scm_is_vector (source))
source = SCM_BOOL_F;
SCM ret = scm_words (scm_tc7_syntax | HAS_SOURCE_WORD_FLAG, WORD_COUNT);
@@ -126,13 +151,37 @@ SCM_DEFINE (scm_syntax_module, "syntax-module", 1, 0, 0,
SCM_DEFINE (scm_syntax_source, "syntax-source", 1, 0, 0,
(SCM obj),
- "Return the source location information for syntax object
@var{obj}.")
+ "Return the source properties for syntax object @var{obj}, as\n"
+ "an alist possibly containing the keys @code{filename},\n"
+ "@code{line}, and @code{column}. Return @code{#f} if no\n"
+ "source properties are available.")
#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;
- return SCM_CELL_OBJECT (obj, SOURCE_WORD);
+ 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;
}
#undef FUNC_NAME
diff --git a/libguile/syntax.h b/libguile/syntax.h
index 8a98c1d..d860a35 100644
--- a/libguile/syntax.h
+++ b/libguile/syntax.h
@@ -28,6 +28,7 @@ SCM_INTERNAL SCM scm_syntax_expression (SCM obj);
SCM_INTERNAL SCM scm_syntax_wrap (SCM obj);
SCM_INTERNAL SCM scm_syntax_module (SCM obj);
SCM_INTERNAL SCM scm_syntax_source (SCM obj);
+SCM_INTERNAL SCM scm_syntax_sourcev (SCM obj);
SCM_INTERNAL void scm_i_syntax_print (SCM obj, SCM port,
scm_print_state *pstate);
- [Guile-commits] branch master updated (a04a024 -> 697f2b3), Andy Wingo, 2021/02/25
- [Guile-commits] 02/13: Remove top-marked? optimization from psyntax, Andy Wingo, 2021/02/25
- [Guile-commits] 09/13: Add syntax-sourcev,
Andy Wingo <=
- [Guile-commits] 04/13: Ensure that (syntax ()) results in (), Andy Wingo, 2021/02/25
- [Guile-commits] 03/13: Fix module scoping for datum->syntax with no identifier, Andy Wingo, 2021/02/25
- [Guile-commits] 07/13: Commit updates from newest autoconf, Andy Wingo, 2021/02/25
- [Guile-commits] 11/13: Psyntax uses sourcev internally, Andy Wingo, 2021/02/25
- [Guile-commits] 06/13: Read Scheme via read-syntax, Andy Wingo, 2021/02/25
- [Guile-commits] 01/13: Add quote-syntax, Andy Wingo, 2021/02/25
- [Guile-commits] 10/13: Assembler writes vector source properties, Andy Wingo, 2021/02/25
- [Guile-commits] 13/13: Shunt syntax-sourcev to (system syntax internal), Andy Wingo, 2021/02/25
- [Guile-commits] 12/13: read-syntax uses vector source representation, Andy Wingo, 2021/02/25
- [Guile-commits] 05/13: Fix read-syntax on vectors and arrays, Andy Wingo, 2021/02/25