[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] branch master updated: Clean up srcprops implementation
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] branch master updated: Clean up srcprops implementation |
|
Date: |
Thu, 03 Sep 2020 17:01:01 -0400 |
This is an automated email from the git hooks/post-receive script.
wingo pushed a commit to branch master
in repository guile.
The following commit(s) were added to refs/heads/master by this push:
new 6f6abb3 Clean up srcprops implementation
6f6abb3 is described below
commit 6f6abb3bb57e54444fd68ebcd451032fb5ce19c0
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Sep 3 22:55:08 2020 +0200
Clean up srcprops implementation
* libguile/deprecated.c (scm_sym_copy, scm_make_srcprops): Deprecate.
* libguile/deprecated.h (scm_tc16_srcprops)
(SCM_SOURCE_PROPERTY_FLAG_BREAK): Deprecate.
* libguile/private-options.h (SCM_COPY_SOURCE_P): Remove.
* libguile/read.c (struct t_read_opts, scm_read_options): Remove useless
copy read option.
(maybe_annotate_source): Change line and column to be tagged, and
subtract off lookahead here. Change all callers.
(READ_OPTION_COPY_SOURCE_P): Remove, renumbering other options.
(init_read_options): Remove copy option.
* libguile/srcprop.c: Change to put filename inline in source
properties. Update private implementation.
* libguile/srcprop.h (SCM_PROCTRACEP): Remove. Unusable given that
scm_sym_trace was undefined.
---
libguile/deprecated.c | 17 ++++++
libguile/deprecated.h | 7 +++
libguile/private-options.h | 21 ++++---
libguile/read.c | 100 +++++++++++++++----------------
libguile/srcprop.c | 142 ++++++++++++++++-----------------------------
libguile/srcprop.h | 13 ++---
6 files changed, 137 insertions(+), 163 deletions(-)
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 1cdc9df..0b9ce35 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -27,13 +27,17 @@
#define SCM_BUILDING_DEPRECATED_CODE
+#include "alist.h"
#include "boolean.h"
#include "bitvectors.h"
#include "deprecation.h"
#include "gc.h"
#include "gsubr.h"
+#include "procprop.h"
+#include "srcprop.h"
#include "srfi-4.h"
#include "strings.h"
+#include "symbols.h"
#include "deprecated.h"
@@ -569,6 +573,19 @@ scm_istr2bve (SCM str)
return res;
}
+SCM_GLOBAL_SYMBOL (scm_sym_copy, "copy");
+
+SCM
+scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
+{
+ scm_c_issue_deprecation_warning
+ ("scm_make_srcprops is deprecated; use set-source-properties! instead");
+
+ alist = SCM_UNBNDP (copy) ? alist : scm_acons (scm_sym_copy, copy, alist);
+ return scm_i_make_srcprops (scm_from_long (line), scm_from_int (col),
+ filename, alist);
+}
+
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 81ec7b0..c78e2b1 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -131,6 +131,13 @@ SCM_DEPRECATED SCM scm_bit_position (SCM item, SCM v, SCM
k);
SCM_DEPRECATED SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
SCM_DEPRECATED SCM scm_istr2bve (SCM str);
+#define SCM_SOURCE_PROPERTY_FLAG_BREAK 1
+
+SCM_DEPRECATED scm_t_bits scm_tc16_srcprops;
+SCM_DEPRECATED SCM scm_sym_copy;
+SCM_DEPRECATED SCM scm_make_srcprops (long line, int col, SCM filename,
+ SCM copy, SCM alist);
+
void scm_i_init_deprecated (void);
#endif
diff --git a/libguile/private-options.h b/libguile/private-options.h
index 3580c53..31f4c0e 100644
--- a/libguile/private-options.h
+++ b/libguile/private-options.h
@@ -1,4 +1,4 @@
-/* Copyright 2007,2009-2011,2014,2018
+/* Copyright 2007,2009-2011,2014,2018,2020
Free Software Foundation, Inc.
This file is part of Guile.
@@ -56,16 +56,15 @@ SCM_INTERNAL scm_t_option scm_print_opts[];
*/
SCM_INTERNAL scm_t_option scm_read_opts[];
-#define SCM_COPY_SOURCE_P scm_read_opts[0].val
-#define SCM_RECORD_POSITIONS_P scm_read_opts[1].val
-#define SCM_CASE_INSENSITIVE_P scm_read_opts[2].val
-#define SCM_KEYWORD_STYLE scm_read_opts[3].val
-#define SCM_R6RS_ESCAPES_P scm_read_opts[4].val
-#define SCM_SQUARE_BRACKETS_P scm_read_opts[5].val
-#define SCM_HUNGRY_EOL_ESCAPES_P scm_read_opts[6].val
-#define SCM_CURLY_INFIX_P scm_read_opts[7].val
-#define SCM_R7RS_SYMBOLS_P scm_read_opts[8].val
+#define SCM_RECORD_POSITIONS_P scm_read_opts[0].val
+#define SCM_CASE_INSENSITIVE_P scm_read_opts[1].val
+#define SCM_KEYWORD_STYLE scm_read_opts[2].val
+#define SCM_R6RS_ESCAPES_P scm_read_opts[3].val
+#define SCM_SQUARE_BRACKETS_P scm_read_opts[4].val
+#define SCM_HUNGRY_EOL_ESCAPES_P scm_read_opts[5].val
+#define SCM_CURLY_INFIX_P scm_read_opts[6].val
+#define SCM_R7RS_SYMBOLS_P scm_read_opts[7].val
-#define SCM_N_READ_OPTIONS 9
+#define SCM_N_READ_OPTIONS 8
#endif /* PRIVATE_OPTIONS */
diff --git a/libguile/read.c b/libguile/read.c
index 122a643..69e93e8 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -81,8 +81,6 @@ SCM_SYMBOL (sym_bracket_apply, "$bracket-apply$");
scm_t_option scm_read_opts[] =
{
- { SCM_OPTION_BOOLEAN, "copy", 0,
- "Copy source code expressions." },
{ SCM_OPTION_BOOLEAN, "positions", 1,
"Record positions of source code expressions." },
{ SCM_OPTION_BOOLEAN, "case-insensitive", 0,
@@ -116,7 +114,6 @@ enum t_keyword_style
struct t_read_opts
{
enum t_keyword_style keyword_style;
- unsigned int copy_source_p : 1;
unsigned int record_positions_p : 1;
unsigned int case_insensitive_p : 1;
unsigned int r6rs_escapes_p : 1;
@@ -178,12 +175,7 @@ SCM_DEFINE (scm_read_options, "read-options-interface", 0,
1, 0,
"@code{read-disable}, @code{read-set!} and @code{read-options}.")
#define FUNC_NAME s_scm_read_options
{
- SCM ans = scm_options (setting,
- scm_read_opts,
- FUNC_NAME);
- if (SCM_COPY_SOURCE_P)
- SCM_RECORD_POSITIONS_P = 1;
- return ans;
+ return scm_options (setting, scm_read_opts, FUNC_NAME);
}
#undef FUNC_NAME
@@ -413,20 +405,26 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char
*eoferr)
static SCM scm_read_expression (SCM port, scm_t_read_opts *opts);
static SCM scm_read_sharp (int chr, SCM port, scm_t_read_opts *opts,
- long line, int column);
+ SCM line, SCM column);
static SCM
maybe_annotate_source (SCM x, SCM port, scm_t_read_opts *opts,
- long line, int column)
+ SCM line, SCM column)
{
- /* This condition can be caused by a user calling
- set-port-column!. */
- if (line < 0 || column < 0)
+ if ((SCM_I_INUMP (line) && SCM_I_INUM (line) < 0)
+ || (SCM_I_INUMP (column) && SCM_I_INUM (column) < 1))
+ /* This condition can be caused by a user calling
+ set-port-column!. */
return x;
if (opts->record_positions_p)
- scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port));
+ {
+ /* We always capture the column after one char of lookahead;
+ subtract off that lookahead value. */
+ column = scm_oneminus (column);
+ scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port));
+ }
return x;
}
@@ -442,8 +440,8 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts
*opts)
: ')'));
/* Need to capture line and column numbers here. */
- long line = scm_to_long (scm_port_line (port));
- int column = scm_to_int (scm_port_column (port)) - 1;
+ SCM line = scm_port_line (port);
+ SCM column = scm_port_column (port);
c = flush_ws (port, opts, FUNC_NAME);
if (terminating_char == c)
@@ -620,8 +618,8 @@ scm_read_string_like_syntax (int chr, SCM port,
scm_t_read_opts *opts)
scm_t_wchar c, c_str[READER_STRING_BUFFER_SIZE];
/* Need to capture line and column numbers here. */
- long line = scm_to_long (scm_port_line (port));
- int column = scm_to_int (scm_port_column (port)) - 1;
+ SCM line = scm_port_line (port);
+ SCM column = scm_port_column (port);
while (chr != (c = scm_getc (port)))
{
@@ -747,8 +745,8 @@ scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts
*opts)
size_t bytes_read;
/* Need to capture line and column numbers here. */
- long line = scm_to_long (scm_port_line (port));
- int column = scm_to_int (scm_port_column (port)) - 1;
+ SCM line = scm_port_line (port);
+ SCM column = scm_port_column (port);
scm_ungetc (chr, port);
buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
@@ -874,8 +872,8 @@ static SCM
scm_read_quote (int chr, SCM port, scm_t_read_opts *opts)
{
SCM p;
- long line = scm_to_long (scm_port_line (port));
- int column = scm_to_int (scm_port_column (port)) - 1;
+ SCM line = scm_port_line (port);
+ SCM column = scm_port_column (port);
switch (chr)
{
@@ -921,8 +919,8 @@ static SCM
scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts)
{
SCM p;
- long line = scm_to_long (scm_port_line (port));
- int column = scm_to_int (scm_port_column (port)) - 1;
+ SCM line = scm_port_line (port);
+ SCM column = scm_port_column (port);
switch (chr)
{
@@ -1177,7 +1175,7 @@ scm_read_keyword (int chr, SCM port, scm_t_read_opts
*opts)
static SCM
scm_read_vector (int chr, SCM port, scm_t_read_opts *opts,
- long line, int column)
+ SCM line, SCM column)
{
/* Note: We call `scm_read_sexp ()' rather than READER here in order to
guarantee that it's going to do what we want. After all, this is an
@@ -1222,7 +1220,7 @@ read_decimal_integer (SCM port, int c, ssize_t *resp)
C is the first character read after the '#'. */
static SCM
-scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
+scm_read_array (int c, SCM port, scm_t_read_opts *opts, SCM line, SCM column)
{
ssize_t rank;
scm_t_wchar tag_buf[8];
@@ -1353,14 +1351,14 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts,
long line, int column)
static SCM
scm_read_srfi4_vector (int chr, SCM port, scm_t_read_opts *opts,
- long line, int column)
+ SCM line, SCM column)
{
return scm_read_array (chr, port, opts, line, column);
}
static SCM
scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
- long line, int column)
+ SCM line, SCM column)
{
chr = scm_getc (port);
if (chr != 'u')
@@ -1387,7 +1385,7 @@ scm_read_bytevector (scm_t_wchar chr, SCM port,
scm_t_read_opts *opts,
static SCM
scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
- long line, int column)
+ SCM line, SCM column)
{
/* Read the `#*10101'-style read syntax for bit vectors in Guile. This is
terribly inefficient but who cares? */
@@ -1655,8 +1653,8 @@ scm_read_sharp_extension (int chr, SCM port,
scm_t_read_opts *opts)
proc = scm_get_hash_procedure (chr);
if (scm_is_true (scm_procedure_p (proc)))
{
- long line = scm_to_long (scm_port_line (port));
- int column = scm_to_int (scm_port_column (port)) - 2;
+ SCM line = scm_port_line (port);
+ SCM column = scm_oneminus (scm_port_column (port));
SCM got;
got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port);
@@ -1675,7 +1673,7 @@ scm_read_sharp_extension (int chr, SCM port,
scm_t_read_opts *opts)
among the above token readers. */
static SCM
scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
- long line, int column)
+ SCM line, SCM column)
#define FUNC_NAME "scm_lreadr"
{
SCM result;
@@ -1808,8 +1806,8 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
be part of an unescaped symbol. We might as well do
something useful with it, so we adopt Kawa's convention:
[...] => ($bracket-list$ ...) */
- long line = scm_to_long (scm_port_line (port));
- int column = scm_to_int (scm_port_column (port)) - 1;
+ SCM line = scm_port_line (port);
+ SCM column = scm_port_column (port);
return maybe_annotate_source
(scm_cons (sym_bracket_list, scm_read_sexp (chr, port, opts)),
port, opts, line, column);
@@ -1831,8 +1829,8 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
return (scm_read_quote (chr, port, opts));
case '#':
{
- long line = scm_to_long (scm_port_line (port));
- int column = scm_to_int (scm_port_column (port)) - 1;
+ SCM line = scm_port_line (port);
+ SCM column = scm_port_column (port);
SCM result = scm_read_sharp (chr, port, opts, line, column);
if (scm_is_eq (result, SCM_UNSPECIFIED))
/* We read a comment or some such. */
@@ -1880,8 +1878,8 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
return read_inner_expression (port, opts);
else
{
- long line = 0;
- int column = 0;
+ SCM line = SCM_INUM0;
+ SCM column = SCM_INUM1;
SCM expr;
if (opts->record_positions_p)
@@ -1896,8 +1894,8 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
if (c == EOF)
return SCM_EOF_VAL;
scm_ungetc (c, port);
- line = scm_to_long (scm_port_line (port));
- column = scm_to_int (scm_port_column (port));
+ line = scm_port_line (port);
+ column = scm_port_column (port);
}
expr = read_inner_expression (port, opts);
@@ -2250,18 +2248,17 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
SCM_SYMBOL (sym_port_read_options, "port-read-options");
/* Offsets of bit fields for each per-port override */
-#define READ_OPTION_COPY_SOURCE_P 0
-#define READ_OPTION_RECORD_POSITIONS_P 2
-#define READ_OPTION_CASE_INSENSITIVE_P 4
-#define READ_OPTION_KEYWORD_STYLE 6
-#define READ_OPTION_R6RS_ESCAPES_P 8
-#define READ_OPTION_SQUARE_BRACKETS_P 10
-#define READ_OPTION_HUNGRY_EOL_ESCAPES_P 12
-#define READ_OPTION_CURLY_INFIX_P 14
-#define READ_OPTION_R7RS_SYMBOLS_P 16
+#define READ_OPTION_RECORD_POSITIONS_P 0
+#define READ_OPTION_CASE_INSENSITIVE_P 2
+#define READ_OPTION_KEYWORD_STYLE 4
+#define READ_OPTION_R6RS_ESCAPES_P 6
+#define READ_OPTION_SQUARE_BRACKETS_P 8
+#define READ_OPTION_HUNGRY_EOL_ESCAPES_P 10
+#define READ_OPTION_CURLY_INFIX_P 12
+#define READ_OPTION_R7RS_SYMBOLS_P 14
/* The total width in bits of the per-port overrides */
-#define READ_OPTIONS_NUM_BITS 18
+#define READ_OPTIONS_NUM_BITS 16
#define READ_OPTIONS_INHERIT_ALL ((1UL << READ_OPTIONS_NUM_BITS) - 1)
#define READ_OPTIONS_MAX_VALUE READ_OPTIONS_INHERIT_ALL
@@ -2377,7 +2374,6 @@ init_read_options (SCM port, scm_t_read_opts *opts)
} \
while (0)
- RESOLVE_BOOLEAN_OPTION (COPY_SOURCE_P, copy_source_p);
RESOLVE_BOOLEAN_OPTION (RECORD_POSITIONS_P, record_positions_p);
RESOLVE_BOOLEAN_OPTION (CASE_INSENSITIVE_P, case_insensitive_p);
RESOLVE_BOOLEAN_OPTION (R6RS_ESCAPES_P, r6rs_escapes_p);
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index b644a32..4c2a77b 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-2002,2006,2008-2012,2018
+/* Copyright 1995-2002,2006,2008-2012,2018,2020
Free Software Foundation, Inc.
This file is part of Guile.
@@ -51,19 +51,17 @@
/* {Source Properties}
*
* Properties of source list expressions.
- * Four of these have special meaning:
+ * Three of these have special meaning:
*
- * filename string The name of the source file.
- * copy list A copy of the list expression.
- * line integer The source code line number.
- * column integer The source code column number.
+ * 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_copy, "copy");
SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
@@ -74,30 +72,27 @@ static SCM scm_source_whash;
* Source properties are stored as double cells with the
* following layout:
- * car = tag
- * cbr = pos
- * ccr = copy
+ * car = tag | col (untagged)
+ * cbr = line
+ * ccr = filename
* cdr = alist
*/
-#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p)))
-#define SRCPROPPOS(p) (SCM_SMOB_DATA(p))
-#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12)
-#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL)
-#define SRCPROPCOPY(p) (SCM_SMOB_OBJECT_2(p))
-#define SRCPROPALIST(p) (SCM_SMOB_OBJECT_3(p))
-#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c))
-#define SETSRCPROPPOS(p, l, c) (SCM_SET_SMOB_DATA_1 (p, SRCPROPMAKPOS (l, c)))
-#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p))
-#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c)
-#define SETSRCPROPCOPY(p, c) (SCM_SET_SMOB_OBJECT_2 (p, c))
-#define SETSRCPROPALIST(p, l) (SCM_SET_SMOB_OBJECT_3 (p, l))
+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 SCM scm_srcprops_to_alist (SCM obj);
-scm_t_bits scm_tc16_srcprops;
static int
@@ -120,56 +115,23 @@ srcprops_print (SCM obj, SCM port, scm_print_state
*pstate)
}
-/*
- * We remember the last file name settings, so we can share that alist
- * entry. This works because scm_set_source_property_x does not use
- * assoc-set! for modifying the alist.
- *
- * This variable contains a protected cons, whose cdr is the cached
- * alist
- */
-static SCM scm_last_alist_filename;
-
SCM
-scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
+scm_i_make_srcprops (SCM line, SCM col, SCM filename, SCM alist)
{
- if (!SCM_UNBNDP (filename))
- {
- SCM old_alist = alist;
-
- /*
- have to extract the acons, and operate on that, for
- thread safety.
- */
- SCM last_acons = SCM_CDR (scm_last_alist_filename);
- if (scm_is_null (old_alist)
- && scm_is_eq (SCM_CDAR (last_acons), filename))
- {
- alist = last_acons;
- }
- else
- {
- alist = scm_acons (scm_sym_filename, filename, alist);
- if (scm_is_null (old_alist))
- scm_set_cdr_x (scm_last_alist_filename, alist);
- }
- }
-
- SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops,
- SRCPROPMAKPOS (line, col),
- SCM_UNPACK (copy),
- SCM_UNPACK (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_UNBNDP (SRCPROPCOPY (obj)))
- alist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), alist);
- alist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), alist);
- alist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), alist);
+ 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;
}
@@ -235,17 +197,13 @@ scm_i_has_source_properties (SCM obj)
void
-scm_i_set_source_properties_x (SCM obj, long line, int col, SCM fname)
+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_make_srcprops (line, col, fname,
- SCM_COPY_SOURCE_P
- ? scm_copy_tree (obj)
- : SCM_UNDEFINED,
- SCM_EOL));
+ scm_i_make_srcprops (line, col, fname, SCM_EOL));
}
#undef FUNC_NAME
@@ -265,11 +223,11 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0,
0,
if (!SRCPROPSP (p))
goto alist;
if (scm_is_eq (scm_sym_line, key))
- return scm_from_int (SRCPROPLINE (p));
+ return SRCPROPLINE (p);
else if (scm_is_eq (scm_sym_column, key))
- return scm_from_int (SRCPROPCOL (p));
- else if (scm_is_eq (scm_sym_copy, key))
- return SRCPROPCOPY (p);
+ return SRCPROPCOL (p);
+ else if (scm_is_eq (scm_sym_filename, key))
+ return SRCPROPFNAME (p);
else
{
p = SRCPROPALIST (p);
@@ -280,6 +238,8 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
}
#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"
@@ -289,34 +249,35 @@ SCM_DEFINE (scm_set_source_property_x,
"set-source-property!", 3, 0, 0,
SCM p;
SCM_VALIDATE_NIM (1, obj);
- scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
+ 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, scm_to_int (datum));
+ SETSRCPROPLINE (p, datum);
else
scm_weak_table_putq_x (scm_source_whash, obj,
- scm_make_srcprops (scm_to_int (datum), 0,
- SCM_UNDEFINED,
SCM_UNDEFINED, p));
+ 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, scm_to_int (datum));
+ SETSRCPROPCOL (p, datum);
else
scm_weak_table_putq_x (scm_source_whash, obj,
- scm_make_srcprops (0, scm_to_int (datum),
- SCM_UNDEFINED,
SCM_UNDEFINED, p));
+ scm_i_make_srcprops (SCM_INUM0, datum,
+ SCM_BOOL_F, p));
}
- else if (scm_is_eq (scm_sym_copy, key))
+ else if (scm_is_eq (scm_sym_filename, key))
{
if (SRCPROPSP (p))
- SETSRCPROPCOPY (p, datum);
+ SETSRCPROPFNAME (p, datum);
else
scm_weak_table_putq_x (scm_source_whash, obj,
- scm_make_srcprops (0, 0, SCM_UNDEFINED, datum,
p));
+ scm_i_make_srcprops (SCM_INUM0, SCM_INUM0,
+ datum, p));
}
else
{
@@ -326,7 +287,7 @@ SCM_DEFINE (scm_set_source_property_x,
"set-source-property!", 3, 0, 0,
scm_weak_table_putq_x (scm_source_whash, obj,
scm_acons (key, datum, p));
}
- scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+ scm_i_pthread_mutex_unlock (&source_mutex);
return SCM_UNSPECIFIED;
}
@@ -354,15 +315,12 @@ SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0,
void
scm_init_srcprop ()
{
- scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0);
- scm_set_smob_print (scm_tc16_srcprops, srcprops_print);
+ 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);
- scm_last_alist_filename = scm_cons (SCM_EOL,
- scm_acons (SCM_EOL, SCM_EOL, SCM_EOL));
-
#include "srcprop.x"
}
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index b32203c..ea1631b 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -1,7 +1,7 @@
#ifndef SCM_SRCPROP_H
#define SCM_SRCPROP_H
-/* Copyright 1995-1996,2000-2001,2006,2008-2012,2018
+/* Copyright 1995-1996,2000-2001,2006,2008-2012,2018,2020
Free Software Foundation, Inc.
This file is part of Guile.
@@ -28,27 +28,24 @@
/* {Source properties}
*/
-#define SCM_PROCTRACEP(x) (scm_is_true (scm_procedure_property (x,
scm_sym_trace)))
-#define SCM_SOURCE_PROPERTY_FLAG_BREAK 1
-
-SCM_API scm_t_bits scm_tc16_srcprops;
SCM_API SCM scm_sym_filename;
-SCM_API SCM scm_sym_copy;
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_make_srcprops (long line, int col, SCM fname, SCM copy, SCM
plist);
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, long line, int col,
+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);
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] branch master updated: Clean up srcprops implementation,
Andy Wingo <=