summaryrefslogtreecommitdiff
path: root/srfi/srfi-11.scm
diff options
context:
space:
mode:
Diffstat (limited to 'srfi/srfi-11.scm')
-rw-r--r--srfi/srfi-11.scm281
1 files changed, 0 insertions, 281 deletions
diff --git a/srfi/srfi-11.scm b/srfi/srfi-11.scm
deleted file mode 100644
index cabd8e6f3..000000000
--- a/srfi/srfi-11.scm
+++ /dev/null
@@ -1,281 +0,0 @@
-;;; srfi-11.scm --- let-values and let*-values
-
-;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
-;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or
-;; (at your option) any later version.
-;;
-;; This program 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
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this software; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;; Boston, MA 02111-1307 USA
-;;
-;; As a special exception, the Free Software Foundation gives permission
-;; for additional uses of the text contained in its release of GUILE.
-;;
-;; The exception is that, if you link the GUILE library with other files
-;; to produce an executable, this does not by itself cause the
-;; resulting executable to be covered by the GNU General Public License.
-;; Your use of that executable is in no way restricted on account of
-;; linking the GUILE library code into it.
-;;
-;; This exception does not however invalidate any other reasons why
-;; the executable file might be covered by the GNU General Public License.
-;;
-;; This exception applies only to the code released by the
-;; Free Software Foundation under the name GUILE. If you copy
-;; code from other Free Software Foundation releases into a copy of
-;; GUILE, as the General Public License permits, the exception does
-;; not apply to the code that you add in this way. To avoid misleading
-;; anyone as to the status of such modified files, you must delete
-;; this exception notice from them.
-;;
-;; If you write modifications of your own for GUILE, it is your choice
-;; whether to permit this exception to apply to your modifications.
-;; If you do not wish that, delete this exception notice.
-
-;;; Commentary:
-
-;; This module exports two syntax forms: let-values and let*-values.
-;;
-;; Sample usage:
-;;
-;; (let-values (((x y . z) (foo a b))
-;; ((p q) (bar c)))
-;; (baz x y z p q))
-;;
-;; This binds `x' and `y' to the first to values returned by `foo',
-;; `z' to the rest of the values from `foo', and `p' and `q' to the
-;; values returned by `bar'. All of these are available to `baz'.
-;;
-;; let*-values : let-values :: let* : let
-;;
-;; This module is fully documented in the Guile Reference Manual.
-
-;;; Code:
-
-(define-module (srfi srfi-11)
- :use-module (ice-9 syncase)
- :export-syntax (let-values let*-values))
-
-(cond-expand-provide (current-module) '(srfi-11))
-
-;;;;;;;;;;;;;;
-;; let-values
-;;
-;; Current approach is to translate
-;;
-;; (let-values (((x y . z) (foo a b))
-;; ((p q) (bar c)))
-;; (baz x y z p q))
-;;
-;; into
-;;
-;; (call-with-values (lambda () (foo a b))
-;; (lambda (<tmp-x> <tmp-y> . <tmp-z>)
-;; (call-with-values (lambda () (bar c))
-;; (lambda (<tmp-p> <tmp-q>)
-;; (let ((x <tmp-x>)
-;; (y <tmp-y>)
-;; (z <tmp-z>)
-;; (p <tmp-p>)
-;; (q <tmp-q>))
-;; (baz x y z p q))))))
-
-;; I originally wrote this as a define-macro, but then I found out
-;; that guile's gensym/gentemp was broken, so I tried rewriting it as
-;; a syntax-rules statement.
-;;
-;; Since syntax-rules didn't seem powerful enough to implement
-;; let-values in one definition without exposing illegal syntax (or
-;; perhaps my brain's just not powerful enough :>). I tried writing
-;; it using a private helper, but that didn't work because the
-;; let-values expands outside the scope of this module. I wonder why
-;; syntax-rules wasn't designed to allow "private" patterns or
-;; similar...
-;;
-;; So in the end, I dumped the syntax-rules implementation, reproduced
-;; here for posterity, and went with the define-macro one below --
-;; gensym/gentemp's got to be fixed anyhow...
-;
-; (define-syntax let-values-helper
-; (syntax-rules ()
-; ;; Take the vars from one let binding (i.e. the (x y z) from ((x y
-; ;; z) (values 1 2 3)) and turn it in to the corresponding (lambda
-; ;; (<tmp-x> <tmp-y> <tmp-z>) ...) from above, keeping track of the
-; ;; temps you create so you can use them later...
-; ;;
-; ;; I really don't fully understand why the (var-1 var-1) trick
-; ;; works below, but basically, when all those (x x) bindings show
-; ;; up in the final "let", syntax-rules forces a renaming.
-
-; ((_ "consumer" () lambda-tmps final-let-bindings lv-bindings
-; body ...)
-; (lambda lambda-tmps
-; (let-values-helper "cwv" lv-bindings final-let-bindings body ...)))
-
-; ((_ "consumer" (var-1 var-2 ...) (lambda-tmp ...) final-let-bindings lv-bindings
-; body ...)
-; (let-values-helper "consumer"
-; (var-2 ...)
-; (lambda-tmp ... var-1)
-; ((var-1 var-1) . final-let-bindings)
-; lv-bindings
-; body ...))
-
-; ((_ "cwv" () final-let-bindings body ...)
-; (let final-let-bindings
-; body ...))
-
-; ((_ "cwv" ((vars-1 binding-1) other-bindings ...) final-let-bindings
-; body ...)
-; (call-with-values (lambda () binding-1)
-; (let-values-helper "consumer"
-; vars-1
-; ()
-; final-let-bindings
-; (other-bindings ...)
-; body ...)))))
-;
-; (define-syntax let-values
-; (syntax-rules ()
-; ((let-values () body ...)
-; (begin body ...))
-; ((let-values (binding ...) body ...)
-; (let-values-helper "cwv" (binding ...) () body ...))))
-;
-;
-; (define-syntax let-values
-; (letrec-syntax ((build-consumer
-; ;; Take the vars from one let binding (i.e. the (x
-; ;; y z) from ((x y z) (values 1 2 3)) and turn it
-; ;; in to the corresponding (lambda (<tmp-x> <tmp-y>
-; ;; <tmp-z>) ...) from above.
-; (syntax-rules ()
-; ((_ () new-tmps tmp-vars () body ...)
-; (lambda new-tmps
-; body ...))
-; ((_ () new-tmps tmp-vars vars body ...)
-; (lambda new-tmps
-; (lv-builder vars tmp-vars body ...)))
-; ((_ (var-1 var-2 ...) new-tmps tmp-vars vars body ...)
-; (build-consumer (var-2 ...)
-; (tmp-1 . new-tmps)
-; ((var-1 tmp-1) . tmp-vars)
-; bindings
-; body ...))))
-; (lv-builder
-; (syntax-rules ()
-; ((_ () tmp-vars body ...)
-; (let tmp-vars
-; body ...))
-; ((_ ((vars-1 binding-1) (vars-2 binding-2) ...)
-; tmp-vars
-; body ...)
-; (call-with-values (lambda () binding-1)
-; (build-consumer vars-1
-; ()
-; tmp-vars
-; ((vars-2 binding-2) ...)
-; body ...))))))
-;
-; (syntax-rules ()
-; ((_ () body ...)
-; (begin body ...))
-; ((_ ((vars binding) ...) body ...)
-; (lv-builder ((vars binding) ...) () body ...)))))
-
-;; FIXME: This is currently somewhat unsafe (b/c gentemp/gensym is
-;; broken -- right now (as of 1.4.1, it doesn't generate unique
-;; symbols)
-(define-macro (let-values vars . body)
-
- (define (map-1-dot proc elts)
- ;; map over one optionally dotted (a b c . d) list, producing an
- ;; optionally dotted result.
- (cond
- ((null? elts) '())
- ((pair? elts) (cons (proc (car elts)) (map-1-dot proc (cdr elts))))
- (else (proc elts))))
-
- (define (undot-list lst)
- ;; produce a non-dotted list from a possibly dotted list.
- (cond
- ((null? lst) '())
- ((pair? lst) (cons (car lst) (undot-list (cdr lst))))
- (else (list lst))))
-
- (define (let-values-helper vars body prev-let-vars)
- (let* ((var-binding (car vars))
- (new-tmps (map-1-dot (lambda (sym) (gensym))
- (car var-binding)))
- (let-vars (map (lambda (sym tmp) (list sym tmp))
- (undot-list (car var-binding))
- (undot-list new-tmps))))
-
- (if (null? (cdr vars))
- `(call-with-values (lambda () ,(cadr var-binding))
- (lambda ,new-tmps
- (let ,(apply append let-vars prev-let-vars)
- ,@body)))
- `(call-with-values (lambda () ,(cadr var-binding))
- (lambda ,new-tmps
- ,(let-values-helper (cdr vars) body
- (cons let-vars prev-let-vars)))))))
-
- (if (null? vars)
- `(begin ,@body)
- (let-values-helper vars body '())))
-
-;;;;;;;;;;;;;;
-;; let*-values
-;;
-;; Current approach is to translate
-;;
-;; (let*-values (((x y z) (foo a b))
-;; ((p q) (bar c)))
-;; (baz x y z p q))
-;;
-;; into
-;;
-;; (call-with-values (lambda () (foo a b))
-;; (lambda (x y z)
-;; (call-with-values (lambda (bar c))
-;; (lambda (p q)
-;; (baz x y z p q)))))
-
-(define-syntax let*-values
- (syntax-rules ()
- ((let*-values () body ...)
- (begin body ...))
- ((let*-values ((vars-1 binding-1) (vars-2 binding-2) ...) body ...)
- (call-with-values (lambda () binding-1)
- (lambda vars-1
- (let*-values ((vars-2 binding-2) ...)
- body ...))))))
-
-; Alternate define-macro implementation...
-;
-; (define-macro (let*-values vars . body)
-; (define (let-values-helper vars body)
-; (let ((var-binding (car vars)))
-; (if (null? (cdr vars))
-; `(call-with-values (lambda () ,(cadr var-binding))
-; (lambda ,(car var-binding)
-; ,@body))
-; `(call-with-values (lambda () ,(cadr var-binding))
-; (lambda ,(car var-binding)
-; ,(let-values-helper (cdr vars) body))))))
-
-; (if (null? vars)
-; `(begin ,@body)
-; (let-values-helper vars body)))
-
-;;; srfi-11.scm ends here