Hello! SRFI 71 has a pretty cool syntax for assigning multiple values, and I wanted to use it! So here it is, ported to Guile.
I've already assigned Guile copyright papers, as you probably know.
From 373aad0f4ee6bde7e34f8b6b74c85be132df108b Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <cweb...@dustycloud.org>
Date: Thu, 29 Jun 2017 17:19:06 -0500
Subject: [PATCH] Add SRFI 71: Extended LET-syntax for multiple values.
* module/srfi/srfi-71.scm: New file.
* module/srfi/Makefile.am: Add it.
* doc/ref/srfi-modules.texi: Document it.
* NEWS: Update.
---
NEWS | 6 ++
doc/ref/srfi-modules.texi | 20 ++++
module/srfi/Makefile.am | 3 +-
module/srfi/srfi-71.scm | 265 ++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 293 insertions(+), 1 deletion(-)
create mode 100644 module/srfi/srfi-71.scm
diff --git a/NEWS b/NEWS
index 7ce583b9b..ee059fb79 100644
--- a/NEWS
+++ b/NEWS
@@ -17,6 +17,12 @@ The URI standard, RFC 3986, defines additional "relative-ref" and
for these URI subtypes has been improved. See "Universal Resource
Identifiers" in the manual, for more.
+** SRFI-71 (Extended LET-syntax for multiple values)
+
+Guile now includes SRFI-71, which extends let, let*, and letrec to
+support assigning multiple values. See "SRFI-71" in the manual for
+details.
+
* New deprecations
** Using `uri?' as a predicate on relative-refs deprecated
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 3d4415629..4527bebdc 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -58,6 +58,7 @@ get the relevant SRFI documents from the SRFI home page
* SRFI-64:: A Scheme API for test suites.
* SRFI-67:: Compare procedures
* SRFI-69:: Basic hash tables.
+* SRFI-71:: Extended LET-syntax for multiple values.
* SRFI-87:: => in case clauses.
* SRFI-88:: Keyword objects.
* SRFI-98:: Accessing environment variables.
@@ -5211,6 +5212,25 @@ specification of SRFI-64}.
See @uref{http://srfi.schemers.org/srfi-67/srfi-67.html, the
specification of SRFI-67}.
+@node SRFI-71
+@subsection SRFI-71 - Extended LET-syntax for multiple values
+@cindex SRFI-71
+
+This SRFI shadows the forms for @code{let}, @code{let*}, and @code{letrec}
+so that they may accept multiple values. For example:
+
+@example
+(use-modules (srfi srfi-71))
+
+(let* ((x y (values 1 2))
+ (z (+ x y)))
+ (* z 2))
+@result{} 6
+@end example
+
+See @uref{http://srfi.schemers.org/srfi-71/srfi-71.html, the
+specification of SRFI-71}.
+
@node SRFI-69
@subsection SRFI-69 - Basic hash tables
@cindex SRFI-69
diff --git a/module/srfi/Makefile.am b/module/srfi/Makefile.am
index 7cbac6630..8b7e965c5 100644
--- a/module/srfi/Makefile.am
+++ b/module/srfi/Makefile.am
@@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in.
##
-## Copyright (C) 2000, 2004, 2006, 2008 Free Software Foundation, Inc.
+## Copyright (C) 2000, 2004, 2006, 2008, 2017 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -44,6 +44,7 @@ SOURCES = \
srfi-39.scm \
srfi-60.scm \
srfi-69.scm \
+ srfi-71.scm \
srfi-88.scm
# Will poke this later.
diff --git a/module/srfi/srfi-71.scm b/module/srfi/srfi-71.scm
new file mode 100644
index 000000000..8e8f4c77e
--- /dev/null
+++ b/module/srfi/srfi-71.scm
@@ -0,0 +1,265 @@
+;; Copyright (c) 2005 Sebastian Egner.
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a
+;; copy of this software and associated documentation files (the
+;; ``Software''), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included
+;; in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+;; Reference implementation of SRFI-71 using PLT 208's modules
+;; sebastian.eg...@philips.com, 2005-04-29
+;;
+;; Adjusted for Guile module system by
+;; Christopher Allan Webber <cweb...@dustycloud.org>, 2017-06-29
+
+(define-module (srfi srfi-71)
+ #:export (uncons unlist unvector values->list
+ values->vector)
+ #:replace ((srfi-let . let)
+ (srfi-let* . let*)
+ (srfi-letrec . letrec)))
+
+(define-syntax r5rs-let
+ (syntax-rules ()
+ ((r5rs-let ((v x) ...) body1 body ...)
+ (let ((v x) ...) body1 body ...))
+ ((r5rs-let tag ((v x) ...) body1 body ...)
+ (let tag ((v x) ...) body1 body ...))))
+
+(define-syntax r5rs-let*
+ (syntax-rules ()
+ ((r5rs-let* ((v x) ...) body1 body ...)
+ (let* ((v x) ...) body1 body ...))))
+
+(define-syntax r5rs-letrec
+ (syntax-rules ()
+ ((r5rs-letrec ((v x) ...) body1 body ...)
+ (letrec ((v x) ...) body1 body ...))))
+
+; --- textual copy of 'letvalues.scm' starts here ---
+
+; Reference implementation of SRFI-71 (generic part)
+; sebastian.eg...@philips.com, 20-May-2005, PLT 208
+;
+; In order to avoid conflicts with the existing let etc.
+; the macros defined here are called srfi-let etc.,
+; and they are defined in terms of r5rs-let etc.
+; It is up to the actual implementation to save let/*/rec
+; in r5rs-let/*/rec first and redefine let/*/rec
+; by srfi-let/*/rec then.
+;
+; There is also a srfi-letrec* being defined (in view of R6RS.)
+;
+; Macros used internally are named i:<something>.
+;
+; Abbreviations for macro arguments:
+; bs - <binding spec>
+; b - component of a binding spec (values, <variable>, or <expression>)
+; v - <variable>
+; vr - <variable> for rest list
+; x - <expression>
+; t - newly introduced temporary variable
+; vx - (<variable> <expression>)
+; rec - flag if letrec is produced (and not let)
+; cwv - call-with-value skeleton of the form (x formals)
+; (call-with-values (lambda () x) (lambda formals /payload/))
+; where /payload/ is of the form (let (vx ...) body1 body ...).
+;
+; Remark (*):
+; We bind the variables of a letrec to i:undefined since there is
+; no portable (R5RS) way of binding a variable to a values that
+; raises an error when read uninitialized.
+
+(define i:undefined 'undefined)
+
+(define-syntax srfi-letrec* ; -> srfi-letrec
+ (syntax-rules ()
+ ((srfi-letrec* () body1 body ...)
+ (srfi-letrec () body1 body ...))
+ ((srfi-letrec* (bs) body1 body ...)
+ (srfi-letrec (bs) body1 body ...))
+ ((srfi-letrec* (bs1 bs2 bs ...) body1 body ...)
+ (srfi-letrec (bs1) (srfi-letrec* (bs2 bs ...) body1 body ...)))))
+
+(define-syntax srfi-letrec ; -> i:let
+ (syntax-rules ()
+ ((srfi-letrec ((b1 b2 b ...) ...) body1 body ...)
+ (i:let "bs" #t () () (body1 body ...) ((b1 b2 b ...) ...)))))
+
+(define-syntax srfi-let* ; -> srfi-let
+ (syntax-rules ()
+ ((srfi-let* () body1 body ...)
+ (srfi-let () body1 body ...))
+ ((srfi-let* (bs) body1 body ...)
+ (srfi-let (bs) body1 body ...))
+ ((srfi-let* (bs1 bs2 bs ...) body1 body ...)
+ (srfi-let (bs1) (srfi-let* (bs2 bs ...) body1 body ...)))))
+
+(define-syntax srfi-let ; -> i:let or i:named-let
+ (syntax-rules ()
+ ((srfi-let ((b1 b2 b ...) ...) body1 body ...)
+ (i:let "bs" #f () () (body1 body ...) ((b1 b2 b ...) ...)))
+ ((srfi-let tag ((b1 b2 b ...) ...) body1 body ...)
+ (i:named-let tag () (body1 body ...) ((b1 b2 b ...) ...)))))
+
+(define-syntax i:let
+ (syntax-rules (values)
+
+; (i:let "bs" rec (cwv ...) (vx ...) body (bs ...))
+; processes the binding specs bs ... by adding call-with-values
+; skeletons to cwv ... and bindings to vx ..., and afterwards
+; wrapping the skeletons around the payload (let (vx ...) . body).
+
+ ; no more bs to process -> wrap call-with-values skeletons
+ ((i:let "bs" rec (cwv ...) vxs body ())
+ (i:let "wrap" rec vxs body cwv ...))
+
+ ; recognize form1 without variable -> dummy binding for side-effects
+ ((i:let "bs" rec cwvs (vx ...) body (((values) x) bs ...))
+ (i:let "bs" rec cwvs (vx ... (dummy (begin x #f))) body (bs ...)))
+
+ ; recognize form1 with single variable -> just extend vx ...
+ ((i:let "bs" rec cwvs (vx ...) body (((values v) x) bs ...))
+ (i:let "bs" rec cwvs (vx ... (v x)) body (bs ...)))
+
+ ; recognize form1 without rest arg -> generate cwv
+ ((i:let "bs" rec cwvs vxs body (((values v ...) x) bs ...))
+ (i:let "form1" rec cwvs vxs body (bs ...) (x ()) (values v ...)))
+
+ ; recognize form1 with rest arg -> generate cwv
+ ((i:let "bs" rec cwvs vxs body (((values . vs) x) bs ...))
+ (i:let "form1+" rec cwvs vxs body (bs ...) (x ()) (values . vs)))
+
+ ; recognize form2 with single variable -> just extend vx ...
+ ((i:let "bs" rec cwvs (vx ...) body ((v x) bs ...))
+ (i:let "bs" rec cwvs (vx ... (v x)) body (bs ...)))
+
+ ; recognize form2 with >=2 variables -> transform to form1
+ ((i:let "bs" rec cwvs vxs body ((b1 b2 b3 b ...) bs ...))
+ (i:let "form2" rec cwvs vxs body (bs ...) (b1 b2) (b3 b ...)))
+
+; (i:let "form1" rec cwvs vxs body bss (x (t ...)) (values v1 v2 v ...))
+; processes the variables in v1 v2 v ... adding them to (t ...)
+; and producing a cwv when finished. There is not rest argument.
+
+ ((i:let "form1" rec (cwv ...) vxs body bss (x ts) (values))
+ (i:let "bs" rec (cwv ... (x ts)) vxs body bss))
+ ((i:let "form1" rec cwvs (vx ...) body bss (x (t ...)) (values v1 v ...))
+ (i:let "form1" rec cwvs (vx ... (v1 t1)) body bss (x (t ... t1)) (values v ...)))
+
+; (i:let "form1+" rec cwvs vxs body bss (x (t ...)) (values v ... . vr))
+; processes the variables in v ... . vr adding them to (t ...)
+; and producing a cwv when finished. The rest arg is vr.
+
+ ((i:let "form1+" rec cwvs (vx ...) body bss (x (t ...)) (values v1 v2 . vs))
+ (i:let "form1+" rec cwvs (vx ... (v1 t1)) body bss (x (t ... t1)) (values v2 . vs)))
+ ((i:let "form1+" rec (cwv ...) (vx ...) body bss (x (t ...)) (values v1 . vr))
+ (i:let "bs" rec (cwv ... (x (t ... t1 . tr))) (vx ... (v1 t1) (vr tr)) body bss))
+ ((i:let "form1+" rec (cwv ...) (vx ...) body bss (x ()) (values . vr))
+ (i:let "bs" rec (cwv ... (x tr)) (vx ... (vr tr)) body bss))
+
+; (i:let "form2" rec cwvs vxs body bss (v ...) (b ... x))
+; processes the binding items (b ... x) from form2 as in
+; (v ... b ... x) into ((values v ... b ...) x), i.e. form1.
+; Then call "bs" recursively.
+
+ ((i:let "form2" rec cwvs vxs body (bs ...) (v ...) (x))
+ (i:let "bs" rec cwvs vxs body (((values v ...) x) bs ...)))
+ ((i:let "form2" rec cwvs vxs body bss (v ...) (b1 b2 b ...))
+ (i:let "form2" rec cwvs vxs body bss (v ... b1) (b2 b ...)))
+
+; (i:let "wrap" rec ((v x) ...) (body ...) cwv ...)
+; wraps cwv ... around the payload generating the actual code.
+; For letrec this is of course different than for let.
+
+ ((i:let "wrap" #f vxs body)
+ (r5rs-let vxs . body))
+ ((i:let "wrap" #f vxs body (x formals) cwv ...)
+ (call-with-values
+ (lambda () x)
+ (lambda formals (i:let "wrap" #f vxs body cwv ...))))
+
+ ((i:let "wrap" #t vxs body)
+ (r5rs-letrec vxs . body))
+ ((i:let "wrap" #t ((v t) ...) body cwv ...)
+ (r5rs-let ((v i:undefined) ...) ; (*)
+ (i:let "wraprec" ((v t) ...) body cwv ...)))
+
+; (i:let "wraprec" ((v t) ...) body cwv ...)
+; generate the inner code for a letrec. The variables v ...
+; are the user-visible variables (bound outside), and t ...
+; are the temporary variables bound by the cwv consumers.
+
+ ((i:let "wraprec" ((v t) ...) (body ...))
+ (begin (set! v t) ... (r5rs-let () body ...)))
+ ((i:let "wraprec" vxs body (x formals) cwv ...)
+ (call-with-values
+ (lambda () x)
+ (lambda formals (i:let "wraprec" vxs body cwv ...))))
+
+ ))
+
+(define-syntax i:named-let
+ (syntax-rules (values)
+
+; (i:named-let tag (vx ...) body (bs ...))
+; processes the binding specs bs ... by extracting the variable
+; and expression, adding them to vx and turning the result into
+; an ordinary named let.
+
+ ((i:named-let tag vxs body ())
+ (r5rs-let tag vxs . body))
+ ((i:named-let tag (vx ...) body (((values v) x) bs ...))
+ (i:named-let tag (vx ... (v x)) body (bs ...)))
+ ((i:named-let tag (vx ...) body ((v x) bs ...))
+ (i:named-let tag (vx ... (v x)) body (bs ...)))))
+
+; --- standard procedures ---
+
+(define (uncons pair)
+ (values (car pair) (cdr pair)))
+
+(define (uncons-2 list)
+ (values (car list) (cadr list) (cddr list)))
+
+(define (uncons-3 list)
+ (values (car list) (cadr list) (caddr list) (cdddr list)))
+
+(define (uncons-4 list)
+ (values (car list) (cadr list) (caddr list) (cadddr list) (cddddr list)))
+
+(define (uncons-cons alist)
+ (values (caar alist) (cdar alist) (cdr alist)))
+
+(define (unlist list)
+ (apply values list))
+
+(define (unvector vector)
+ (apply values (vector->list vector)))
+
+; --- standard macros ---
+
+(define-syntax values->list
+ (syntax-rules ()
+ ((values->list x)
+ (call-with-values (lambda () x) list))))
+
+(define-syntax values->vector
+ (syntax-rules ()
+ ((values->vector x)
+ (call-with-values (lambda () x) vector))))
+
+; --- textual copy of 'letvalues.scm' ends here ---
--
2.13.1
signature.asc
Description: PGP signature
