SRFI 61: a more general `cond' clause

* SRFI 61: a more general `cond' clause
@ 2005-07-30  0:25 Stephen Compall
  2005-07-30  1:22 ` Stephen Compall
       [not found] ` <878xzlrywd.fsf@zip.com.au>
  0 siblings, 2 replies; 3+ messages in thread
From: Stephen Compall @ 2005-07-30  0:25 UTC (permalink / raw)



[-- Attachment #1.1.1: Type: text/plain, Size: 1429 bytes --]

Attached is a patch against guile-core CVS HEAD to implement SRFI 61 in
the core.  While it makes COND incompatible with RnRS COND, it is
unlikely that any code has been written that would operate differently
with this cond -- the most reasonable case of these involves binding =>
as a variable, then referring to it in an essentially void context.

I also have a pure syntax-rules version, written by me, that uses if,
begin, lambda, apply, let, and call-with-values to completely implement
RnRS cond plus SRFI 61 cond.  It is not possible to translate an SRFI 61
cond form directly to RnRS cond without using non-local exits, and even
then the action forms are not in tail position, at least not the way
primitive cond is currently evaluated.  If you would rather use that
implementation, I will be happy to post it.

Here are changelog entries for srfi/ChangeLog, doc/ref/ChangeLog, and
libguile/ChangeLog, respectively.

2005-07-29  Stephen Compall  <s11@member.fsf.org>

        * srfi-61.scm: New file.

        * Makefile.am (srfi_DATA): Add srfi-61.scm.

2005-07-29  Stephen Compall  <s11@member.fsf.org>

        * srfi-modules.texi (SRFI-61): New section.
        (SRFI Support): Add SRFI-61 to menu.

2005-07-29  Stephen Compall  <s11@member.fsf.org>

        * eval.c (scm_m_cond): Recognize SRFI 61 cond syntax.
        (CEVAL): Evaluate SRFI 61 cond clauses.

-- 
Stephen Compall

[-- Attachment #1.1.2: srfi-61-1s11.patch --]
[-- Type: text/x-patch, Size: 5983 bytes --]

Index: libguile/eval.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/eval.c,v
retrieving revision 1.398
diff -d -u -r1.398 eval.c

--- libguile/eval.c	12 Jul 2005 00:28:09 -0000	1.398
+++ libguile/eval.c	30 Jul 2005 00:02:46 -0000
@@ -1095,6 +1095,15 @@
           ASSERT_SYNTAX_2 (length == 3, s_extra_expression, clause, expr);
           SCM_SETCAR (SCM_CDR (clause), SCM_IM_ARROW);
 	}
+      /* SRFI 61 extended cond */
+      else if (length >= 3
+	       && scm_is_eq (SCM_CADDR (clause), scm_sym_arrow)
+	       && arrow_literal_p)
+	{
+	  ASSERT_SYNTAX_2 (length > 3, s_missing_recipient, clause, expr);
+	  ASSERT_SYNTAX_2 (length == 4, s_extra_expression, clause, expr);
+	  SCM_SETCAR (SCM_CDDR (clause), SCM_IM_ARROW);
+	}
     }
 
   SCM_SETCAR (expr, SCM_IM_COND);
@@ -3427,7 +3436,29 @@
               else
                 {
                   arg1 = EVALCAR (clause, env);
-                  if (scm_is_true (arg1) && !SCM_NILP (arg1))
+		  /* SRFI 61 extended cond */
+		  if (!scm_is_null (SCM_CDR (clause))
+		      && !scm_is_null (SCM_CDDR (clause))
+		      && scm_is_eq (SCM_CADDR (clause), SCM_IM_ARROW))
+		    {
+		      SCM guard_result;
+		      if (SCM_VALUESP (arg1))
+			arg1 = scm_struct_ref (arg1, SCM_INUM0);
+		      else
+			arg1 = scm_list_1 (arg1);
+		      x = SCM_CDR (clause);
+		      proc = EVALCAR (x, env);
+		      guard_result = SCM_APPLY (proc, arg1, SCM_EOL);
+		      if (scm_is_true (guard_result)
+			  && !SCM_NILP (guard_result))
+			{
+			  proc = SCM_CDDR (x);
+			  proc = EVALCAR (proc, env);
+			  PREP_APPLY (proc, arg1);
+			  goto apply_proc;
+			}
+		    }
+                  else if (scm_is_true (arg1) && !SCM_NILP (arg1))
                     {
                       x = SCM_CDR (clause);
                       if (scm_is_null (x))
Index: srfi/Makefile.am
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/srfi/Makefile.am,v
retrieving revision 1.32
diff -d -u -r1.32 Makefile.am
--- srfi/Makefile.am	23 May 2005 19:57:21 -0000	1.32
+++ srfi/Makefile.am	30 Jul 2005 00:02:46 -0000
@@ -75,7 +75,8 @@
             srfi-31.scm \
             srfi-34.scm \
             srfi-39.scm \
-            srfi-60.scm
+            srfi-60.scm \
+	    srfi-61.scm
 
 EXTRA_DIST = $(srfi_DATA) 
 TAGS_FILES = $(srfi_DATA)
Index: doc/ref/srfi-modules.texi
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/doc/ref/srfi-modules.texi,v
retrieving revision 1.67
diff -d -u -r1.67 srfi-modules.texi
--- doc/ref/srfi-modules.texi	3 May 2005 22:50:21 -0000	1.67
+++ doc/ref/srfi-modules.texi	30 Jul 2005 00:02:50 -0000
@@ -40,6 +40,7 @@
 * SRFI-39::                     Parameter objects
 * SRFI-55::                     Requiring Features.
 * SRFI-60::                     Integers as bits.
+* SRFI-61::                     A more general `cond' clause
 @end menu
 
 
@@ -2683,6 +2684,38 @@
 (list->integer '(#t #f #t #f)) @result{} 10
 @end example
 @end defun
+
+
+@node SRFI-61
+@subsection SRFI-61 - A more general @code{cond} clause
+@cindex SRFI-61
+@cindex general cond clause
+@cindex multiple values and cond
+
+This SRFI extends RnRS @code{cond} to support test expressions that
+return multiple values, as well as arbitrary definitions of test
+success.  SRFI 61 is implemented in the Guile core; there's no need to
+use this module at the moment.  However, it may be moved into this
+module, and the module @code{(srfi srfi-61)} is available, so it
+wouldn't hurt to use it.
+
+@deffn {library syntax} cond clause@dots{}
+@xref{if cond case,, Simple Conditional Evaluation}, for the Scheme
+definition.  SRFI 61 adds one more @code{cond}-clause to that syntax:
+
+@lisp
+(@var{test} @var{guard} => @var{expression})
+@end lisp
+
+where @var{guard} and @var{expression} must evaluate to procedures.
+For this clause type, @var{test} may return multiple values, and its
+boolean state is ignored; instead, evaluate @var{guard}, and apply the
+resulting procedure to the value(s) of @var{test}, as if @var{guard}
+were the @var{consumer} argument of @code{call-with-values}.  Iff the
+result of that procedure call is a true value, evaluate
+@var{expression} and apply the resulting procedure to the value(s) of
+@var{test}, in the same manner as the @var{guard} was called.
+@end deffn
 
 
 @c srfi-modules.texi ends here
--- /dev/null	1969-12-31 18:00:00.000000000 -0600
+++ srfi/srfi-61.scm	2005-07-29 17:25:08.000000000 -0500
@@ -0,0 +1,33 @@
+;;; srfi-6.scm --- Basic String Ports
+
+;; 	Copyright (C) 2005 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 as published by the Free Software Foundation; either
+;; version 2.1 of the License, or (at your option) any later version.
+;; 
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; Lesser General Public License for more details.
+;; 
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Commentary:
+
+;; This module is fully documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-61)
+  #:re-export-syntax (cond))
+
+;; Currently, guile provides these functions by default, so no action
+;; is needed, and this file is just a placeholder.
+
+(cond-expand-provide (current-module) '(srfi-61))
+
+;;; srfi-61.scm ends here

[-- Attachment #1.2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 189 bytes --]

[-- Attachment #2: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

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