mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Add SRFI 71: Extended LET-syntax for multiple values.

Browse source 
* module/srfi/srfi-71.scm: New file.
* module/srfi/Makefile.am: Add it.
* doc/ref/srfi-modules.texi: Document it.
* NEWS: Update.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Christopher Allan Webber 2017-06-29 17:19:06 -05:00 • committed by Andy Wingo
parent 8a3cca464e
commit 26fc11a2ae
4 changed files with 300 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

13
NEWS
View file

@ -1,5 +1,5 @@
Guile NEWS --- history of user-visible changes.
Copyright (C) 1996-2017 Free Software Foundation, Inc.
Copyright (C) 1996-2018 Free Software Foundation, Inc.
See the end for copying conditions.
Please send Guile bug reports to bug-guile@gnu.org.
@ -61,6 +61,17 @@ installation with other effective versions (for example, the older Guile
2.2). See "Parallel Installations" in the manual for full details.
Notably, the `pkg-config' file is now `guile-3.0'.
Changes in 2.2.4 (since 2.2.3):
* New interfaces and functionality
** 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.
Changes in 2.2.3 (since 2.2.2):

22
doc/ref/srfi-modules.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000-2004, 2006, 2007-2014, 2017
@c Copyright (C) 1996, 1997, 2000-2004, 2006, 2007-2014, 2017, 2018
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -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.
@ -5400,6 +5401,25 @@ Answer a hash value appropriate for equality predicate @code{equal?},
@code{hash} is a backwards-compatible replacement for Guile's built-in
@code{hash}.
@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-87
@subsection SRFI-87 => in case clauses
@cindex SRFI-87

3
module/srfi/Makefile.am
View file

@ -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.

265
module/srfi/srfi-71.scm Normal file
View file

@ -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.Egner@philips.com, 2005-04-29
;;
;; Adjusted for Guile module system by
;; Christopher Allan Webber <cwebber@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.Egner@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 ---