On Fri, 2005-07-29 at 19:25 -0500, Stephen Compall wrote: > Attached is a patch against guile-core CVS HEAD to implement SRFI 61 in > the core.
This one should work, ah, slightly better. -- Stephen Compall
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 01:17:19 -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 xx, guard_result;
+ if (SCM_VALUESP (arg1))
+ arg1 = scm_struct_ref (arg1, SCM_INUM0);
+ else
+ arg1 = scm_list_1 (arg1);
+ xx = SCM_CDR (clause);
+ proc = EVALCAR (xx, env);
+ guard_result = SCM_APPLY (proc, arg1, SCM_EOL);
+ if (scm_is_true (guard_result)
+ && !SCM_NILP (guard_result))
+ {
+ proc = SCM_CDDR (xx);
+ 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 01:17:20 -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 01:17:22 -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
+
+
[EMAIL PROTECTED] SRFI-61
[EMAIL PROTECTED] SRFI-61 - A more general @code{cond} clause
[EMAIL PROTECTED] SRFI-61
[EMAIL PROTECTED] general cond clause
[EMAIL PROTECTED] 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.
+
[EMAIL PROTECTED] {library syntax} cond [EMAIL PROTECTED]
[EMAIL PROTECTED] cond case,, Simple Conditional Evaluation}, for the Scheme
+definition. SRFI 61 adds one more @code{cond}-clause to that syntax:
+
[EMAIL PROTECTED]
+(@var{test} @var{guard} => @var{expression})
[EMAIL PROTECTED] 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
[EMAIL PROTECTED] and apply the resulting procedure to the value(s) of
[EMAIL PROTECTED], in the same manner as the @var{guard} was called.
[EMAIL PROTECTED] 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
signature.asc
Description: This is a digitally signed message part
_______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://lists.gnu.org/mailman/listinfo/guile-devel
