From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Improve support for source properties Date: Wed, 15 Feb 2012 12:50:06 -0500 Message-ID: <87r4xw2dgx.fsf@netris.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1329328795 12025 80.91.229.3 (15 Feb 2012 17:59:55 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Wed, 15 Feb 2012 17:59:55 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Feb 15 18:59:54 2012 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Rxj8z-0007p1-GD for guile-devel@m.gmane.org; Wed, 15 Feb 2012 18:59:53 +0100 Original-Received: from localhost ([::1]:36460 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Rxj1U-0007p3-K8 for guile-devel@m.gmane.org; Wed, 15 Feb 2012 12:52:08 -0500 Original-Received: from eggs.gnu.org ([140.186.70.92]:35800) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Rxj1O-0007m6-8r for guile-devel@gnu.org; Wed, 15 Feb 2012 12:52:06 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Rxj1K-0002Qc-66 for guile-devel@gnu.org; Wed, 15 Feb 2012 12:52:02 -0500 Original-Received: from world.peace.net ([96.39.62.75]:59506) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Rxj1J-0002Pq-Va for guile-devel@gnu.org; Wed, 15 Feb 2012 12:51:58 -0500 Original-Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1Rxj0v-0004QA-AI; Wed, 15 Feb 2012 12:51:34 -0500 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 96.39.62.75 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:13860 Archived-At: --=-=-= Content-Type: text/plain Hello all, Here's another patch set to improve support for source properties. In brief: * 'read' now sets source properties on non-immediate numbers: bignums, floats, fractions, complex. * add the 'supports-source-properties?' predicate (as well as scm_supports_source_properties_p), which cannot be implemented efficiently in Scheme. * relax validation checking of source property getters so that they may be applied to _any_ object. Previously, attempts to get source properties of immediate objects would throw an error. * psyntax now accesses and sets source properties for all supported objects. Previously it assumed that only pairs could support source properties. * add tests to verify that 'read' sets source properties appropriately. For ease of reading, the first patch shows only non-whitespace changes, since the bodies of three functions changed indentation level. I very nearly pushed this, but wanted to make sure there were no objections to adding 'supports-source-properties?', or to relaxing the validation of source property getters. What do you think? Okay to push? Thanks, Mark --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Relax-validation-of-source-property-accessors-NO-WS.patch Content-Description: [PATCH 1/5] Relax validation of source property accessors >From fb3a112122b6406e88adbff2299aacc5230cc8ec Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 14 Feb 2012 01:54:15 -0500 Subject: [PATCH 1/5] Relax validation of source property accessors * libguile/srcprop.c (scm_source_properties, scm_source_property, scm_i_has_source_properties): Relax validation to allow _any_ object to be queried for source properties. --- libguile/srcprop.c | 88 +++++++++++++++++++++++++++++---------------------- 1 files changed, 50 insertions(+), 38 deletions(-) diff --git a/libguile/srcprop.c b/libguile/srcprop.c index dc333d4..c43acdf 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -1,4 +1,5 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002, 2006, 2008, 2009, 2010, 2011 Free Software Foundation +/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2006, + * 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -164,8 +164,11 @@ "Return the source property association list of @var{obj}.") #define FUNC_NAME s_scm_source_properties { + if (SCM_IMP (obj)) + return SCM_EOL; + else + { SCM p; - SCM_VALIDATE_NIM (1, obj); scm_i_pthread_mutex_lock (&source_lock); p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); @@ -176,6 +179,7 @@ else /* list from set-source-properties!, or SCM_EOL for not found */ return p; + } } #undef FUNC_NAME @@ -201,15 +201,18 @@ scm_i_has_source_properties (SCM obj) #define FUNC_NAME "%set-source-properties" { + if (SCM_IMP (obj)) + return 0; + else + { int ret; - SCM_VALIDATE_NIM (1, obj); - scm_i_pthread_mutex_lock (&source_lock); ret = scm_is_true (scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F)); scm_i_pthread_mutex_unlock (&source_lock); return ret; + } } #undef FUNC_NAME @@ -237,8 +237,11 @@ "@var{obj}'s source property list.") #define FUNC_NAME s_scm_source_property { + if (SCM_IMP (obj)) + return SCM_BOOL_F; + else + { SCM p; - SCM_VALIDATE_NIM (1, obj); scm_i_pthread_mutex_lock (&source_lock); p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL); @@ -260,6 +263,7 @@ return (SCM_NIMP (p) ? SCM_CDR (p) : SCM_BOOL_F); } return SCM_UNBNDP (p) ? SCM_BOOL_F : p; + } } #undef FUNC_NAME -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0002-Add-supports-source-properties-predicate.patch Content-Description: [PATCH 2/5] Add 'supports-source-properties?' predicate >From 76b9bac565182dd7d0ffe416c3382ac7d59d93ab Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 14 Feb 2012 02:14:10 -0500 Subject: [PATCH 2/5] Add 'supports-source-properties?' predicate * libguile/srcprop.c (scm_supports_source_properties_p): New procedure. (supports_source_props): New static C function. * libguile/srcprop.h (scm_supports_source_properties_p): Add prototype. * doc/ref/api-debug.texi (Source Properties): Add documentation. --- doc/ref/api-debug.texi | 6 ++++++ libguile/srcprop.c | 18 ++++++++++++++++++ libguile/srcprop.h | 4 +++- 3 files changed, 27 insertions(+), 1 deletions(-) diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi index c5fbe56..18371f0 100644 --- a/doc/ref/api-debug.texi +++ b/doc/ref/api-debug.texi @@ -258,6 +258,12 @@ ERROR: Unbound variable: xxx In the latter case, no source properties were stored, so the error doesn't have any source information. +@deffn {Scheme Procedure} supports-source-properties? obj +@deffnx {C Function} scm_supports_source_properties_p (obj) +Return #t if source properties can be associated with @var{obj}, +otherwise return #f. +@end deffn + The recording of source properties is controlled by the read option named ``positions'' (@pxref{Scheme Read}). This option is switched @emph{on} by default. diff --git a/libguile/srcprop.c b/libguile/srcprop.c index c43acdf..c632bb0 100644 --- a/libguile/srcprop.c +++ b/libguile/srcprop.c @@ -94,6 +94,14 @@ static SCM scm_srcprops_to_alist (SCM obj); scm_t_bits scm_tc16_srcprops; + +static int +supports_source_props (SCM obj) +{ + return SCM_NIMP (obj) && !scm_is_symbol (obj) && !scm_is_keyword (obj); +} + + static int srcprops_print (SCM obj, SCM port, scm_print_state *pstate) { @@ -160,6 +168,16 @@ scm_srcprops_to_alist (SCM obj) return alist; } +SCM_DEFINE (scm_supports_source_properties_p, "supports-source-properties?", 1, 0, 0, + (SCM obj), + "Return #t if @var{obj} supports adding source properties,\n" + "otherwise return #f.") +#define FUNC_NAME s_scm_supports_source_properties_p +{ + return scm_from_bool (supports_source_props (obj)); +} +#undef FUNC_NAME + SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, (SCM obj), "Return the source property association list of @var{obj}.") diff --git a/libguile/srcprop.h b/libguile/srcprop.h index 250756d..0252e54 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -3,7 +3,8 @@ #ifndef SCM_SRCPROP_H #define SCM_SRCPROP_H -/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 1995, 1996, 2000, 2001, 2006, 2008, 2009, 2010, + * 2011, 2012 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -41,6 +42,7 @@ SCM_API SCM scm_sym_column; +SCM_API SCM scm_supports_source_properties_p (SCM obj); SCM_API SCM scm_make_srcprops (long line, int col, SCM fname, SCM copy, SCM plist); SCM_API SCM scm_source_property (SCM obj, SCM key); SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum); -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0003-psyntax-access-source-properties-for-all-supported-o-NO-PP.patch Content-Description: [PATCH 3/5] psyntax: access source properties for all supported objects >From 32fbc38fbb3c7544a45f7be3cf0a981a31681cbb Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 14 Feb 2012 23:22:51 -0500 Subject: [PATCH 3/5] psyntax: access source properties for all supported objects * module/ice-9/psyntax.scm (decorate-source): Set source properties on any object that satisfies 'supports-source-properties?'. Previously we used 'pair?' as the predicate. (source-annotation): Apply 'source-properties' to _any_ kind of source expression, where previously only pairs were queried. If the argument is a syntax-object, apply the source-properties to the syntax-object's expression. In the peculiar case of a syntax-object whose expression is also a syntax-object: previously we would iterate, but with this commit we now call 'syntax-object-expression' only once. * module/ice-9/psyntax-pp.scm: Regenerate. --- module/ice-9/psyntax-pp.scm |12795 ++++++++++++++++++++++--------------------- module/ice-9/psyntax.scm | 15 +- 2 files changed, 6438 insertions(+), 6372 deletions(-) diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 729ae6e..4290069 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -301,7 +301,7 @@ (define (decorate-source e s) - (if (and (pair? e) s) + (if (and s (supports-source-properties? e)) (set-source-properties! e s)) e) @@ -461,14 +461,11 @@ (define source-annotation (lambda (x) - (cond - ((syntax-object? x) - (source-annotation (syntax-object-expression x))) - ((pair? x) (let ((props (source-properties x))) - (if (pair? props) - props - #f))) - (else #f)))) + (let ((props (source-properties + (if (syntax-object? x) + (syntax-object-expression x) + x)))) + (and (pair? props) props)))) (define-syntax-rule (arg-check pred? e who) (let ((x e)) -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0004-Add-support-for-source-properties-on-non-immediate-n.patch Content-Description: [PATCH 4/5] Add support for source properties on non-immediate numbers >From 38f190749da57150b5329676b6fd70ff73d66e02 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 15 Feb 2012 11:47:31 -0500 Subject: [PATCH 4/5] Add support for source properties on non-immediate numbers * libguile/read.c (scm_read_number): Set source properties on non-immediate numbers if the 'positions' reader option is set. * doc/ref/api-debug.texi (Source Properties): Update manual. --- doc/ref/api-debug.texi | 4 ++-- libguile/read.c | 8 +++++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi index 18371f0..dd2a3d1 100644 --- a/doc/ref/api-debug.texi +++ b/doc/ref/api-debug.texi @@ -239,8 +239,8 @@ Guile's debugger can point back to the file and location where the expression originated. The way that source properties are stored means that Guile cannot -associate source properties with individual numbers, symbols, -characters, booleans, or keywords. This can be seen by typing +associate source properties with individual symbols, keywords, +characters, booleans, or small integers. This can be seen by typing @code{(xxx)} and @code{xxx} at the Guile prompt (where the variable @code{xxx} has not been defined): diff --git a/libguile/read.c b/libguile/read.c index 4b19750..bbaf3f6 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -600,6 +600,10 @@ scm_read_number (scm_t_wchar chr, SCM port) int overflow; scm_t_port *pt = SCM_PTAB_ENTRY (port); + /* Need to capture line and column numbers here. */ + long line = SCM_LINUM (port); + int column = SCM_COL (port) - 1; + scm_ungetc (chr, port); overflow = read_complete_token (port, buffer, sizeof (buffer), &overflow_buffer, &bytes_read); @@ -611,13 +615,15 @@ scm_read_number (scm_t_wchar chr, SCM port) pt->ilseq_handler); result = scm_string_to_number (str, SCM_UNDEFINED); - if (!scm_is_true (result)) + if (scm_is_false (result)) { /* Return a symbol instead of a number */ if (SCM_CASE_INSENSITIVE_P) str = scm_string_downcase_x (str); result = scm_string_to_symbol (str); } + else if (SCM_NIMP (result)) + result = maybe_annotate_source (result, port, line, column); if (overflow) free (overflow_buffer); -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0005-Add-tests-to-verify-that-read-sets-source-properties.patch Content-Description: [PATCH 5/5] Add tests to verify that 'read' sets source properties when appropriate >From cac24946da089e1e1fddf9c9dc7ae7dae9e29014 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 15 Feb 2012 12:23:12 -0500 Subject: [PATCH 5/5] Add tests to verify that 'read' sets source properties when appropriate * test-suite/tests/srcprop.test (source properties): Add tests. --- test-suite/tests/srcprop.test | 48 +++++++++++++++++++++++++++++++++++----- 1 files changed, 42 insertions(+), 6 deletions(-) diff --git a/test-suite/tests/srcprop.test b/test-suite/tests/srcprop.test index 0ca11b3..4afc318 100644 --- a/test-suite/tests/srcprop.test +++ b/test-suite/tests/srcprop.test @@ -25,15 +25,51 @@ ;;; (with-test-prefix "source-properties" - + (pass-if "no props" (null? (source-properties (list 1 2 3)))) - + (read-enable 'positions) - (let ((s (read (open-input-string "(1 . 2)")))) - - (pass-if "read properties" - (not (null? (source-properties s)))))) + (with-test-prefix "read properties" + (define (reads-with-srcprops? str) + (let ((x (read (open-input-string str)))) + (not (null? (source-properties x))))) + + (pass-if "pairs" (reads-with-srcprops? "(1 . 2)")) + (pass-if "vectors" (reads-with-srcprops? "#(1 2 3)")) + (pass-if "bytevectors" (reads-with-srcprops? "#vu8(1 2 3)")) + (pass-if "bitvectors" (reads-with-srcprops? "#*101011")) + (pass-if "srfi4 vectors" (reads-with-srcprops? "#f64(3.1415 2.71)")) + (pass-if "arrays" (reads-with-srcprops? "#2u32@2@3((1 2) (2 3))")) + (pass-if "strings" (reads-with-srcprops? "\"hello\"")) + (pass-if "null string" (reads-with-srcprops? "\"\"")) + + (pass-if "floats" (reads-with-srcprops? "3.1415")) + (pass-if "fractions" (reads-with-srcprops? "1/2")) + (pass-if "complex numbers" (reads-with-srcprops? "1+1i")) + (pass-if "bignums" + (and (reads-with-srcprops? (number->string (1+ most-positive-fixnum))) + (reads-with-srcprops? (number->string (1- most-negative-fixnum))))) + + (pass-if "fixnums (should have none)" + (not (or (reads-with-srcprops? "0") + (reads-with-srcprops? "1") + (reads-with-srcprops? "-1") + (reads-with-srcprops? (number->string most-positive-fixnum)) + (reads-with-srcprops? (number->string most-negative-fixnum))))) + + (pass-if "symbols (should have none)" + (not (reads-with-srcprops? "foo"))) + + (pass-if "keywords (should have none)" + (not (reads-with-srcprops? "#:foo"))) + + (pass-if "characters (should have none)" + (not (reads-with-srcprops? "#\\c"))) + + (pass-if "booleans (should have none)" + (not (or (reads-with-srcprops? "#t") + (reads-with-srcprops? "#f")))))) ;;; ;;; set-source-property! -- 1.7.5.4 --=-=-=--