mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

read + source properties simplification

Browse source 
* libguile/srcprop.h: Remove internal scm_source_whash declaration.
* libguile/srcprop.c (scm_i_set_source_properties_x)
  (scm_i_has_source_properties): New helpers.
  (scm_source_whash): Make static.

* libguile/read.c (scm_read_sexp): Remove register declarations here;
  let's trust the compiler.  Remove code to incrementally build up a
  copy; instead let's let scm_i_set_source_properties_x handle copying
  the expression if needed.
  (scm_read_quote, scm_read_syntax): Use scm_i_set_source_properties_x.
  (recsexpr): Remove this helper from 1996.
  (scm_read_sharp_extension): Instead of trying to recursively label
  sharp-read subforms with source properties, just label the outside
  form and rely on the macro-expander to propagate it down.
This commit is contained in:
Andy Wingo 2011-05-24 21:25:11 +02:00
parent c0937f0988
commit 26c8cc144f
3 changed files with 43 additions and 110 deletions
Download patch file Download diff file Expand all files Collapse all files

117
libguile/read.c
View file

@ -357,24 +357,20 @@ flush_ws (SCM port, const char *eoferr)
static SCM scm_read_expression (SCM port); static SCM scm_read_expression (SCM port);
static SCM scm_read_sharp (int chr, SCM port); static SCM scm_read_sharp (int chr, SCM port);
static SCM recsexpr (SCM obj, long line, int column, SCM filename);
static SCM static SCM
scm_read_sexp (scm_t_wchar chr, SCM port) scm_read_sexp (scm_t_wchar chr, SCM port)
#define FUNC_NAME "scm_i_lreadparen" #define FUNC_NAME "scm_i_lreadparen"
{ {
register int c; int c;
register SCM tmp; SCM tmp, tl, ans = SCM_EOL;
register SCM tl, ans = SCM_EOL;
SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F;
const int terminating_char = ((chr == '[') ? ']' : ')'); const int terminating_char = ((chr == '[') ? ']' : ')');
/* Need to capture line and column numbers here. */ /* Need to capture line and column numbers here. */
long line = SCM_LINUM (port); long line = SCM_LINUM (port);
int column = SCM_COL (port) - 1; int column = SCM_COL (port) - 1;
c = flush_ws (port, FUNC_NAME); c = flush_ws (port, FUNC_NAME);
if (terminating_char == c) if (terminating_char == c)
return SCM_EOL; return SCM_EOL;
@ -393,12 +389,6 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
/* Build the head of the list structure. */ /* Build the head of the list structure. */
ans = tl = scm_cons (tmp, SCM_EOL); ans = tl = scm_cons (tmp, SCM_EOL);
if (SCM_COPY_SOURCE_P)
ans2 = tl2 = scm_cons (scm_is_pair (tmp)
? copy
: tmp,
SCM_EOL);
while (terminating_char != (c = flush_ws (port, FUNC_NAME))) while (terminating_char != (c = flush_ws (port, FUNC_NAME)))
{ {
SCM new_tail; SCM new_tail;
@ -415,10 +405,6 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
{ {
SCM_SETCDR (tl, tmp = scm_read_expression (port)); SCM_SETCDR (tl, tmp = scm_read_expression (port));
if (SCM_COPY_SOURCE_P)
SCM_SETCDR (tl2, scm_cons (scm_is_pair (tmp) ? copy : tmp,
SCM_EOL));
c = flush_ws (port, FUNC_NAME); c = flush_ws (port, FUNC_NAME);
if (terminating_char != c) if (terminating_char != c)
scm_i_input_error (FUNC_NAME, port, scm_i_input_error (FUNC_NAME, port,
@ -429,27 +415,12 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
new_tail = scm_cons (tmp, SCM_EOL); new_tail = scm_cons (tmp, SCM_EOL);
SCM_SETCDR (tl, new_tail); SCM_SETCDR (tl, new_tail);
tl = new_tail; tl = new_tail;
if (SCM_COPY_SOURCE_P)
{
SCM new_tail2 = scm_cons (scm_is_pair (tmp)
? copy
: tmp, SCM_EOL);
SCM_SETCDR (tl2, new_tail2);
tl2 = new_tail2;
}
} }
exit: exit:
if (SCM_RECORD_POSITIONS_P) if (SCM_RECORD_POSITIONS_P)
scm_hashq_set_x (scm_source_whash, scm_i_set_source_properties_x (ans, line, column, SCM_FILENAME (port));
ans,
scm_make_srcprops (line, column,
SCM_FILENAME (port),
SCM_COPY_SOURCE_P
? ans2
: SCM_UNDEFINED,
SCM_EOL));
return ans; return ans;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -805,16 +776,7 @@ scm_read_quote (int chr, SCM port)
p = scm_cons2 (p, scm_read_expression (port), SCM_EOL); p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
if (SCM_RECORD_POSITIONS_P) if (SCM_RECORD_POSITIONS_P)
scm_hashq_set_x (scm_source_whash, p, scm_i_set_source_properties_x (p, line, column, SCM_FILENAME (port));
scm_make_srcprops (line, column,
SCM_FILENAME (port),
SCM_COPY_SOURCE_P
? (scm_cons2 (SCM_CAR (p),
SCM_CAR (SCM_CDR (p)),
SCM_EOL))
: SCM_UNDEFINED,
SCM_EOL));
return p; return p;
} }
@ -864,16 +826,7 @@ scm_read_syntax (int chr, SCM port)
p = scm_cons2 (p, scm_read_expression (port), SCM_EOL); p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
if (SCM_RECORD_POSITIONS_P) if (SCM_RECORD_POSITIONS_P)
scm_hashq_set_x (scm_source_whash, p, scm_i_set_source_properties_x (p, line, column, SCM_FILENAME (port));
scm_make_srcprops (line, column,
SCM_FILENAME (port),
SCM_COPY_SOURCE_P
? (scm_cons2 (SCM_CAR (p),
SCM_CAR (SCM_CDR (p)),
SCM_EOL))
: SCM_UNDEFINED,
SCM_EOL));
return p; return p;
} }
@ -1332,15 +1285,12 @@ scm_read_sharp_extension (int chr, SCM port)
SCM got; SCM got;
got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port); got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port);
if (!scm_is_eq (got, SCM_UNSPECIFIED))
{ if (scm_is_pair (got) && !scm_i_has_source_properties (got))
if (SCM_RECORD_POSITIONS_P) scm_i_set_source_properties_x (got, line, column, SCM_FILENAME (port));
return (recsexpr (got, line, column,
SCM_FILENAME (port)));
else
return got; return got;
} }
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -1550,53 +1500,6 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
/* Used when recording expressions constructed by `scm_read_sharp ()'. */
static SCM
recsexpr (SCM obj, long line, int column, SCM filename)
{
if (!scm_is_pair(obj)) {
return obj;
} else {
SCM tmp, copy;
/* If this sexpr is visible in the read:sharp source, we want to
keep that information, so only record non-constant cons cells
which haven't previously been read by the reader. */
if (scm_is_false (scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F)))
{
if (SCM_COPY_SOURCE_P)
{
copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename),
SCM_UNDEFINED);
for (tmp = obj; scm_is_pair (tmp); tmp = SCM_CDR (tmp))
{
SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp),
line,
column,
filename),
SCM_UNDEFINED));
copy = SCM_CDR (copy);
}
SCM_SETCDR (copy, tmp);
}
else
{
recsexpr (SCM_CAR (obj), line, column, filename);
for (tmp = obj; scm_is_pair (tmp); tmp = SCM_CDR (tmp))
recsexpr (SCM_CAR (tmp), line, column, filename);
copy = SCM_UNDEFINED;
}
scm_hashq_set_x (scm_source_whash,
obj,
scm_make_srcprops (line,
column,
filename,
copy,
SCM_EOL));
}
return obj;
}
}
/* Manipulate the read-hash-procedures alist. This could be written in /* Manipulate the read-hash-procedures alist. This could be written in
Scheme, but maybe it will also be used by C code during initialisation. */ Scheme, but maybe it will also be used by C code during initialisation. */
SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0, SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0,

30
libguile/srcprop.c
View file

@ -38,6 +38,8 @@
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/srcprop.h" #include "libguile/srcprop.h"
#include "libguile/private-options.h"
/* {Source Properties} /* {Source Properties}
* *
@ -57,7 +59,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename");
SCM_GLOBAL_SYMBOL (scm_sym_copy, "copy"); SCM_GLOBAL_SYMBOL (scm_sym_copy, "copy");
SCM_GLOBAL_SYMBOL (scm_sym_line, "line"); SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
SCM_GLOBAL_SYMBOL (scm_sym_column, "column"); SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
SCM scm_source_whash; static SCM scm_source_whash;
@ -186,6 +188,32 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
int
scm_i_has_source_properties (SCM obj)
#define FUNC_NAME "%set-source-properties"
{
SCM_VALIDATE_NIM (1, obj);
return scm_is_true (scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F));
}
#undef FUNC_NAME
void
scm_i_set_source_properties_x (SCM obj, long line, int col, SCM fname)
#define FUNC_NAME "%set-source-properties"
{
SCM_VALIDATE_NIM (1, obj);
scm_hashq_set_x (scm_source_whash, obj,
scm_make_srcprops (line, col, fname,
SCM_COPY_SOURCE_P
? scm_copy_tree (obj)
: SCM_UNDEFINED,
SCM_EOL));
}
#undef FUNC_NAME
SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
(SCM obj, SCM key), (SCM obj, SCM key),
"Return the source property specified by @var{key} from\n" "Return the source property specified by @var{key} from\n"

4
libguile/srcprop.h
View file

@ -33,7 +33,6 @@
#define SCM_SOURCE_PROPERTY_FLAG_BREAK 1 #define SCM_SOURCE_PROPERTY_FLAG_BREAK 1
SCM_API scm_t_bits scm_tc16_srcprops; SCM_API scm_t_bits scm_tc16_srcprops;
SCM_INTERNAL SCM scm_source_whash;
SCM_API SCM scm_sym_filename; SCM_API SCM scm_sym_filename;
SCM_API SCM scm_sym_copy; SCM_API SCM scm_sym_copy;
@ -47,6 +46,9 @@ 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_set_source_property_x (SCM obj, SCM key, SCM datum);
SCM_API SCM scm_source_properties (SCM obj); SCM_API SCM scm_source_properties (SCM obj);
SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props); SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props);
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 fname);
SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y); SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y);
SCM_INTERNAL void scm_init_srcprop (void); SCM_INTERNAL void scm_init_srcprop (void);