Support for detailed input locations.

* gint: Upgrade.
* grecs: Upgrade.
* NEWS: Document changes.
* src/cfpeek.c (_print_diag): Fix prototype.
* src/guile.c (grecs-node-ident-locus)
(grecs-node-value-locus): New functions.
(grecs-node-locus): Take optional second argument.  It it is #t,
return full location.
* tests/locus.at: Update.

1 files changed, 106 insertions, 9 deletions

diff --git a/src/guile.c b/src/guile.c
index 6da81b0..254d671 100644
--- a/src/guile.c
+++ b/src/guile.c
@@ -177,6 +177,8 @@ _guile_init_node()
 	((struct _guile_node *) SCM_CDR(obj));
 
 static SCM scm_from_grecs_value(struct grecs_value *val);
+static SCM scm_from_grecs_locus_point(struct grecs_locus_point const *pt);
+static SCM scm_from_grecs_locus(struct grecs_locus const *locus, int simp);
 
 
 SCM_DEFINE_PUBLIC(scm_grecs_node_p, "grecs-node?",
@@ -383,7 +385,39 @@ SCM_DEFINE_PUBLIC(scm_grecs_node_ident, "grecs-node-ident",
         return scm_from_locale_string(gnp->node->ident ? gnp->node->ident : "");
 }
 #undef FUNC_NAME
+
+SCM_DEFINE_PUBLIC(scm_grecs_node_ident_locus, "grecs-node-ident-locus",
+                  1, 1, 0,
+                  (SCM node, SCM full),
+"Returns locus of the @var{node}'s identifier.  Returned value is a cons\n"
+"whose parts depend on @var{full}, which is a boolean value.  If @var{full}\n"
+"is @samp{#f}, which is the default, then returned value is a cons:\n\n"
+"@lisp\n"
+"(@var{file-name} . @var{line-number})\n"
+"@end lisp\n"
+"\n"
+"Oherwise, if @var{full} is @samp{#t}, the function returns the locations\n"
+"where the node begins and ends:\n"
+"@lisp\n"
+"((@var{beg-file-name} @var{beg-line} @var{beg-column}) . \n"
+" (@var{end-file-name} @var{end-line} @var{end-column}))\n"
+"@end lisp\n")
+#define FUNC_NAME s_scm_grecs_node_ident_locus
+{
+        struct _guile_node *gnp;
+	int full_p = 0;
 
+	if (!SCM_UNBNDP(full)) {
+		SCM_ASSERT(scm_is_bool(full), full, SCM_ARG2, FUNC_NAME);
+		full_p = full == SCM_BOOL_T;
+	}
+	
+        SCM_ASSERT(CELL_IS_NODE(node), node, SCM_ARG1, FUNC_NAME);
+        gnp = node_from_scm(node);
+        return scm_from_grecs_locus(&gnp->node->idloc, full_p);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE_PUBLIC(scm_grecs_node_path_list, "grecs-node-path-list",
 		  1, 0, 0,
 		  (SCM node),
@@ -590,23 +624,86 @@ SCM_DEFINE_PUBLIC(scm_grecs_node_value, "grecs-node-value",
 }
 #undef FUNC_NAME
 
-SCM_DEFINE_PUBLIC(scm_grecs_node_locus, "grecs-node-locus",
-		  1, 0, 0,
-		  (SCM node),
-"Returns source location of the @var{node}.  Returned value is a cons:\n\n"
+SCM_DEFINE_PUBLIC(scm_grecs_node_value_locus, "grecs-node-value-locus",
+                  1, 1, 0,
+                  (SCM node, SCM full),
+"Returns locus of the @var{node}'s value.  Returned value is a cons\n"
+"whose parts depend on @var{full}, which is a boolean value.  If @var{full}\n"
+"is @samp{#f}, which is the default, then returned value is a cons:\n\n"
 "@lisp\n"
 "(@var{file-name} . @var{line-number})\n"
+"@end lisp\n"
+"\n"
+"Oherwise, if @var{full} is @samp{#t}, the function returns the locations\n"
+"where the node begins and ends:\n"
+"@lisp\n"
+"((@var{beg-file-name} @var{beg-line} @var{beg-column}) . \n"
+" (@var{end-file-name} @var{end-line} @var{end-column}))\n"
+"@end lisp\n")
+#define FUNC_NAME s_scm_grecs_node_ident_locus
+{
+        struct _guile_node *gnp;
+	int full_p = 0;
+
+        SCM_ASSERT(CELL_IS_NODE(node), node, SCM_ARG1, FUNC_NAME);
+        gnp = node_from_scm(node);
+	if (!SCM_UNBNDP(full)) {
+		SCM_ASSERT(scm_is_bool(full), full, SCM_ARG2, FUNC_NAME);
+		full_p = full == SCM_BOOL_T;
+	}
+        return scm_from_grecs_locus(&gnp->node->v.value->locus, full_p);
+}
+#undef FUNC_NAME
+
+static SCM
+scm_from_grecs_locus_point(struct grecs_locus_point const *pt)
+{
+	return scm_list_3(pt->file ?
+			  scm_from_locale_string(pt->file) : SCM_BOOL_F,
+			  scm_from_uint(pt->line),
+			  scm_from_uint(pt->col));
+}
+
+static SCM
+scm_from_grecs_locus(struct grecs_locus const *locus, int full)
+{
+	return full ?
+		scm_cons(scm_from_grecs_locus_point(&locus->beg),
+			 scm_from_grecs_locus_point(&locus->end)) :
+		scm_cons(locus->beg.file ?
+			 scm_from_locale_string(locus->beg.file) : SCM_BOOL_F,
+			 scm_from_uint(locus->beg.line));
+}
+
+SCM_DEFINE_PUBLIC(scm_grecs_node_locus,
+		  "grecs-node-locus",
+		  1, 1, 0,
+		  (SCM node, SCM full),
+"Returns source location of the @var{node}.  Returned value is a cons\n"
+"whose parts depend on @var{full}, which is a boolean value.  If @var{full}\n"
+"is @samp{#f}, which is the default, then returned value is a cons:\n\n"
+"@lisp\n"
+"(@var{file-name} . @var{line-number})\n"
+"@end lisp\n"
+"\n"
+"Oherwise, if @var{full} is @samp{#t}, the function returns the locations\n"
+"where the node begins and ends:\n"
+"@lisp\n"
+"((@var{beg-file-name} @var{beg-line} @var{beg-column}) . \n"
+" (@var{end-file-name} @var{end-line} @var{end-column}))\n"
 "@end lisp\n")
 #define FUNC_NAME s_scm_grecs_node_locus
 {
 	struct _guile_node *gnp;
-
+	int full_p = 0;
+	
 	SCM_ASSERT(CELL_IS_NODE(node), node, SCM_ARG1, FUNC_NAME);
 	gnp = node_from_scm(node);
-	return scm_cons(gnp->node->locus.file ?
-			scm_from_locale_string(gnp->node->locus.file) :
-			SCM_EOL,
-			scm_from_int(gnp->node->locus.line));
+	if (!SCM_UNBNDP(full)) {
+		SCM_ASSERT(scm_is_bool(full), full, SCM_ARG2, FUNC_NAME);
+		full_p = full == SCM_BOOL_T;
+	}
+	return scm_from_grecs_locus(&gnp->node->locus, full_p);
 }
 #undef FUNC_NAME