unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [PATCH] Improved source properties and errors; => within case
@ 2012-02-08  9:09 Mark H Weaver
  2012-02-08 10:06 ` Andy Wingo
  2012-02-10 15:45 ` Ludovic Courtès
  0 siblings, 2 replies; 8+ messages in thread
From: Mark H Weaver @ 2012-02-08  9:09 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 726 bytes --]

Hello all,

Here's a preliminary patch set to do the following:

* Add support for '=>' within 'case' as mandated by the R7RS draft.

* Add support in 'read' to set source properties for vectors,
  bytevectors, bitvectors, srfi-4 vectors, arrays, and non-empty
  strings.

* Reimplement 'cond' and 'case' using syntax-case.

* Improve error messages for syntax errors in 'cond' and 'case'.

* Compile-time warnings for duplicate datums in 'case'.

* Compile-time warnings for some types of datums in 'case' that cannot
  be meaningfully compared using 'eqv?' (strings, generalized vectors,
  and arrays).

* Remove 'inline' and 'register' attributes from read.c.

Comments and suggestions solicited.

    Thanks,
      Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH 1/5] Remove inline and register attributes from read.c --]
[-- Type: text/x-patch, Size: 3914 bytes --]

From 672e15f5cddd4a203b2e6e38c289f2127078b143 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Wed, 8 Feb 2012 03:00:15 -0500
Subject: [PATCH 1/5] Remove inline and register attributes from read.c

* libguile/read.c: Remove all 'inline' and 'register' attributes.
---
 libguile/read.c |   28 ++++++++++++++--------------
 1 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/libguile/read.c b/libguile/read.c
index 6166724..fc5aaf8 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 Free Software
- * Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2003, 2004, 2006,
+ *   2007, 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
@@ -142,13 +142,13 @@ SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0,
    characters to procedures.  */
 static SCM *scm_i_read_hash_procedures;
 
-static inline SCM
+static SCM
 scm_i_read_hash_procedures_ref (void)
 {
   return scm_fluid_ref (*scm_i_read_hash_procedures);
 }
 
-static inline void
+static void
 scm_i_read_hash_procedures_set_x (SCM value)
 {
   scm_fluid_set_x (*scm_i_read_hash_procedures, value);
@@ -197,7 +197,7 @@ scm_i_read_hash_procedures_set_x (SCM value)
    || ((_chr) == 'd') || ((_chr) == 'l'))
 
 /* Read an SCSH block comment.  */
-static inline SCM scm_read_scsh_block_comment (scm_t_wchar, SCM);
+static SCM scm_read_scsh_block_comment (scm_t_wchar, SCM);
 static SCM scm_read_r6rs_block_comment (scm_t_wchar, SCM);
 static SCM scm_read_commented_expression (scm_t_wchar, SCM);
 static SCM scm_read_shebang (scm_t_wchar, SCM);
@@ -207,7 +207,7 @@ static SCM scm_get_hash_procedure (int);
    result in the pre-allocated buffer BUF.  Return zero if the whole token has
    fewer than BUF_SIZE bytes, non-zero otherwise. READ will be set the number of
    bytes actually read.  */
-static inline int
+static int
 read_token (SCM port, char *buf, const size_t buf_size, size_t *read)
  {
    *read = 0;
@@ -286,7 +286,7 @@ read_complete_token (SCM port, char *buffer, const size_t buffer_size,
 static int
 flush_ws (SCM port, const char *eoferr)
 {
-  register scm_t_wchar c;
+  scm_t_wchar c;
   while (1)
     switch (c = scm_getc (port))
       {
@@ -836,7 +836,7 @@ scm_read_syntax (int chr, SCM port)
   return p;
 }
 
-static inline SCM
+static SCM
 scm_read_nil (int chr, SCM port)
 {
   SCM id = scm_read_mixed_case_symbol (chr, port);
@@ -849,7 +849,7 @@ scm_read_nil (int chr, SCM port)
   return SCM_ELISP_NIL;
 }
   
-static inline SCM
+static SCM
 scm_read_semicolon_comment (int chr, SCM port)
 {
   int c;
@@ -990,7 +990,7 @@ scm_read_character (scm_t_wchar chr, SCM port)
 }
 #undef FUNC_NAME
 
-static inline SCM
+static SCM
 scm_read_keyword (int chr, SCM port)
 {
   SCM symbol;
@@ -1009,7 +1009,7 @@ scm_read_keyword (int chr, SCM port)
   return (scm_symbol_to_keyword (symbol));
 }
 
-static inline SCM
+static SCM
 scm_read_vector (int chr, SCM port)
 {
   /* Note: We call `scm_read_sexp ()' rather than READER here in order to
@@ -1019,7 +1019,7 @@ scm_read_vector (int chr, SCM port)
   return (scm_vector (scm_read_sexp (chr, port)));
 }
 
-static inline SCM
+static SCM
 scm_read_srfi4_vector (int chr, SCM port)
 {
   return scm_i_read_array (port, chr);
@@ -1069,7 +1069,7 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port)
   return scm_bitvector (scm_reverse_x (s_bits, SCM_EOL));
 }
 
-static inline SCM
+static SCM
 scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
 {
   int bang_seen = 0;
@@ -1415,7 +1415,7 @@ scm_read_expression (SCM port)
 {
   while (1)
     {
-      register scm_t_wchar chr;
+      scm_t_wchar chr;
 
       chr = scm_getc (port);
 
-- 
1.7.5.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: [PATCH 2/5] Add and use maybe_annotate_source helper in read.c --]
[-- Type: text/x-patch, Size: 1932 bytes --]

From aac5ab0cda76e91e2735dfa929dfcd53c43c7841 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Wed, 8 Feb 2012 03:10:11 -0500
Subject: [PATCH 2/5] Add and use maybe_annotate_source helper in read.c

* libguile/read.c (maybe_annotate_source): New static helper function.
  (scm_read_sexp, scm_read_quote, scm_read_syntax): Use
  'maybe_annotate_source'.
---
 libguile/read.c |   23 +++++++++++------------
 1 files changed, 11 insertions(+), 12 deletions(-)

diff --git a/libguile/read.c b/libguile/read.c
index fc5aaf8..0af1822 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -360,6 +360,14 @@ static SCM scm_read_sharp (int chr, SCM port);
 
 
 static SCM
+maybe_annotate_source (SCM x, SCM port, long line, int column)
+{
+  if (SCM_RECORD_POSITIONS_P)
+    scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port));
+  return x;
+}
+
+static SCM
 scm_read_sexp (scm_t_wchar chr, SCM port)
 #define FUNC_NAME "scm_i_lreadparen"
 {
@@ -423,10 +431,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port)
     }
 
  exit:
-  if (SCM_RECORD_POSITIONS_P)
-    scm_i_set_source_properties_x (ans, line, column, SCM_FILENAME (port));
-
-  return ans;
+  return maybe_annotate_source (ans, port, line, column);
 }
 #undef FUNC_NAME
 
@@ -780,10 +785,7 @@ scm_read_quote (int chr, SCM port)
     }
 
   p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
-  if (SCM_RECORD_POSITIONS_P)
-    scm_i_set_source_properties_x (p, line, column, SCM_FILENAME (port));
-
-  return p;
+  return maybe_annotate_source (p, port, line, column);
 }
 
 SCM_SYMBOL (sym_syntax, "syntax");
@@ -830,10 +832,7 @@ scm_read_syntax (int chr, SCM port)
     }
 
   p = scm_cons2 (p, scm_read_expression (port), SCM_EOL);
-  if (SCM_RECORD_POSITIONS_P)
-    scm_i_set_source_properties_x (p, line, column, SCM_FILENAME (port));
-
-  return p;
+  return maybe_annotate_source (p, port, line, column);
 }
 
 static SCM
-- 
1.7.5.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: [PATCH 3/5] Remove incorrect comment in read.c --]
[-- Type: text/x-patch, Size: 845 bytes --]

From 1aee9e4eb47e7996a3a99e92afcc5566684374db Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Wed, 8 Feb 2012 03:14:17 -0500
Subject: [PATCH 3/5] Remove incorrect comment in read.c

* libguile/read.c (scm_read_sharp): Remove incorrect comment that
  incorrectly claims that scm_read_boolean might return a SRFI-4 vector.
---
 libguile/read.c |    1 -
 1 files changed, 0 insertions(+), 1 deletions(-)

diff --git a/libguile/read.c b/libguile/read.c
index 0af1822..4cdde4a 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1331,7 +1331,6 @@ scm_read_sharp (scm_t_wchar chr, SCM port)
     case 't':
     case 'T':
     case 'F':
-      /* This one may return either a boolean or an SRFI-4 vector.  */
       return (scm_read_boolean (chr, port));
     case ':':
       return (scm_read_keyword (chr, port));
-- 
1.7.5.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: [PATCH 4/5] Add source properties to many more types of data --]
[-- Type: text/x-patch, Size: 8035 bytes --]

From 8838a4d76bc4deeafd7fd9bd9d438c66e1f6abae Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Wed, 8 Feb 2012 03:24:10 -0500
Subject: [PATCH 4/5] Add source properties to many more types of data

* libguile/read.c (scm_read_array): New internal helper that
  calls scm_i_read_array and sets its source property if the
  'positions' reader option is set.

  (scm_read_string): Set source properties on non-empty strings if the
  'positions' reader option is set.

  (scm_read_vector, scm_read_srfi4_vector, scm_read_bytevector,
  scm_read_guile_bitvector, scm_read_sharp): Add new arguments for the
  'line' and 'column' of the first character of the datum being read.
  Set source properties if the 'positions' reader option is set.

  (scm_read_expression): Pass 'line' and 'column' to scm_read_sharp.

* doc/ref/api-debug.texi (Source Properties): Update manual.
---
 doc/ref/api-debug.texi |   12 ++++----
 libguile/read.c        |   66 ++++++++++++++++++++++++++++++-----------------
 2 files changed, 48 insertions(+), 30 deletions(-)

diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index cf9ea5a..d036460 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -239,10 +239,10 @@ 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 can only
-associate source properties with parenthesized expressions, and not, for
-example, with individual symbols, numbers or strings.  The difference
-can be seen by typing @code{(xxx)} and @code{xxx} at the Guile prompt
-(where the variable @code{xxx} has not been defined):
+associate source properties with parenthesized expressions and non-empty
+strings, and not, for example, with individual symbols or numbers.  The
+difference can be seen by typing @code{(xxx)} and @code{xxx} at the
+Guile prompt (where the variable @code{xxx} has not been defined):
 
 @example
 scheme@@(guile-user)> (xxx)
@@ -288,8 +288,8 @@ Return the property specified by @var{key} from @var{obj}'s source
 properties.
 @end deffn
 
-If the @code{positions} reader option is enabled, each parenthesized
-expression will have values set for the @code{filename}, @code{line} and
+If the @code{positions} reader option is enabled, supported expressions
+will have values set for the @code{filename}, @code{line} and
 @code{column} properties.
 
 Source properties are also associated with syntax objects.  Procedural
diff --git a/libguile/read.c b/libguile/read.c
index 4cdde4a..aa6d439 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -356,8 +356,7 @@ flush_ws (SCM port, const char *eoferr)
 /* Token readers.  */
 
 static SCM scm_read_expression (SCM port);
-static SCM scm_read_sharp (int chr, SCM port);
-
+static SCM scm_read_sharp (int chr, SCM port, long line, int column);
 
 static SCM
 maybe_annotate_source (SCM x, SCM port, long line, int column)
@@ -497,6 +496,10 @@ scm_read_string (int chr, SCM port)
   unsigned c_str_len = 0;
   scm_t_wchar c;
 
+  /* Need to capture line and column numbers here. */
+  long line = SCM_LINUM (port);
+  int column = SCM_COL (port) - 1;
+
   str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
   while ('"' != (c = scm_getc (port)))
     {
@@ -582,11 +585,10 @@ scm_read_string (int chr, SCM port)
     }
 
   if (c_str_len > 0)
-    {
-      return scm_i_substring_copy (str, 0, c_str_len);
-    }
-
-  return scm_nullstr;
+    return maybe_annotate_source (scm_i_substring_copy (str, 0, c_str_len),
+                                  port, line, column);
+  else
+    return scm_nullstr;
 }
 #undef FUNC_NAME
 
@@ -1009,23 +1011,34 @@ scm_read_keyword (int chr, SCM port)
 }
 
 static SCM
-scm_read_vector (int chr, SCM port)
+scm_read_vector (int chr, SCM port, long line, int column)
 {
   /* Note: We call `scm_read_sexp ()' rather than READER here in order to
      guarantee that it's going to do what we want.  After all, this is an
      implementation detail of `scm_read_vector ()', not a desirable
      property.  */
-  return (scm_vector (scm_read_sexp (chr, port)));
+  return maybe_annotate_source (scm_vector (scm_read_sexp (chr, port)),
+                                port, line, column);
+}
+
+static SCM
+scm_read_array (int chr, SCM port, long line, int column)
+{
+  SCM result = scm_i_read_array (port, chr);
+  if (scm_is_false (result))
+    return result;
+  else
+    return maybe_annotate_source (result, port, line, column);
 }
 
 static SCM
-scm_read_srfi4_vector (int chr, SCM port)
+scm_read_srfi4_vector (int chr, SCM port, long line, int column)
 {
-  return scm_i_read_array (port, chr);
+  return scm_read_array (chr, port, line, column);
 }
 
 static SCM
-scm_read_bytevector (scm_t_wchar chr, SCM port)
+scm_read_bytevector (scm_t_wchar chr, SCM port, long line, int column)
 {
   chr = scm_getc (port);
   if (chr != 'u')
@@ -1039,7 +1052,9 @@ scm_read_bytevector (scm_t_wchar chr, SCM port)
   if (chr != '(')
     goto syntax;
 
-  return scm_u8_list_to_bytevector (scm_read_sexp (chr, port));
+  return maybe_annotate_source
+    (scm_u8_list_to_bytevector (scm_read_sexp (chr, port)),
+     port, line, column);
 
  syntax:
   scm_i_input_error ("read_bytevector", port,
@@ -1049,7 +1064,7 @@ scm_read_bytevector (scm_t_wchar chr, SCM port)
 }
 
 static SCM
-scm_read_guile_bit_vector (scm_t_wchar chr, SCM port)
+scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, long line, int column)
 {
   /* Read the `#*10101'-style read syntax for bit vectors in Guile.  This is
      terribly inefficient but who cares?  */
@@ -1065,7 +1080,9 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port)
   if (chr != EOF)
     scm_ungetc (chr, port);
 
-  return scm_bitvector (scm_reverse_x (s_bits, SCM_EOL));
+  return maybe_annotate_source
+    (scm_bitvector (scm_reverse_x (s_bits, SCM_EOL)),
+     port, line, column);
 }
 
 static SCM
@@ -1301,7 +1318,7 @@ scm_read_sharp_extension (int chr, SCM port)
 /* The reader for the sharp `#' character.  It basically dispatches reads
    among the above token readers.   */
 static SCM
-scm_read_sharp (scm_t_wchar chr, SCM port)
+scm_read_sharp (scm_t_wchar chr, SCM port, long line, int column)
 #define FUNC_NAME "scm_lreadr"
 {
   SCM result;
@@ -1317,17 +1334,17 @@ scm_read_sharp (scm_t_wchar chr, SCM port)
     case '\\':
       return (scm_read_character (chr, port));
     case '(':
-      return (scm_read_vector (chr, port));
+      return (scm_read_vector (chr, port, line, column));
     case 's':
     case 'u':
     case 'f':
     case 'c':
       /* This one may return either a boolean or an SRFI-4 vector.  */
-      return (scm_read_srfi4_vector (chr, port));
+      return (scm_read_srfi4_vector (chr, port, line, column));
     case 'v':
-      return (scm_read_bytevector (chr, port));
+      return (scm_read_bytevector (chr, port, line, column));
     case '*':
-      return (scm_read_guile_bit_vector (chr, port));
+      return (scm_read_guile_bit_vector (chr, port, line, column));
     case 't':
     case 'T':
     case 'F':
@@ -1344,7 +1361,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port)
     case 'h':
     case 'l':
 #endif
-      return (scm_i_read_array (port, chr));
+      return (scm_read_array (chr, port, line, column));
 
     case 'i':
     case 'e':
@@ -1356,7 +1373,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port)
 	if (next_c != EOF)
 	  scm_ungetc (next_c, port);
 	if (next_c == '(')
-	  return scm_i_read_array (port, chr);
+	  return scm_read_array (chr, port, line, column);
 	/* Fall through. */
       }
 #endif
@@ -1439,8 +1456,9 @@ scm_read_expression (SCM port)
 	  return (scm_read_quote (chr, port));
 	case '#':
 	  {
-	    SCM result;
-	    result = scm_read_sharp (chr, port);
+            long line  = SCM_LINUM (port);
+            int column = SCM_COL (port) - 1;
+	    SCM result = scm_read_sharp (chr, port, line, column);
 	    if (scm_is_eq (result, SCM_UNSPECIFIED))
 	      /* We read a comment or some such.  */
 	      break;
-- 
1.7.5.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: [PATCH 5/5] Support => within case, and improve error messages for cond and case --]
[-- Type: text/x-patch, Size: 18284 bytes --]

From 849b96dd703315db31f41e01f10a1140391f82c1 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Tue, 7 Feb 2012 19:40:29 -0500
Subject: [PATCH 5/5] Support => within case, and improve error messages for
 cond and case

* module/ice-9/boot-9.scm (cond, case): Reimplement using syntax-case,
  with improved error messages and support for '=>' within 'case' as
  mandated by the R7RS.  Add warnings for duplicate case datums and
  case datums that cannot be meaningfully compared using 'eqv?'.

* test-suite/tests/syntax.test (cond, case): Update tests to reflect
  improved error reporting.  Add tests for '=>' within 'case'.

* module/system/base/message.scm (%warning-types): Add 'bad-case-datum'
  and 'duplicate-case-datum' warning types.

* doc/ref/api-control.texi (Conditionals): Document '=>' within 'case'.
---
 doc/ref/api-control.texi       |   19 ++++-
 module/ice-9/boot-9.scm        |  192 ++++++++++++++++++++++++++++------------
 module/system/base/message.scm |   14 +++
 test-suite/tests/syntax.test   |   77 +++++++++++++----
 4 files changed, 227 insertions(+), 75 deletions(-)

diff --git a/doc/ref/api-control.texi b/doc/ref/api-control.texi
index fc59350..ca7ad4a 100644
--- a/doc/ref/api-control.texi
+++ b/doc/ref/api-control.texi
@@ -212,18 +212,30 @@ result of the @code{cond}-expression.
 @end deffn
 
 @deffn syntax case key clause1 clause2 @dots{}
-@var{key} may be any expression, the @var{clause}s must have the form
+@var{key} may be any expression, and the @var{clause}s must have the form
 
 @lisp
 ((@var{datum1} @dots{}) @var{expr1} @var{expr2} @dots{})
 @end lisp
 
+or
+
+@lisp
+((@var{datum1} @dots{}) => @var{expression})
+@end lisp
+
 and the last @var{clause} may have the form
 
 @lisp
 (else @var{expr1} @var{expr2} @dots{})
 @end lisp
 
+or
+
+@lisp
+(else => @var{expression})
+@end lisp
+
 All @var{datum}s must be distinct.  First, @var{key} is evaluated.  The
 result of this evaluation is compared against all @var{datum} values using
 @code{eqv?}.  When this comparison succeeds, the expression(s) following
@@ -234,6 +246,11 @@ If the @var{key} matches no @var{datum} and there is an
 @code{else}-clause, the expressions following the @code{else} are
 evaluated.  If there is no such clause, the result of the expression is
 unspecified.
+
+For the @code{=>} clause types, @var{expression} is evaluated and the
+resulting procedure is applied to the value of @var{key}.  The result of
+this procedure application is then the result of the
+@code{case}-expression.
 @end deffn
 
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index d1bbd95..41ce924 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -411,70 +411,150 @@ If there is no handler at all, Guile prints an error and then exits."
     ((_ x) x)
     ((_ x y ...) (let ((t x)) (if t t (or y ...))))))
 
+(include-from-path "ice-9/quasisyntax")
+
 (define-syntax-rule (when test stmt stmt* ...)
   (if test (begin stmt stmt* ...)))
 
 (define-syntax-rule (unless test stmt stmt* ...)
   (if (not test) (begin stmt stmt* ...)))
 
-;; The "maybe-more" bits are something of a hack, so that we can support
-;; SRFI-61. Rewrites into a standalone syntax-case macro would be
-;; appreciated.
 (define-syntax cond
-  (syntax-rules (=> else)
-    ((_ "maybe-more" test consequent)
-     (if test consequent))
-
-    ((_ "maybe-more" test consequent clause ...)
-     (if test consequent (cond clause ...)))
-
-    ((_ (else else1 else2 ...))
-     (begin else1 else2 ...))
-
-    ((_ (test => receiver) more-clause ...)
-     (let ((t test))
-       (cond "maybe-more" t (receiver t) more-clause ...)))
-
-    ((_ (generator guard => receiver) more-clause ...)
-     (call-with-values (lambda () generator)
-       (lambda t
-         (cond "maybe-more"
-               (apply guard t) (apply receiver t) more-clause ...))))
-
-    ((_ (test => receiver ...) more-clause ...)
-     (syntax-violation 'cond "wrong number of receiver expressions"
-                       '(test => receiver ...)))
-    ((_ (generator guard => receiver ...) more-clause ...)
-     (syntax-violation 'cond "wrong number of receiver expressions"
-                       '(generator guard => receiver ...)))
-    
-    ((_ (test) more-clause ...)
-     (let ((t test))
-       (cond "maybe-more" t t more-clause ...)))
-
-    ((_ (test body1 body2 ...) more-clause ...)
-     (cond "maybe-more"
-           test (begin body1 body2 ...) more-clause ...))))
+  (lambda (whole-expr)
+    (define (fold f seed xs)
+      (let loop ((xs xs) (seed seed))
+        (if (null? xs) seed
+            (loop (cdr xs) (f (car xs) seed)))))
+    (define (reverse-map f xs)
+      (fold (lambda (x seed) (cons (f x) seed))
+            '() xs))
+    (syntax-case whole-expr ()
+      ((_ clause clauses ...)
+       #`(begin
+           #,@(fold (lambda (clause-builder tail)
+                      (clause-builder tail))
+                    #'()
+                    (reverse-map
+                     (lambda (clause)
+                       (define* (bad-clause #:optional (msg "invalid clause"))
+                         (syntax-violation 'cond msg whole-expr clause))
+                       (syntax-case clause (=> else)
+                         ((else e e* ...)
+                          (lambda (tail)
+                            (if (null? tail)
+                                #'((begin e e* ...))
+                                (bad-clause "else must be the last clause"))))
+                         ((else . _) (bad-clause))
+                         ((test => receiver)
+                          (lambda (tail)
+                            #`((let ((t test))
+                                 (if t
+                                     (receiver t)
+                                     #,@tail)))))
+                         ((test => receiver ...)
+                          (bad-clause "wrong number of receiver expressions"))
+                         ((generator guard => receiver)
+                          (lambda (tail)
+                            #`((call-with-values (lambda () generator)
+                                 (lambda vals
+                                   (if (apply guard vals)
+                                       (apply receiver vals)
+                                       #,@tail))))))
+                         ((generator guard => receiver ...)
+                          (bad-clause "wrong number of receiver expressions"))
+                         ((test)
+                          (lambda (tail)
+                            #`((let ((t test))
+                                 (if t t #,@tail)))))
+                         ((test e e* ...)
+                          (lambda (tail)
+                            #`((if test
+                                   (begin e e* ...)
+                                   #,@tail))))
+                         (_ (bad-clause))))
+                     #'(clause clauses ...))))))))
 
 (define-syntax case
-  (syntax-rules (else)
-    ((case (key ...)
-       clauses ...)
-     (let ((atom-key (key ...)))
-       (case atom-key clauses ...)))
-    ((case key
-       (else result1 result2 ...))
-     (begin result1 result2 ...))
-    ((case key
-       ((atoms ...) result1 result2 ...))
-     (if (memv key '(atoms ...))
-         (begin result1 result2 ...)))
-    ((case key
-       ((atoms ...) result1 result2 ...)
-       clause clauses ...)
-     (if (memv key '(atoms ...))
-         (begin result1 result2 ...)
-         (case key clause clauses ...)))))
+  (lambda (whole-expr)
+    (define (fold f seed xs)
+      (let loop ((xs xs) (seed seed))
+        (if (null? xs) seed
+            (loop (cdr xs) (f (car xs) seed)))))
+    (define (fold2 f a b xs)
+      (let loop ((xs xs) (a a) (b b))
+        (if (null? xs) (values a b)
+            (call-with-values
+                (lambda () (f (car xs) a b))
+              (lambda (a b)
+                (loop (cdr xs) a b))))))
+    (define (reverse-map-with-seed f seed xs)
+      (fold2 (lambda (x ys seed)
+               (call-with-values
+                   (lambda () (f x seed))
+                 (lambda (y seed)
+                   (values (cons y ys) seed))))
+             '() seed xs))
+    (syntax-case whole-expr ()
+      ((_ expr clause clauses ...)
+       (with-syntax ((key #'key))
+         #`(let ((key expr))
+             #,@(fold
+                 (lambda (clause-builder tail)
+                   (clause-builder tail))
+                 #'()
+                 (reverse-map-with-seed
+                  (lambda (clause seen)
+                    (define* (bad-clause #:optional (msg "invalid clause"))
+                      (syntax-violation 'case msg whole-expr clause))
+                    (syntax-case clause ()
+                      ((test . rest)
+                       (with-syntax
+                           ((clause-expr
+                             (syntax-case #'rest (=>)
+                               ((=> receiver) #'(receiver key))
+                               ((=> receiver ...)
+                                (bad-clause
+                                 "wrong number of receiver expressions"))
+                               ((e e* ...) #'(begin e e* ...))
+                               (_ (bad-clause)))))
+                         (syntax-case #'test (else)
+                           ((datums ...)
+                            (let ((seen
+                                   (fold
+                                    (lambda (datum seen)
+                                      (define (warn-datum type)
+                                        ((@ (system base message)
+                                            warning)
+                                         type
+                                         (append (source-properties datum)
+                                                 (source-properties
+                                                  (syntax->datum #'test)))
+                                         datum
+                                         (syntax->datum clause)
+                                         (syntax->datum whole-expr)))
+                                      (if (memv datum seen)
+                                          (warn-datum 'duplicate-case-datum))
+                                      (if (or (pair? datum)
+                                              (array? datum)
+                                              (generalized-vector? datum))
+                                          (warn-datum 'bad-case-datum))
+                                      (cons datum seen))
+                                    seen
+                                    (map syntax->datum #'(datums ...)))))
+                              (values (lambda (tail)
+                                        #`((if (memv key '(datums ...))
+                                               clause-expr
+                                               #,@tail)))
+                                      seen)))
+                           (else (values (lambda (tail)
+                                           (if (null? tail)
+                                               #'(clause-expr)
+                                               (bad-clause
+                                                "else must be the last clause")))
+                                         seen))
+                           (_ (bad-clause)))))
+                      (_ (bad-clause))))
+                  '() #'(clause clauses ...)))))))))
 
 (define-syntax do
   (syntax-rules ()
@@ -502,8 +582,6 @@ If there is no handler at all, Guile prints an error and then exits."
 (define-syntax-rule (delay exp)
   (make-promise (lambda () exp)))
 
-(include-from-path "ice-9/quasisyntax")
-
 (define-syntax current-source-location
   (lambda (x)
     (syntax-case x ()
diff --git a/module/system/base/message.scm b/module/system/base/message.scm
index 8cf285a..9accf71 100644
--- a/module/system/base/message.scm
+++ b/module/system/base/message.scm
@@ -126,6 +126,20 @@
                          "~A: warning: possibly wrong number of arguments to `~A'~%"
                          loc name))))
 
+           (duplicate-case-datum
+            "report a duplicate datum in a case expression"
+            ,(lambda (port loc datum clause case-expr)
+               (emit port
+                     "~A: warning: duplicate datum ~S in clause ~S of case expression ~S~%"
+                     loc datum clause case-expr)))
+
+           (bad-case-datum
+            "report a case datum that cannot be meaningfully compared using `eqv?'"
+            ,(lambda (port loc datum clause case-expr)
+               (emit port
+                     "~A: warning: datum ~S cannot be meaningfully compared using `eqv?' in clause ~S of case expression ~S~%"
+                     loc datum clause case-expr)))
+
            (format
             "report wrong number of arguments to `format'"
             ,(lambda (port loc . rest)
diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test
index fcc0349..cdaee71 100644
--- a/test-suite/tests/syntax.test
+++ b/test-suite/tests/syntax.test
@@ -648,11 +648,13 @@
 
     (pass-if-syntax-error "missing recipient"
       '(cond . "wrong number of receiver expressions")
-      (cond (#t identity =>)))
+      (eval '(cond (#t identity =>))
+            (interaction-environment)))
 
     (pass-if-syntax-error "extra recipient"
       '(cond . "wrong number of receiver expressions")
-      (cond (#t identity => identity identity))))
+      (eval '(cond (#t identity => identity identity))
+            (interaction-environment))))
 
   (with-test-prefix "bad or missing clauses"
 
@@ -662,43 +664,48 @@
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(cond #t)"
-      exception:generic-syncase-error
+      '(cond . "invalid clause")
       (eval '(cond #t)
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(cond 1)"
-      exception:generic-syncase-error
+      '(cond . "invalid clause")
       (eval '(cond 1)
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(cond 1 2)"
-      exception:generic-syncase-error
+      '(cond . "invalid clause")
       (eval '(cond 1 2)
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(cond 1 2 3)"
-      exception:generic-syncase-error
+      '(cond . "invalid clause")
       (eval '(cond 1 2 3)
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(cond 1 2 3 4)"
-      exception:generic-syncase-error
+      '(cond . "invalid clause")
       (eval '(cond 1 2 3 4)
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(cond ())"
-      exception:generic-syncase-error
+      '(cond . "invalid clause")
       (eval '(cond ())
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(cond () 1)"
-      exception:generic-syncase-error
+      '(cond . "invalid clause")
       (eval '(cond () 1)
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(cond (1) 1)"
-      exception:generic-syncase-error
+      '(cond . "invalid clause")
       (eval '(cond (1) 1)
+	    (interaction-environment)))
+
+    (pass-if-syntax-error "(cond (else #f) (#t #t))"
+      '(cond . "else must be the last clause")
+      (eval '(cond (else #f) (#t #t))
 	    (interaction-environment))))
 
   (with-test-prefix "wrong number of arguments"
@@ -712,10 +719,46 @@
   (pass-if "clause with empty labels list"
     (case 1 (() #f) (else #t)))
 
+  (with-test-prefix "case handles '=> correctly"
+
+    (pass-if "(1 2 3) => list"
+      (equal? (case 1 ((1 2 3) => list))
+              '(1)))
+
+    (pass-if "else => list"
+      (equal? (case 6
+                ((1 2 3) 'wrong)
+                (else => list))
+              '(6)))
+
+    (with-test-prefix "bound '=> is handled correctly"
+
+      (pass-if "(1) => 'ok"
+        (let ((=> 'foo))
+          (eq? (case 1 ((1) => 'ok)) 'ok)))
+
+      (pass-if "else =>"
+        (let ((=> 'foo))
+          (eq? (case 1 (else =>)) 'foo)))
+
+      (pass-if "else => list"
+        (let ((=> 'foo))
+          (eq? (case 1 (else => identity)) identity))))
+
+    (pass-if-syntax-error "missing recipient"
+      '(case . "wrong number of receiver expressions")
+      (eval '(case 1 ((1) =>))
+            (interaction-environment)))
+
+    (pass-if-syntax-error "extra recipient"
+      '(case . "wrong number of receiver expressions")
+      (eval '(case 1 ((1) => identity identity))
+            (interaction-environment))))
+
   (with-test-prefix "case is hygienic"
 
     (pass-if-syntax-error "bound 'else is handled correctly"
-      exception:generic-syncase-error
+      '(case . "invalid clause")
       (eval '(let ((else #f)) (case 1 (else #f)))
             (interaction-environment))))
 
@@ -742,22 +785,22 @@
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(case 1 \"foo\")"
-      exception:generic-syncase-error
+      '(case . "invalid clause")
       (eval '(case 1 "foo")
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(case 1 ())"
-      exception:generic-syncase-error
+      '(case . "invalid clause")
       (eval '(case 1 ())
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(case 1 (\"foo\"))"
-      exception:generic-syncase-error
+      '(case . "invalid clause")
       (eval '(case 1 ("foo"))
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(case 1 (\"foo\" \"bar\"))"
-      exception:generic-syncase-error
+      '(case . "invalid clause")
       (eval '(case 1 ("foo" "bar"))
 	    (interaction-environment)))
 
@@ -767,7 +810,7 @@
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(case 1 ((2) \"bar\") (else))"
-      exception:generic-syncase-error
+      '(case . "invalid clause")
       (eval '(case 1 ((2) "bar") (else))
 	    (interaction-environment)))
 
@@ -777,7 +820,7 @@
 	    (interaction-environment)))
 
     (pass-if-syntax-error "(case 1 (else #f) ((1) #t))"
-      exception:generic-syncase-error
+      '(case . "else must be the last clause")
       (eval '(case 1 (else #f) ((1) #t))
 	    (interaction-environment)))))
 
-- 
1.7.5.4


^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: [PATCH] Improved source properties and errors; => within case
  2012-02-08  9:09 [PATCH] Improved source properties and errors; => within case Mark H Weaver
@ 2012-02-08 10:06 ` Andy Wingo
  2012-02-08 16:16   ` Mark H Weaver
  2012-02-10 15:45 ` Ludovic Courtès
  1 sibling, 1 reply; 8+ messages in thread
From: Andy Wingo @ 2012-02-08 10:06 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

Heya Mark,

Patch set looks good to me.  Please push.  One comment:

On Wed 08 Feb 2012 10:09, Mark H Weaver <mhw@netris.org> writes:

>  The way that source properties are stored means that Guile can only
> -associate source properties with parenthesized expressions, and not, for
> -example, with individual symbols, numbers or strings.  The difference
> -can be seen by typing @code{(xxx)} and @code{xxx} at the Guile prompt
> -(where the variable @code{xxx} has not been defined):
> +associate source properties with parenthesized expressions and non-empty
> +strings, and not, for example, with individual symbols or numbers.  The
> +difference can be seen by typing @code{(xxx)} and @code{xxx} at the
> +Guile prompt (where the variable @code{xxx} has not been defined):

This isn't quite right; #*101010101 should probably get source info, no?
And is it useful to have an exception for empty strings?  I would think
that it would be fine to return fresh empty strings.  The compiler would
DTRT.  I don't care much though.

Perhaps: "Everything but numbers, symbols, characters, and booleans get
source information."  Dunno.

> +    (syntax-case whole-expr ()
> +      ((_ clause clauses ...)
> +       #`(begin

(This is in `cond').  Why is the begin needed here?

> +                            #`((let ((t test))
> +                                 (if t t #,@tail)))))

Use `or' here.

> +    (syntax-case whole-expr ()
> +      ((_ expr clause clauses ...)
> +       (with-syntax ((key #'key))
> +         #`(let ((key expr))
> +             #,@(fold

(In `case'.)  Likewise here, it would be good to avoid this use of an
implicit `begin', of possible.

> +                                      (if (memv datum seen)
> +                                          (warn-datum 'duplicate-case-datum))
> +                                      (if (or (pair? datum)
> +                                              (array? datum)
> +                                              (generalized-vector? datum))
> +                                          (warn-datum 'bad-case-datum))

Nice.

Cheers,

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] Improved source properties and errors; => within case
  2012-02-08 10:06 ` Andy Wingo
@ 2012-02-08 16:16   ` Mark H Weaver
  2012-02-08 21:27     ` Noah Lavine
  0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2012-02-08 16:16 UTC (permalink / raw)
  To: Andy Wingo; +Cc: guile-devel

Hi Andy, thanks for the quick review!

Andy Wingo <wingo@pobox.com> writes:
> Patch set looks good to me.  Please push.

Great, thanks!  Of course I'll fix the following issues first.

> On Wed 08 Feb 2012 10:09, Mark H Weaver <mhw@netris.org> writes:
>
>>  The way that source properties are stored means that Guile can only
>> -associate source properties with parenthesized expressions, and not, for
>> -example, with individual symbols, numbers or strings.  The difference
>> -can be seen by typing @code{(xxx)} and @code{xxx} at the Guile prompt
>> -(where the variable @code{xxx} has not been defined):
>> +associate source properties with parenthesized expressions and non-empty
>> +strings, and not, for example, with individual symbols or numbers.  The
>> +difference can be seen by typing @code{(xxx)} and @code{xxx} at the
>> +Guile prompt (where the variable @code{xxx} has not been defined):
>
> This isn't quite right; #*101010101 should probably get source info, no?

Yes, and indeed this patch _does_ add source info for bitvectors, but
I forgot to mention that in the doc.  I'll fix it.

> And is it useful to have an exception for empty strings?  I would think
> that it would be fine to return fresh empty strings.  The compiler would
> DTRT.  I don't care much though.

Currently 'read' returns the shared global 'scm_nullstr' for empty
strings.  We could remove that optimization though.  Maybe we should.
What do you think?

> Perhaps: "Everything but numbers, symbols, characters, and booleans get
> source information."  Dunno.

and keywords, and maybe some other things we're forgetting.  Good idea.
Another option is to explain it in terms of the core problem: only types
for which 'read' reliably returns a fresh object can have source
properties.  I'll think on this some more.

>> +    (syntax-case whole-expr ()
>> +      ((_ clause clauses ...)
>> +       #`(begin
>
> (This is in `cond').  Why is the begin needed here?

It's needed because the 'loop' returns a _list_ of expressions (of
length zero or one), to enable more graceful handling of the base case.
The outer 'loop' is guaranteed to return a list of length one, so I need
to either take the 'car' or wrap it in a 'begin'.

>> +                            #`((let ((t test))
>> +                                 (if t t #,@tail)))))
>
> Use `or' here.

I can't, because if it's the last clause, 'tail' will be '(), which
would generate (or test) which would be incorrect.  (or test) would
return #f is 'test' is false, but we actually want to return
*unspecified* in that case.

>> +    (syntax-case whole-expr ()
>> +      ((_ expr clause clauses ...)
>> +       (with-syntax ((key #'key))
>> +         #`(let ((key expr))
>> +             #,@(fold
>
> (In `case'.)  Likewise here, it would be good to avoid this use of an
> implicit `begin', of possible.

Hmm.  I don't know if this is what you meant, but it occurs to me that
as I've currently implemented them, both (cond (else (define x 5) x))
and (case 1 (else (define x 5) x)) are allowed.  I'll have to make sure
that those raise errors.  I guess that means I'll have to insert a '#f'
like I did for local-eval.  Do you see a better way?

    Thanks!
      Mark



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] Improved source properties and errors; => within case
  2012-02-08 16:16   ` Mark H Weaver
@ 2012-02-08 21:27     ` Noah Lavine
  2012-02-08 22:30       ` Mark H Weaver
  0 siblings, 1 reply; 8+ messages in thread
From: Noah Lavine @ 2012-02-08 21:27 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: Andy Wingo, guile-devel

Hello,

> Hmm.  I don't know if this is what you meant, but it occurs to me that
> as I've currently implemented them, both (cond (else (define x 5) x))
> and (case 1 (else (define x 5) x)) are allowed.  I'll have to make sure
> that those raise errors.  I guess that means I'll have to insert a '#f'
> like I did for local-eval.  Do you see a better way?

This makes me think that we should have a macro called
expression-context for putting things in expression context. It's not
that it's hard to insert #f, but that makes the source code less clear
unless people know why a random `#f' would appear in the code. What
does everyone else think?

Noah



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] Improved source properties and errors; => within case
  2012-02-08 21:27     ` Noah Lavine
@ 2012-02-08 22:30       ` Mark H Weaver
  0 siblings, 0 replies; 8+ messages in thread
From: Mark H Weaver @ 2012-02-08 22:30 UTC (permalink / raw)
  To: guile-devel

Hello all,

I have committed an improved version of this patch set to stable-2.0.
See below for more.

I wrote:
> Hmm.  I don't know if this is what you meant, but it occurs to me that
> as I've currently implemented them, both (cond (else (define x 5) x))
> and (case 1 (else (define x 5) x)) are allowed.  I'll have to make sure
> that those raise errors.

In the end, I decided that I couldn't safely make this change.  In
earlier versions of Guile, and in the reference implementations of the
R5RS/R7RS, (cond (else e e* ...)) and (case x (else e e* ...)) expand to
(begin e e* ...), and thus allow internal definitions.  Even though the
docs don't explicitly specify that this is allowed, I was uncomfortable
going out of my way to disallow this.

Also, this reminds me of another change in 'case' introduced by my patch
set (now committed to stable-2.0) that I forgot to mention before:

Previously (and in the reference implementations), (case expr c c* ...)
expands to (let ((key expr)) (case key c c* ...)) if and only if 'expr'
is a parenthesized expression.  Now, we introduce the 'let' in _all_
cases.  The reason is that, in the presence of identifier-syntax, a bare
identifier could expand into anything.

Andy Wingo <wingo@pobox.com> writes:
> And is it useful to have an exception for empty strings?  I would think
> that it would be fine to return fresh empty strings.  The compiler would
> DTRT.  I don't care much though.

Good point.  'read' now returns fresh strings in all cases, even for
empty strings, and thus we can apply source properties to empty strings
(and now we do).

Noah Lavine <noah.b.lavine@gmail.com> writes:
>> I guess that means I'll have to insert a '#f'
>> like I did for local-eval.  Do you see a better way?
>
> This makes me think that we should have a macro called
> expression-context for putting things in expression context. It's not
> that it's hard to insert #f, but that makes the source code less clear
> unless people know why a random `#f' would appear in the code. What
> does everyone else think?

Currently, it seems that (ice-9 local-eval) would be its only user, but
nonetheless this sounds like a good idea to me.

    Thanks,
      Mark



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] Improved source properties and errors; => within case
  2012-02-08  9:09 [PATCH] Improved source properties and errors; => within case Mark H Weaver
  2012-02-08 10:06 ` Andy Wingo
@ 2012-02-10 15:45 ` Ludovic Courtès
  2012-02-11 20:23   ` Mark H Weaver
  1 sibling, 1 reply; 8+ messages in thread
From: Ludovic Courtès @ 2012-02-10 15:45 UTC (permalink / raw)
  To: guile-devel

Hi Mark,

Sorry for not replying earlier.

Mark H Weaver <mhw@netris.org> skribis:

> From 849b96dd703315db31f41e01f10a1140391f82c1 Mon Sep 17 00:00:00 2001
> From: Mark H Weaver <mhw@netris.org>
> Date: Tue, 7 Feb 2012 19:40:29 -0500
> Subject: [PATCH 5/5] Support => within case, and improve error messages for
>  cond and case
>
> * module/ice-9/boot-9.scm (cond, case): Reimplement using syntax-case,
>   with improved error messages and support for '=>' within 'case' as
>   mandated by the R7RS.  Add warnings for duplicate case datums and
>   case datums that cannot be meaningfully compared using 'eqv?'.

This looks like a useful addition.

However, could it be done in the tree-il/analyze.scm instead, along with
other warning passes?

The reason I’m asking is that this:

> * module/system/base/message.scm (%warning-types): Add 'bad-case-datum'
>   and 'duplicate-case-datum' warning types.

... is really meant for compiler warnings (see, for instance, the output
of ‘guild compile -Whelp’).  In particular, whether the warnings are
emitted is determined by a #:opts sub-option to ‘compile’.

WDYT?

In addition, it would be great to have tests for the warnings
themselves, as found at the bottom of tree-il.test.

Thanks,
Ludo’




^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] Improved source properties and errors; => within case
  2012-02-10 15:45 ` Ludovic Courtès
@ 2012-02-11 20:23   ` Mark H Weaver
  2012-02-11 21:08     ` Ludovic Courtès
  0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2012-02-11 20:23 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guile-devel

ludo@gnu.org (Ludovic Courtès) writes:
> However, could it be done in the tree-il/analyze.scm instead, along with
> other warning passes?

The problem is that 'case' does not exist in tree-il.  By the time
analyze.scm sees it, 'case' has been transformed into nested 'if's with
'memv's.  In theory, similar checks could still be done, but I don't see
how we could produce warning messages that are easy to understand.
Please consider how you would implement the 'duplicate-case-datum'
warning at the tree-il level, and what the messages would look like.

More generally though, I think that we should empower users to write
macros that produce warning messages.

> The reason I’m asking is that this:
>
>> * module/system/base/message.scm (%warning-types): Add 'bad-case-datum'
>>   and 'duplicate-case-datum' warning types.
>
> ... is really meant for compiler warnings (see, for instance, the output
> of ‘guild compile -Whelp’).  In particular, whether the warnings are
> emitted is determined by a #:opts sub-option to ‘compile’.

Hmm, good point.  Maybe what we need here is something analogous to
'syntax-violation', but for warnings.  One of 'syntax-warning's
arguments would be the 'warning-type' (a symbol), to allow the warning
to be disabled.

One complication is that, in order to enable ordinary users to easily
add their own warning types for their macros, there would be no fixed
set of warning types.  This suggests that it might be better to specify
the set of _disabled_ warnings, instead of the set of _enabled_
warnings.  I think this probably makes more sense anyway.  I expect that
most users want all warnings enabled (including new ones added in future
versions of Guile) except for the ones that are giving them headaches.
The current interface makes this awkward.

For compatibility with the existing interface, we could allow warnings
to be either enabled or disabled via #:opts, and then there would be a
set of warnings that are disabled by default.

What do you think?

> In addition, it would be great to have tests for the warnings
> themselves, as found at the bottom of tree-il.test.

Ah yes, thanks for pointing that out!

     Mark



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: [PATCH] Improved source properties and errors; => within case
  2012-02-11 20:23   ` Mark H Weaver
@ 2012-02-11 21:08     ` Ludovic Courtès
  0 siblings, 0 replies; 8+ messages in thread
From: Ludovic Courtès @ 2012-02-11 21:08 UTC (permalink / raw)
  To: guile-devel

Hi Mark,

Mark H Weaver <mhw@netris.org> skribis:

> ludo@gnu.org (Ludovic Courtès) writes:
>> However, could it be done in the tree-il/analyze.scm instead, along with
>> other warning passes?
>
> The problem is that 'case' does not exist in tree-il.  By the time
> analyze.scm sees it, 'case' has been transformed into nested 'if's with
> 'memv's.  In theory, similar checks could still be done, but I don't see
> how we could produce warning messages that are easy to understand.

Indeed.

>> The reason I’m asking is that this:
>>
>>> * module/system/base/message.scm (%warning-types): Add 'bad-case-datum'
>>>   and 'duplicate-case-datum' warning types.
>>
>> ... is really meant for compiler warnings (see, for instance, the output
>> of ‘guild compile -Whelp’).  In particular, whether the warnings are
>> emitted is determined by a #:opts sub-option to ‘compile’.
>
> Hmm, good point.  Maybe what we need here is something analogous to
> 'syntax-violation', but for warnings.  One of 'syntax-warning's
> arguments would be the 'warning-type' (a symbol), to allow the warning
> to be disabled.

Sounds good.

> One complication is that, in order to enable ordinary users to easily
> add their own warning types for their macros,

What about addressing this problem separately?  :-)

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2012-02-11 21:08 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-02-08  9:09 [PATCH] Improved source properties and errors; => within case Mark H Weaver
2012-02-08 10:06 ` Andy Wingo
2012-02-08 16:16   ` Mark H Weaver
2012-02-08 21:27     ` Noah Lavine
2012-02-08 22:30       ` Mark H Weaver
2012-02-10 15:45 ` Ludovic Courtès
2012-02-11 20:23   ` Mark H Weaver
2012-02-11 21:08     ` Ludovic Courtès

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).