diff options
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/read.c | 8 | ||||
-rw-r--r-- | libguile/srcprop.c | 63 | ||||
-rw-r--r-- | libguile/srcprop.h | 4 |
3 files changed, 51 insertions, 24 deletions
diff --git a/libguile/read.c b/libguile/read.c index 7b53bc7fc..dff9d85d1 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_unlocked (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); diff --git a/libguile/srcprop.c b/libguile/srcprop.c index f63f1bc61..cc71fd182 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 @@ -91,6 +92,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) { @@ -157,21 +166,33 @@ 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}.") #define FUNC_NAME s_scm_source_properties { - SCM p; - SCM_VALIDATE_NIM (1, obj); - - p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL); - - if (SRCPROPSP (p)) - return scm_srcprops_to_alist (p); + if (SCM_IMP (obj)) + return SCM_EOL; else - /* list from set-source-properties!, or SCM_EOL for not found */ - return p; + { + SCM p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL); + + if (SRCPROPSP (p)) + return scm_srcprops_to_alist (p); + else + /* list from set-source-properties!, or SCM_EOL for not found */ + return p; + } } #undef FUNC_NAME @@ -195,13 +216,10 @@ int scm_i_has_source_properties (SCM obj) #define FUNC_NAME "%set-source-properties" { - int ret; - - SCM_VALIDATE_NIM (1, obj); - - ret = scm_is_true (scm_weak_table_refq (scm_source_whash, obj, SCM_BOOL_F)); - - return ret; + if (SCM_IMP (obj)) + return 0; + else + return scm_is_true (scm_weak_table_refq (scm_source_whash, obj, SCM_BOOL_F)); } #undef FUNC_NAME @@ -228,18 +246,20 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, #define FUNC_NAME s_scm_source_property { SCM p; - SCM_VALIDATE_NIM (1, obj); + + if (SCM_IMP (obj)) + return SCM_BOOL_F; p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL); if (!SRCPROPSP (p)) goto alist; if (scm_is_eq (scm_sym_line, key)) - p = scm_from_int (SRCPROPLINE (p)); + return scm_from_int (SRCPROPLINE (p)); else if (scm_is_eq (scm_sym_column, key)) - p = scm_from_int (SRCPROPCOL (p)); + return scm_from_int (SRCPROPCOL (p)); else if (scm_is_eq (scm_sym_copy, key)) - p = SRCPROPCOPY (p); + return SRCPROPCOPY (p); else { p = SRCPROPALIST (p); @@ -247,7 +267,6 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0, p = scm_assoc (key, p); return (scm_is_pair (p) ? SCM_CDR (p) : SCM_BOOL_F); } - return SCM_UNBNDP (p) ? SCM_BOOL_F : p; } #undef FUNC_NAME diff --git a/libguile/srcprop.h b/libguile/srcprop.h index 250756dcc..0252e54a1 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); |