LilyPond-Ruby 0.1.1 → 0.1.2

data/share/guile/2.2/srfi/srfi-67.scm

@@ -0,0 +1,88 @@
+;;; srfi-67.scm --- Compare Procedures
+
+;; Copyright (C) 2010 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 3 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, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This module is not yet documented in the Guile Reference Manual.
+
+;;; Code:
+
+(define-module (srfi srfi-67)
+  #:export (</<=?
+            </<?
+            <=/<=?
+            <=/<?
+            <=?
+            <?
+            =?
+            >/>=?
+            >/>?
+            >=/>=?
+            >=/>?
+            >=?
+            >?
+            boolean-compare
+            chain<=?
+            chain<?
+            chain=?
+            chain>=?
+            chain>?
+            char-compare
+            char-compare-ci
+            compare-by<
+            compare-by<=
+            compare-by=/<
+            compare-by=/>
+            compare-by>
+            compare-by>=
+            complex-compare
+            cond-compare
+            debug-compare
+            default-compare
+            if-not=?
+            if3
+            if<=?
+            if<?
+            if=?
+            if>=?
+            if>?
+            integer-compare
+            kth-largest
+            list-compare
+            list-compare-as-vector
+            max-compare
+            min-compare
+            not=?
+            number-compare
+            pair-compare
+            pair-compare-car
+            pair-compare-cdr
+            pairwise-not=?
+            rational-compare
+            real-compare
+            refine-compare
+            select-compare
+            symbol-compare
+            vector-compare
+            vector-compare-as-list)
+  #:replace (string-compare string-compare-ci)
+  #:use-module (srfi srfi-27))
+
+(cond-expand-provide (current-module) '(srfi-67))
+
+(include-from-path "srfi/srfi-67/compare.scm")

data/share/guile/2.2/srfi/srfi-69.scm

@@ -0,0 +1,336 @@
+;;; srfi-69.scm --- Basic hash tables
+
+;; 	Copyright (C) 2007 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 3 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:
+
+;; My `hash' is compatible with core `hash', so I replace it.
+;; However, my `hash-table?' and `make-hash-table' are different, so
+;; importing this module will warn about them.  If you don't rename my
+;; imports, you shouldn't use both my hash tables and Guile's hash
+;; tables in the same module.
+;;
+;; SRFI-13 `string-hash' and `string-hash-ci' have more arguments, but
+;; are compatible with my `string-hash' and `string-ci-hash', and are
+;; furthermore primitive in Guile, so I use them as my own.
+;;
+;; I also have the extension of allowing hash functions that require a
+;; second argument to be used as the `hash-table-hash-function', and use
+;; these in defaults to avoid an indirection in the hashx functions.  The
+;; only deviation this causes is:
+;;
+;;  ((hash-table-hash-function (make-hash-table)) obj)
+;;  error> Wrong number of arguments to #<primitive-procedure hash>
+;;
+;; I don't think that SRFI 69 actually specifies that I *can't* do this,
+;; because it only implies the signature of a hash function by way of the
+;; named, exported hash functions.  However, if this matters enough I can
+;; add a private derivation of hash-function to the srfi-69:hash-table
+;; record type, like associator is to equivalence-function.
+;;
+;; Also, outside of the issue of how weak keys and values are referenced
+;; outside the table, I always interpret key equivalence to be that of
+;; the `hash-table-equivalence-function'.  For example, given the
+;; requirement that `alist->hash-table' give earlier associations
+;; priority, what should these answer?
+;;
+;;  (hash-table-keys
+;;   (alist->hash-table '(("xY" . 1) ("Xy" . 2)) string-ci=?))
+;;
+;;  (let ((ht (make-hash-table string-ci=?)))
+;;    (hash-table-set! ht "xY" 2)
+;;    (hash-table-set! ht "Xy" 1)
+;;    (hash-table-keys ht))
+;;
+;; My interpretation is that they can answer either ("Xy") or ("xY"),
+;; where `hash-table-values' will of course always answer (1), because
+;; the keys are the same according to the equivalence function.  In this
+;; implementation, both answer ("xY").  However, I don't guarantee that
+;; this won't change in the future.
+
+;;; Code:
+
+;;;; Module definition & exports
+
+(define-module (srfi srfi-69)
+  #:use-module (srfi srfi-1)	;alist-cons,second&c,assoc
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-13)	;string-hash,string-hash-ci
+  #:use-module (ice-9 optargs)
+  #:export (;; Type constructors & predicate
+	    make-hash-table hash-table? alist->hash-table
+	    ;; Reflective queries
+	    hash-table-equivalence-function hash-table-hash-function
+	    ;; Dealing with single elements
+	    hash-table-ref hash-table-ref/default hash-table-set!
+	    hash-table-delete! hash-table-exists? hash-table-update!
+	    hash-table-update!/default
+	    ;; Dealing with the whole contents
+	    hash-table-size hash-table-keys hash-table-values
+	    hash-table-walk hash-table-fold hash-table->alist
+	    hash-table-copy hash-table-merge!
+	    ;; Hashing
+	    string-ci-hash hash-by-identity)
+  #:re-export (string-hash)
+  #:replace (hash make-hash-table hash-table?))
+
+(cond-expand-provide (current-module) '(srfi-69))
+
+;;;; Internal helper macros
+
+;; Define these first, so the compiler will pick them up.
+
+;; I am a macro only for efficiency, to avoid varargs/apply.
+(define-macro (hashx-invoke hashx-proc ht-var . args)
+  "Invoke HASHX-PROC, a `hashx-*' procedure taking a hash-function,
+assoc-function, and the hash-table as first args."
+  `(,hashx-proc (hash-table-hash-function ,ht-var)
+		(ht-associator ,ht-var)
+		(ht-real-table ,ht-var)
+		. ,args))
+
+(define-macro (with-hashx-values bindings ht-var . body-forms)
+  "Bind BINDINGS to the hash-function, associator, and real-table of
+HT-VAR, while evaluating BODY-FORMS."
+  `(let ((,(first bindings) (hash-table-hash-function ,ht-var))
+	 (,(second bindings) (ht-associator ,ht-var))
+	 (,(third bindings) (ht-real-table ,ht-var)))
+     . ,body-forms))
+
+
+;;;; Hashing
+
+;;; The largest fixnum is in `most-positive-fixnum' in module (guile),
+;;; though not documented anywhere but libguile/numbers.c.
+
+(define (caller-with-default-size hash-fn)
+  "Answer a function that makes `most-positive-fixnum' the default
+second argument to HASH-FN, a 2-arg procedure."
+  (lambda* (obj #:optional (size most-positive-fixnum))
+    (hash-fn obj size)))
+
+(define hash (caller-with-default-size (@ (guile) hash)))
+
+(define string-ci-hash string-hash-ci)
+
+(define hash-by-identity (caller-with-default-size hashq))
+
+;;;; Reflective queries, construction, predicate
+
+(define-record-type srfi-69:hash-table
+  (make-srfi-69-hash-table real-table associator size weakness
+			   equivalence-function hash-function)
+  hash-table?
+  (real-table ht-real-table)
+  (associator ht-associator)
+  ;; required for O(1) by SRFI-69.  It really makes a mess of things,
+  ;; and I'd like to compute it in O(n) and memoize it because it
+  ;; doesn't seem terribly useful, but SRFI-69 is final.
+  (size ht-size ht-size!)
+  ;; required for `hash-table-copy'
+  (weakness ht-weakness)
+  ;; used only to implement hash-table-equivalence-function; I don't
+  ;; use it internally other than for `ht-associator'.
+  (equivalence-function hash-table-equivalence-function)
+  (hash-function hash-table-hash-function))
+
+(define (guess-hash-function equal-proc)
+  "Guess a hash function for EQUAL-PROC, falling back on `hash', as
+specified in SRFI-69 for `make-hash-table'."
+  (cond ((eq? equal? equal-proc) (@ (guile) hash)) ;shortcut most common case
+	((eq? eq? equal-proc) hashq)
+	((eq? eqv? equal-proc) hashv)
+	((eq? string=? equal-proc) string-hash)
+	((eq? string-ci=? equal-proc) string-ci-hash)
+	(else (@ (guile) hash))))
+
+(define (without-keyword-args rest-list)
+  "Answer REST-LIST with all keywords removed along with items that
+follow them."
+  (let lp ((acc '()) (rest-list rest-list))
+    (cond ((null? rest-list) (reverse! acc))
+	  ((keyword? (first rest-list))
+	   (lp acc (cddr rest-list)))
+	  (else (lp (cons (first rest-list) acc) (cdr rest-list))))))
+
+(define (guile-ht-ctor weakness)
+  "Answer the Guile HT constructor for the given WEAKNESS."
+  (case weakness
+    ((#f) (@ (guile) make-hash-table))
+    ((key) make-weak-key-hash-table)
+    ((value) make-weak-value-hash-table)
+    ((key-or-value) make-doubly-weak-hash-table)
+    (else (error "Invalid weak hash table type" weakness))))
+
+(define (equivalence-proc->associator equal-proc)
+  "Answer an `assoc'-like procedure that compares the argument key to
+alist keys with EQUAL-PROC."
+  (cond ((or (eq? equal? equal-proc)
+	     (eq? string=? equal-proc)) (@ (guile) assoc))
+	((eq? eq? equal-proc) assq)
+	((eq? eqv? equal-proc) assv)
+	(else (lambda (item alist)
+		(assoc item alist equal-proc)))))
+
+(define* (make-hash-table
+	  #:optional (equal-proc equal?)
+	  (hash-proc (guess-hash-function equal-proc))
+	  #:key (weak #f) #:rest guile-opts)
+  "Answer a new hash table using EQUAL-PROC as the comparison
+function, and HASH-PROC as the hash function.  See the reference
+manual for specifics, of which there are many."
+  (make-srfi-69-hash-table
+   (apply (guile-ht-ctor weak) (without-keyword-args guile-opts))
+   (equivalence-proc->associator equal-proc)
+   0 weak equal-proc hash-proc))
+
+(define (alist->hash-table alist . mht-args)
+  "Convert ALIST to a hash table created with MHT-ARGS."
+  (let* ((result (apply make-hash-table mht-args))
+	 (size (ht-size result)))
+    (with-hashx-values (hash-proc associator real-table) result
+      (for-each (lambda (pair)
+		  (let ((handle (hashx-get-handle hash-proc associator
+						  real-table (car pair))))
+		    (cond ((not handle)
+			   (set! size (1+ size))
+			   (hashx-set! hash-proc associator real-table
+				       (car pair) (cdr pair))))))
+		alist))
+    (ht-size! result size)
+    result))
+
+;;;; Accessing table items
+
+;; We use this to denote missing or unspecified values to avoid
+;; possible collision with *unspecified*.
+(define ht-unspecified (cons *unspecified* "ht-value"))
+
+(define (hash-table-ref ht key . default-thunk-lst)
+  "Lookup KEY in HT and answer the value, invoke DEFAULT-THUNK if KEY
+isn't present, or signal an error if DEFAULT-THUNK isn't provided."
+  (let ((result (hashx-invoke hashx-ref ht key ht-unspecified)))
+    (if (eq? ht-unspecified result)
+	(if (pair? default-thunk-lst)
+	    ((first default-thunk-lst))
+	    (error "Key not in table" key ht))
+	result)))
+
+(define (hash-table-ref/default ht key default)
+  "Lookup KEY in HT and answer the value.  Answer DEFAULT if KEY isn't
+present."
+  (hashx-invoke hashx-ref ht key default))
+
+(define (hash-table-set! ht key new-value)
+  "Set KEY to NEW-VALUE in HT."
+  (let ((handle (hashx-invoke hashx-create-handle! ht key ht-unspecified)))
+    (if (eq? ht-unspecified (cdr handle))
+	(ht-size! ht (1+ (ht-size ht))))
+    (set-cdr! handle new-value))
+  *unspecified*)
+
+(define (hash-table-delete! ht key)
+  "Remove KEY's association in HT."
+  (with-hashx-values (h a real-ht) ht
+    (if (hashx-get-handle h a real-ht key)
+	(begin
+	  (ht-size! ht (1- (ht-size ht)))
+	  (hashx-remove! h a real-ht key))))
+  *unspecified*)
+
+(define (hash-table-exists? ht key)
+  "Return whether KEY is a key in HT."
+  (and (hashx-invoke hashx-get-handle ht key) #t))
+
+;;; `hashx-set!' duplicates the hash lookup, but we use it anyway to
+;;; avoid creating a handle in case DEFAULT-THUNK exits
+;;; `hash-table-update!' non-locally.
+(define (hash-table-update! ht key modifier . default-thunk-lst)
+  "Modify HT's value at KEY by passing its value to MODIFIER and
+setting it to the result thereof.  Invoke DEFAULT-THUNK for the old
+value if KEY isn't in HT, or signal an error if DEFAULT-THUNK is not
+provided."
+  (with-hashx-values (hash-proc associator real-table) ht
+    (let ((handle (hashx-get-handle hash-proc associator real-table key)))
+      (cond (handle
+	     (set-cdr! handle (modifier (cdr handle))))
+	    (else
+	     (hashx-set! hash-proc associator real-table key
+			 (if (pair? default-thunk-lst)
+			     (modifier ((car default-thunk-lst)))
+			     (error "Key not in table" key ht)))
+	     (ht-size! ht (1+ (ht-size ht)))))))
+  *unspecified*)
+
+(define (hash-table-update!/default ht key modifier default)
+  "Modify HT's value at KEY by passing its old value, or DEFAULT if it
+doesn't have one, to MODIFIER, and setting it to the result thereof."
+  (hash-table-update! ht key modifier (lambda () default)))
+
+;;;; Accessing whole tables
+
+(define (hash-table-size ht)
+  "Return the number of associations in HT.  This is guaranteed O(1)
+for tables where #:weak was #f or not specified at creation time."
+  (if (ht-weakness ht)
+      (hash-table-fold ht (lambda (k v ans) (1+ ans)) 0)
+      (ht-size ht)))
+
+(define (hash-table-keys ht)
+  "Return a list of the keys in HT."
+  (hash-table-fold ht (lambda (k v lst) (cons k lst)) '()))
+
+(define (hash-table-values ht)
+  "Return a list of the values in HT."
+  (hash-table-fold ht (lambda (k v lst) (cons v lst)) '()))
+
+(define (hash-table-walk ht proc)
+  "Call PROC with each key and value as two arguments."
+  (hash-table-fold ht (lambda (k v unspec)
+                        (call-with-values (lambda () (proc k v))
+                          (lambda vals unspec)))
+		   *unspecified*))
+
+(define (hash-table-fold ht f knil)
+  "Invoke (F KEY VAL PREV) for each KEY and VAL in HT, where PREV is
+the result of the previous invocation, using KNIL as the first PREV.
+Answer the final F result."
+  (hash-fold f knil (ht-real-table ht)))
+
+(define (hash-table->alist ht)
+  "Return an alist for HT."
+  (hash-table-fold ht alist-cons '()))
+
+(define (hash-table-copy ht)
+  "Answer a copy of HT."
+  (with-hashx-values (h a real-ht) ht
+    (let* ((size (hash-table-size ht)) (weak (ht-weakness ht))
+	   (new-real-ht ((guile-ht-ctor weak) size)))
+      (hash-fold (lambda (k v ign) (hashx-set! h a new-real-ht k v))
+		 #f real-ht)
+      (make-srfi-69-hash-table		;real,assoc,size,weak,equiv,h
+       new-real-ht a size weak
+       (hash-table-equivalence-function ht) h))))
+
+(define (hash-table-merge! ht other-ht)
+  "Add all key/value pairs from OTHER-HT to HT, overriding HT's
+mappings where present.  Return HT."
+  (hash-table-fold
+   ht (lambda (k v ign) (hash-table-set! ht k v)) #f)
+  ht)
+
+;;; srfi-69.scm ends here

data/share/guile/2.2/srfi/srfi-71.scm

@@ -0,0 +1,267 @@
+;; 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)))
+
+(cond-expand-provide (current-module) '(srfi-71))
+
+(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 ---