summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-05-24 21:25:11 +0200
committerAndy Wingo <wingo@pobox.com>2011-05-24 22:41:11 +0200
commit26c8cc144f4d58871098347df7462ea60b72a72c (patch)
tree11ade9f795d50a63afda6d25593f2a3146448813
parentc0937f0988d202d1062fea6e5b61d68d387d1542 (diff)
downloadguile-26c8cc144f4d58871098347df7462ea60b72a72c.tar.gz
read + source properties simplification
* 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.
-rw-r--r--libguile/read.c119
-rw-r--r--libguile/srcprop.c30
-rw-r--r--libguile/srcprop.h4
3 files changed, 43 insertions, 110 deletions
diff --git a/libguile/read.c b/libguile/read.c
index 3760ce135..4d22ead8a 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -357,24 +357,20 @@ flush_ws (SCM port, const char *eoferr)
static SCM scm_read_expression (SCM port);
static SCM scm_read_sharp (int chr, SCM port);
-static SCM recsexpr (SCM obj, long line, int column, SCM filename);
static SCM
scm_read_sexp (scm_t_wchar chr, SCM port)
#define FUNC_NAME "scm_i_lreadparen"
{
- register int c;
- register SCM tmp;
- register SCM tl, ans = SCM_EOL;
- SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F;
+ int c;
+ SCM tmp, tl, ans = SCM_EOL;
const int terminating_char = ((chr == '[') ? ']' : ')');
/* Need to capture line and column numbers here. */
long line = SCM_LINUM (port);
int column = SCM_COL (port) - 1;
-
c = flush_ws (port, FUNC_NAME);
if (terminating_char == c)
return SCM_EOL;
@@ -393,12 +389,6 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
/* Build the head of the list structure. */
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)))
{
SCM new_tail;
@@ -415,10 +405,6 @@ scm_read_sexp (scm_t_wchar chr, SCM 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);
if (terminating_char != c)
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);
SCM_SETCDR (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:
if (SCM_RECORD_POSITIONS_P)
- scm_hashq_set_x (scm_source_whash,
- ans,
- scm_make_srcprops (line, column,
- SCM_FILENAME (port),
- SCM_COPY_SOURCE_P
- ? ans2
- : SCM_UNDEFINED,
- SCM_EOL));
+ scm_i_set_source_properties_x (ans, line, column, SCM_FILENAME (port));
+
return ans;
}
#undef FUNC_NAME
@@ -805,16 +776,7 @@ scm_read_quote (int chr, SCM port)
p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
if (SCM_RECORD_POSITIONS_P)
- scm_hashq_set_x (scm_source_whash, p,
- 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));
-
+ scm_i_set_source_properties_x (p, line, column, SCM_FILENAME (port));
return p;
}
@@ -864,16 +826,7 @@ scm_read_syntax (int chr, SCM port)
p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
if (SCM_RECORD_POSITIONS_P)
- scm_hashq_set_x (scm_source_whash, p,
- 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));
-
+ scm_i_set_source_properties_x (p, line, column, SCM_FILENAME (port));
return p;
}
@@ -1332,14 +1285,11 @@ scm_read_sharp_extension (int chr, SCM port)
SCM got;
got = scm_call_2 (proc, SCM_MAKE_CHAR (chr), port);
- if (!scm_is_eq (got, SCM_UNSPECIFIED))
- {
- if (SCM_RECORD_POSITIONS_P)
- return (recsexpr (got, line, column,
- SCM_FILENAME (port)));
- else
- return got;
- }
+
+ if (scm_is_pair (got) && !scm_i_has_source_properties (got))
+ scm_i_set_source_properties_x (got, line, column, SCM_FILENAME (port));
+
+ return got;
}
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
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,
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index 4eb1ccaac..64b39fdfc 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -38,6 +38,8 @@
#include "libguile/validate.h"
#include "libguile/srcprop.h"
+#include "libguile/private-options.h"
+
/* {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_line, "line");
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
+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 obj, SCM key),
"Return the source property specified by @var{key} from\n"
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index 5c9ccb960..250756dcc 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -33,7 +33,6 @@
#define SCM_SOURCE_PROPERTY_FLAG_BREAK 1
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_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_source_properties (SCM obj);
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_INTERNAL void scm_init_srcprop (void);