[Guile-commits] GNU Guile branch, master, updated. release_1-9-6-49-gc1ff4aa

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c1ff4aa7866aa7189c770136d19578b1295a6229

The branch, master has been updated
       via  c1ff4aa7866aa7189c770136d19578b1295a6229 (commit)
       via  9a9d82c28caf37278375912d33441e4318d55349 (commit)
      from  b597129782e4e65cbb9b2317b116d83daea0820c (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit c1ff4aa7866aa7189c770136d19578b1295a6229
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 28 16:37:59 2009 +0100

    pretty-print is a lambda*
    
    * module/ice-9/pretty-print.scm (pretty-print): Fix to always be a
      define*. Shouldn't change behavior, but it will be more
      introspectible.

commit 9a9d82c28caf37278375912d33441e4318d55349
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 28 16:36:29 2009 +0100

    fix bug bindings lexical vars within optargs initializers
    
    * module/language/tree-il/analyze.scm (analyze-lexicals): Fix bug in
      which variables bound within inits were being improperly allocated.
    * module/language/tree-il/compile-glil.scm (vars->bind-list): More
      detail in terrible debugging clause.
    * test-suite/tests/optargs.test ("lambda* inits"): Add tests for binding
      vars within inits.

-----------------------------------------------------------------------

Summary of changes:
 module/ice-9/pretty-print.scm            |   27 ++++++++++-----------------
 module/language/tree-il/analyze.scm      |    2 +-
 module/language/tree-il/compile-glil.scm |    2 +-
 test-suite/tests/optargs.test            |   12 ++++++++++++
 4 files changed, 24 insertions(+), 19 deletions(-)

diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index 0ce6a80..dc39f44 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -1,6 +1,6 @@
 ;;;; -*-scheme-*-
 ;;;;
-;;;;   Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2001, 2004, 2006, 2009 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
@@ -17,8 +17,8 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 ;;;; 
 (define-module (ice-9 pretty-print)
-  :use-module (ice-9 optargs)
-  :export (pretty-print))
+  #:export (pretty-print))
+
 
 ;; From SLIB.
 
@@ -250,7 +250,12 @@
 
   (rev-string-append l 0))
 
-(define (pretty-print obj . opts)
+(define* (pretty-print obj #:optional port
+                       #:key 
+                       (port* (or port (current-output-port)) #:port)
+                       (width 79)
+                       (display? #f)
+                       (per-line-prefix ""))
   "Pretty-print OBJ on PORT, which is a keyword argument defaulting to
 the current output port.  Formatting can be controlled by a number of
 keyword arguments: Each line in the output is preceded by the string
@@ -260,19 +265,7 @@ true, display rather than write representation will be 
used.
 
 Instead of with a keyword argument, you can also specify the output
 port directly after OBJ, like (pretty-print OBJ PORT)."
-  (if (pair? opts)
-      (if (keyword? (car opts))
-         (apply pretty-print-with-keys obj opts)
-         (apply pretty-print-with-keys obj #:port (car opts) (cdr opts)))
-      (pretty-print-with-keys obj)))
-
-(define* (pretty-print-with-keys obj
-                                #:key 
-                                (port (current-output-port))
-                                (width 79)
-                                (display? #f)
-                                (per-line-prefix ""))
   (generic-write obj display?
                 (- width (string-length per-line-prefix))
                 per-line-prefix
-                (lambda (s) (display s port) #t)))
+                (lambda (s) (display s port*) #t)))
diff --git a/module/language/tree-il/analyze.scm 
b/module/language/tree-il/analyze.scm
index a8f8e4a..b81a7da 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -388,7 +388,7 @@
                             (allocate! body proc n)
                             ;; inits not logically at the end, but they
                             ;; are the list...
-                            (map (lambda (x) (allocate! x body n)) inits))))
+                            (map (lambda (x) (allocate! x proc n)) inits))))
                 ;; label and nlocs for the case
                 (hashq-set! allocation x (cons (gensym ":LCASE") nlocs))
                 nlocs)
diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index c0dae64..a79be41 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -173,7 +173,7 @@
          (pmatch (hashq-ref (hashq-ref allocation v) proc)
            ((#t ,boxed? . ,n)
             (list id boxed? n))
-           (,x (error "badness" x))))
+           (,x (error "badness" id v x))))
        ids
        vars))
 
diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test
index a065261..1f9313b 100644
--- a/test-suite/tests/optargs.test
+++ b/test-suite/tests/optargs.test
@@ -174,6 +174,18 @@
       (equal? (f 1 2 3 #:x 'x #:z 'z)
               '(x #f z (1 2 3 #:x x #:z z))))))
 
+(with-test-prefix/c&e "lambda* inits"
+  (pass-if "can bind lexicals within inits"
+    (begin
+      (define* (qux #:optional a
+                    #:key (b (or a 13) #:a))
+        b)
+      #t))
+  (pass-if "testing qux"
+    (and (equal? (qux) 13)
+         (equal? (qux 1) 1)
+         (equal? (qux #:a 2) 2))))
+
 (with-test-prefix/c&e "defmacro*"
   (pass-if "definition"
     (begin


hooks/post-receive
-- 
GNU Guile