diff options
author | Mark H Weaver <mhw@netris.org> | 2014-01-12 04:36:02 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2014-01-14 02:24:24 -0500 |
commit | 7a329029cf898fc0b9b24252c9bb437e1ad0b1d7 (patch) | |
tree | 24a0298953a4ff3c16c0c102d06eb451bbc33c43 | |
parent | 61d509194c6ce90e678a0b27d613f3656c8bbafd (diff) | |
download | guile-7a329029cf898fc0b9b24252c9bb437e1ad0b1d7.tar.gz |
read: Support R7RS '#true' and '#false' syntax for booleans.
* libguile/read.c (try_read_ci_chars): New static function.
(scm_read_boolean, scm_read_array): Use 'try_read_ci_chars'.
* doc/ref/api-data.texi (Booleans): Update docs.
* test-suite/tests/reader.test ("reading"): Add tests.
-rw-r--r-- | doc/ref/api-data.texi | 1 | ||||
-rw-r--r-- | libguile/read.c | 47 | ||||
-rw-r--r-- | test-suite/tests/reader.test | 11 |
3 files changed, 55 insertions, 4 deletions
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index fda76f1dc..198854bf1 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -56,6 +56,7 @@ For the documentation of such @dfn{compound} data types, see @tpindex Booleans The two boolean values are @code{#t} for true and @code{#f} for false. +They can also be written as @code{#true} and @code{#false}, as per R7RS. Boolean values are returned by predicate procedures, such as the general equality predicates @code{eq?}, @code{eqv?} and @code{equal?} diff --git a/libguile/read.c b/libguile/read.c index b36ecd437..03a53aadc 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2003, 2004, 2006, - * 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + * 2007, 2008, 2009, 2010, 2011, 2012, 2014 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 @@ -947,6 +947,43 @@ scm_read_semicolon_comment (int chr, SCM port) return SCM_UNSPECIFIED; } +/* If the EXPECTED_CHARS are the next ones available from PORT, then + consume them and return 1. Otherwise leave the port position where + it was and return 0. EXPECTED_CHARS should be all lowercase, and + will be matched case-insensitively against the characters read from + PORT. */ +static int +try_read_ci_chars (SCM port, const char *expected_chars) +{ + int num_chars_wanted = strlen (expected_chars); + int num_chars_read = 0; + char *chars_read = alloca (num_chars_wanted); + int c; + + while (num_chars_read < num_chars_wanted) + { + c = scm_getc (port); + if (c == EOF) + break; + else if (tolower (c) != expected_chars[num_chars_read]) + { + scm_ungetc (c, port); + break; + } + else + chars_read[num_chars_read++] = c; + } + + if (num_chars_read == num_chars_wanted) + return 1; + else + { + while (num_chars_read > 0) + scm_ungetc (chars_read[--num_chars_read], port); + return 0; + } +} + /* Sharp readers, i.e. readers called after a `#' sign has been read. */ @@ -957,10 +994,12 @@ scm_read_boolean (int chr, SCM port) { case 't': case 'T': + try_read_ci_chars (port, "rue"); return SCM_BOOL_T; case 'f': case 'F': + try_read_ci_chars (port, "alse"); return SCM_BOOL_F; } @@ -1160,8 +1199,10 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column) c = scm_getc (port); if (c != '3' && c != '6') { - if (c != EOF) - scm_ungetc (c, port); + if (c == 'a' && try_read_ci_chars (port, "lse")) + return SCM_BOOL_F; + else if (c != EOF) + scm_ungetc (c, port); return SCM_BOOL_F; } rank = 1; diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 6e02255ad..448ae1bcb 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -1,6 +1,7 @@ ;;;; reader.test --- Reader test. -*- coding: iso-8859-1; mode: scheme -*- ;;;; -;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008, 2009, 2010, 2011, +;;;; 2014 Free Software Foundation, Inc. ;;;; Jim Blandy <jimb@red-bean.com> ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -73,6 +74,14 @@ (not (equal? (imag-part (read-string "-nan.0-1i")) (imag-part (read-string "-nan.0+1i"))))) + (pass-if-equal "#true" + '(a #t b) + (read-string "(a #true b)")) + + (pass-if-equal "#false" + '(a #f b) + (read-string "(a #false b)")) + ;; At one time the arg list for "Unknown # object: ~S" didn't make it out ;; of read.c. Check that `format' can be applied to this error. (pass-if "error message on bad #" |