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.

diff --git a/libguile/read.c b/libguile/read.c
index 3760ce1..4d22ead 100644 (file)
--- 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,
 
 \f
 
-/* 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 4eb1cca..64b39fd 100644 (file)
--- 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"
+
 \f
 /* {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 5c9ccb9..250756d 100644 (file)
--- 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);