1 ;;; srfi-11.scm --- let-values and let*-values
3 ;; Copyright (C) 2000, 2001, 2002, 2004, 2006 Free Software Foundation, Inc.
5 ;; This library is free software; you can redistribute it and/or
6 ;; modify it under the terms of the GNU Lesser General Public
7 ;; License as published by the Free Software Foundation; either
8 ;; version 2.1 of the License, or (at your option) any later version.
10 ;; This library is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with this library; if not, write to the Free Software
17 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 ;; This module exports two syntax forms: let-values and let*-values.
25 ;; (let-values (((x y . z) (foo a b))
29 ;; This binds `x' and `y' to the first to values returned by `foo',
30 ;; `z' to the rest of the values from `foo', and `p' and `q' to the
31 ;; values returned by `bar'. All of these are available to `baz'.
33 ;; let*-values : let-values :: let* : let
35 ;; This module is fully documented in the Guile Reference Manual.
39 (define-module (srfi srfi-11)
40 :use-module (ice-9 syncase)
41 :export-syntax (let-values let*-values))
43 (cond-expand-provide (current-module) '(srfi-11))
48 ;; Current approach is to translate
50 ;; (let-values (((x y . z) (foo a b))
56 ;; (call-with-values (lambda () (foo a b))
57 ;; (lambda (<tmp-x> <tmp-y> . <tmp-z>)
58 ;; (call-with-values (lambda () (bar c))
59 ;; (lambda (<tmp-p> <tmp-q>)
65 ;; (baz x y z p q))))))
67 ;; I originally wrote this as a define-macro, but then I found out
68 ;; that guile's gensym/gentemp was broken, so I tried rewriting it as
69 ;; a syntax-rules statement.
70 ;; [make-symbol now fixes gensym/gentemp problems.]
72 ;; Since syntax-rules didn't seem powerful enough to implement
73 ;; let-values in one definition without exposing illegal syntax (or
74 ;; perhaps my brain's just not powerful enough :>). I tried writing
75 ;; it using a private helper, but that didn't work because the
76 ;; let-values expands outside the scope of this module. I wonder why
77 ;; syntax-rules wasn't designed to allow "private" patterns or
80 ;; So in the end, I dumped the syntax-rules implementation, reproduced
81 ;; here for posterity, and went with the define-macro one below --
82 ;; gensym/gentemp's got to be fixed anyhow...
84 ; (define-syntax let-values-helper
86 ; ;; Take the vars from one let binding (i.e. the (x y z) from ((x y
87 ; ;; z) (values 1 2 3)) and turn it in to the corresponding (lambda
88 ; ;; (<tmp-x> <tmp-y> <tmp-z>) ...) from above, keeping track of the
89 ; ;; temps you create so you can use them later...
91 ; ;; I really don't fully understand why the (var-1 var-1) trick
92 ; ;; works below, but basically, when all those (x x) bindings show
93 ; ;; up in the final "let", syntax-rules forces a renaming.
95 ; ((_ "consumer" () lambda-tmps final-let-bindings lv-bindings
98 ; (let-values-helper "cwv" lv-bindings final-let-bindings body ...)))
100 ; ((_ "consumer" (var-1 var-2 ...) (lambda-tmp ...) final-let-bindings lv-bindings
102 ; (let-values-helper "consumer"
104 ; (lambda-tmp ... var-1)
105 ; ((var-1 var-1) . final-let-bindings)
109 ; ((_ "cwv" () final-let-bindings body ...)
110 ; (let final-let-bindings
113 ; ((_ "cwv" ((vars-1 binding-1) other-bindings ...) final-let-bindings
115 ; (call-with-values (lambda () binding-1)
116 ; (let-values-helper "consumer"
120 ; (other-bindings ...)
123 ; (define-syntax let-values
125 ; ((let-values () body ...)
127 ; ((let-values (binding ...) body ...)
128 ; (let-values-helper "cwv" (binding ...) () body ...))))
131 ; (define-syntax let-values
132 ; (letrec-syntax ((build-consumer
133 ; ;; Take the vars from one let binding (i.e. the (x
134 ; ;; y z) from ((x y z) (values 1 2 3)) and turn it
135 ; ;; in to the corresponding (lambda (<tmp-x> <tmp-y>
136 ; ;; <tmp-z>) ...) from above.
138 ; ((_ () new-tmps tmp-vars () body ...)
141 ; ((_ () new-tmps tmp-vars vars body ...)
143 ; (lv-builder vars tmp-vars body ...)))
144 ; ((_ (var-1 var-2 ...) new-tmps tmp-vars vars body ...)
145 ; (build-consumer (var-2 ...)
147 ; ((var-1 tmp-1) . tmp-vars)
152 ; ((_ () tmp-vars body ...)
155 ; ((_ ((vars-1 binding-1) (vars-2 binding-2) ...)
158 ; (call-with-values (lambda () binding-1)
159 ; (build-consumer vars-1
162 ; ((vars-2 binding-2) ...)
168 ; ((_ ((vars binding) ...) body ...)
169 ; (lv-builder ((vars binding) ...) () body ...)))))
171 (define-macro (let-values vars . body)
173 (define (map-1-dot proc elts)
174 ;; map over one optionally dotted (a b c . d) list, producing an
175 ;; optionally dotted result.
178 ((pair? elts) (cons (proc (car elts)) (map-1-dot proc (cdr elts))))
181 (define (undot-list lst)
182 ;; produce a non-dotted list from a possibly dotted list.
185 ((pair? lst) (cons (car lst) (undot-list (cdr lst))))
188 (define (let-values-helper vars body prev-let-vars)
189 (let* ((var-binding (car vars))
190 (new-tmps (map-1-dot (lambda (sym) (make-symbol "let-values-var"))
192 (let-vars (map (lambda (sym tmp) (list sym tmp))
193 (undot-list (car var-binding))
194 (undot-list new-tmps))))
196 (if (null? (cdr vars))
197 `(call-with-values (lambda () ,(cadr var-binding))
199 (let ,(apply append let-vars prev-let-vars)
201 `(call-with-values (lambda () ,(cadr var-binding))
203 ,(let-values-helper (cdr vars) body
204 (cons let-vars prev-let-vars)))))))
208 (let-values-helper vars body '())))
213 ;; Current approach is to translate
215 ;; (let*-values (((x y z) (foo a b))
221 ;; (call-with-values (lambda () (foo a b))
223 ;; (call-with-values (lambda (bar c))
225 ;; (baz x y z p q)))))
227 (define-syntax let*-values
229 ((let*-values () body ...)
231 ((let*-values ((vars-1 binding-1) (vars-2 binding-2) ...) body ...)
232 (call-with-values (lambda () binding-1)
234 (let*-values ((vars-2 binding-2) ...)
237 ; Alternate define-macro implementation...
239 ; (define-macro (let*-values vars . body)
240 ; (define (let-values-helper vars body)
241 ; (let ((var-binding (car vars)))
242 ; (if (null? (cdr vars))
243 ; `(call-with-values (lambda () ,(cadr var-binding))
244 ; (lambda ,(car var-binding)
246 ; `(call-with-values (lambda () ,(cadr var-binding))
247 ; (lambda ,(car var-binding)
248 ; ,(let-values-helper (cdr vars) body))))))
252 ; (let-values-helper vars body)))
254 ;;; srfi-11.scm ends here