From 26c8cc144f4d58871098347df7462ea60b72a72c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 24 May 2011 21:25:11 +0200 Subject: [PATCH 1/1] 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. --- libguile/read.c | 119 +++++---------------------------------------- libguile/srcprop.c | 30 +++++++++++- libguile/srcprop.h | 4 +- 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); -- 2.20.1