[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-148-g962b910

[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=962b910318f792f7593782c166c3d129bc5a7be9

The branch, master has been updated
       via  962b910318f792f7593782c166c3d129bc5a7be9 (commit)
       via  d83eb93f45448338b0b77642f72a0f870ccd7451 (commit)
       via  652f48c062cbc82fc4c7d3028cd1ae8c1bf31f9f (commit)
       via  9d2136ba40a49c08695d871f32bd762b91830d73 (commit)
       via  5b27d9d25eee26b132d4ac5238f23e680188c2d0 (commit)
       via  fda1dd386060f474fc7f9773e02e0427c74c163c (commit)
      from  554137a7e9fcf71882de3ef70d153fc60d0668e5 (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 962b910318f792f7593782c166c3d129bc5a7be9
Author: Tristan Colgate <address@hidden>
Date:   Tue Jun 29 09:14:33 2010 +0100

    Update #:procedure method for <applicable-struct>
    
    * modules/oop/goop.scm (initialize-object-procedure): Use slot-set!
      instead of set-object-procedure!.

commit d83eb93f45448338b0b77642f72a0f870ccd7451
Author: Andy Wingo <address@hidden>
Date:   Mon Jun 28 15:03:34 2010 +0200

    * module/srfi/srfi-60.scm (bit-count): #:replace core definition.

commit 652f48c062cbc82fc4c7d3028cd1ae8c1bf31f9f
Author: Andy Wingo <address@hidden>
Date:   Sat Jun 26 22:28:21 2010 +0200

    use *repl-stack* instead of *repl-level*
    
    * module/ice-9/boot-9.scm (*repl-stack*): Instead of repl-level, have a
      stack.
      (batch-mode?): Change to poke the stack.
    
    * module/ice-9/deprecated.scm (set-batch-mode?!): Update deprecation
      method.
    
    * module/system/repl/common.scm (repl-prompt): Update to poke
      *repl-stack* to get the level.
    
    * module/system/repl/repl.scm (start-repl): Bind *repl-stack*
      appropriately.

commit 9d2136ba40a49c08695d871f32bd762b91830d73
Author: Andy Wingo <address@hidden>
Date:   Sat Jun 26 22:18:37 2010 +0200

    tweak to ensure-batch-mode!
    
    * module/ice-9/boot-9.scm (ensure-batch-mode!): Fix to be correct
      regarding dynamic extent (so far as this hack goes).

commit 5b27d9d25eee26b132d4ac5238f23e680188c2d0
Author: Andy Wingo <address@hidden>
Date:   Sat Jun 26 21:55:13 2010 +0200

    add repl inport and outport fields and accessors
    
    * module/system/repl/common.scm (<repl>): Add inport and outport fields
      and accessors.
      (make-repl): Add optional "debug" argument. Bind inport and outport to
      the current inport and output ports at the time of repl creation.
      (repl-read): Read from the repl inport.
      (repl-print): Write to the repl outport.
    
    * module/system/repl/command.scm (read-datum, read-line, meta-command):
      Respect repl-inport, and bind the outport of meta-commands to the repl
      outport.

commit fda1dd386060f474fc7f9773e02e0427c74c163c
Author: Andy Wingo <address@hidden>
Date:   Sat Jun 26 21:46:28 2010 +0200

    allow kwargs to repl metacommands
    
    * module/system/repl/command.scm (define-meta-command): Allow repl
      meta-commands to have optional or keyword arguments.

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

Summary of changes:
 module/ice-9/boot-9.scm        |    6 +++---
 module/ice-9/deprecated.scm    |    2 +-
 module/oop/goops.scm           |    4 ++--
 module/srfi/srfi-60.scm        |    4 ++--
 module/system/repl/command.scm |   17 ++++++++---------
 module/system/repl/common.scm  |   20 ++++++++++++--------
 module/system/repl/repl.scm    |   17 +++++++++++------
 7 files changed, 39 insertions(+), 31 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index bd5625d..f8b3eb0 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -2684,21 +2684,21 @@ module '(ice-9 q) '(make-q q-length))}."
 ;;; {Running Repls}
 ;;;
 
-(define *repl-level* (make-fluid))
+(define *repl-stack* (make-fluid))
 
 ;; Programs can call `batch-mode?' to see if they are running as part of a
 ;; script or if they are running interactively. REPL implementations ensure 
that
 ;; `batch-mode?' returns #f during their extent.
 ;;
 (define (batch-mode?)
-  (negative? (or (fluid-ref *repl-level*) -1)))
+  (null? (or (fluid-ref *repl-stack*) '())))
 
 ;; Programs can re-enter batch mode, for example after a fork, by calling
 ;; `ensure-batch-mode!'. It's not a great interface, though; it would be better
 ;; to abort to the outermost prompt, and call a thunk there.
 ;;
 (define (ensure-batch-mode!)
-  (fluid-set! *repl-level* #f))
+  (set! batch-mode? (lambda () #t)))
 
 (define (quit . args)
   (apply throw 'quit args))
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 1ce98f2..d809b73 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -616,7 +616,7 @@ the `(system repl common)' module.")
    (else
     (issue-deprecation-warning
      "`set-batch-mode?!' with an argument of `#f' is deprecated. Use the
-`*repl-level*' fluid instead.")
+`*repl-stack*' fluid instead.")
     #t)))
 
 (define (repl read evaler print)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index d0d65fa..9ebfab8 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1453,9 +1453,9 @@
   (let ((proc (get-keyword #:procedure initargs #f)))
     (cond ((not proc))
          ((pair? proc)
-          (apply set-object-procedure! object proc))
+          (apply slot-set! object 'procedure proc))
          (else
-           (set-object-procedure! object proc)))))
+           (slot-set! object 'procedure proc)))))
 
 (define-method (initialize (applicable-struct <applicable-struct>) initargs)
   (next-method)
diff --git a/module/srfi/srfi-60.scm b/module/srfi/srfi-60.scm
index c9eb60f..dbb0776 100644
--- a/module/srfi/srfi-60.scm
+++ b/module/srfi/srfi-60.scm
@@ -1,6 +1,6 @@
 ;;; srfi-60.scm --- Integers as Bits
 
-;; Copyright (C) 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2006, 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
@@ -22,7 +22,6 @@
            bitwise-xor
            bitwise-not
            any-bits-set?
-           bit-count
            bitwise-if bitwise-merge
            log2-binary-factors first-set-bit
            bit-set?
@@ -35,6 +34,7 @@
            integer->list
            list->integer
            booleans->integer)
+  #:replace (bit-count)
   #:re-export (logand
               logior
               logxor
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 9e79eb7..0c3d707 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -106,12 +106,12 @@
     (format #t " ,~24A address@hidden - ~A\n" usage abbrev summary)))
 
 (define (read-datum repl)
-  (read))
+  (read (repl-inport repl)))
 
 (define read-line
   (let ((orig-read-line read-line))
     (lambda (repl)
-      (orig-read-line))))
+      (orig-read-line (repl-inport repl)))))
 
 (define (meta-command repl)
   (let ((command (read-datum repl)))
@@ -129,14 +129,13 @@
        docstring
        (let* ((expression0
                (repl-reader ""
-                            (lambda args
-                              (let ((port (if (pair? args)
-                                              (car args)
-                                              (current-input-port))))
-                                ((language-reader (repl-language repl))
-                                 port (current-module))))))
+                            (lambda* (#:optional (port (repl-inport repl)))
+                              ((language-reader (repl-language repl))
+                               port (current-module)))))
               ...)
-         (apply (lambda datums b0 b1 ...)
+         (apply (lambda* datums
+                  (with-output-to-port (repl-outport repl)
+                    (lambda () b0 b1 ...)))
                 (let ((port (open-input-string (read-line repl))))
                   (let lp ((out '()))
                     (let ((x (read port)))
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index bc3fcaf..97a8a7f 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -25,7 +25,7 @@
   #:use-module (system vm program)
   #:use-module (ice-9 control)
   #:export (<repl> make-repl repl-language repl-options
-            repl-tm-stats repl-gc-stats
+            repl-tm-stats repl-gc-stats repl-inport repl-outport repl-debug
             repl-welcome repl-prompt repl-read repl-compile repl-eval
             repl-parse repl-print repl-option-ref repl-option-set!
             repl-default-option-set! repl-default-prompt-set!
@@ -99,7 +99,8 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
 ;;; Repl type
 ;;;
 
-(define-record/keywords <repl> language options tm-stats gc-stats)
+(define-record/keywords <repl>
+  language options tm-stats gc-stats inport outport debug)
 
 (define repl-default-options
   '((compile-options . (#:warnings (unbound-variable arity-mismatch)))
@@ -107,11 +108,14 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
     (interp . #f)))
 
 (define %make-repl make-repl)
-(define (make-repl lang)
+(define* (make-repl lang #:optional debug)
   (%make-repl #:language (lookup-language lang)
               #:options repl-default-options
               #:tm-stats (times)
-              #:gc-stats (gc-stats)))
+              #:gc-stats (gc-stats)
+              #:inport (current-input-port)
+              #:outport (current-output-port)
+              #:debug debug))
 
 (define (repl-welcome repl)
   (display *version*)
@@ -126,11 +130,11 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
    (else
     (format #f "address@hidden> " (language-name (repl-language repl))
             (module-name (current-module))
-            (let ((level (or (fluid-ref *repl-level*) 0)))
+            (let ((level (length (or (fluid-ref *repl-stack*) '()))))
               (if (zero? level) "" (format #f " [~a]" level)))))))
 
 (define (repl-read repl)
-  ((language-reader (repl-language repl)) (current-input-port)
+  ((language-reader (repl-language repl)) (repl-inport repl)
                                           (current-module)))
 
 (define (repl-compile-options repl)
@@ -162,8 +166,8 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
         ;; should be printed with the generic printer, `write'. The
         ;; language-printer is something else: it prints expressions of
         ;; a given language, not the result of evaluation.
-       (write val)
-       (newline))))
+       (write val (repl-outport repl))
+       (newline (repl-outport repl)))))
 
 (define (repl-option-ref repl key)
   (assq-ref (repl-options repl) key))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 503191f..48c6eb0 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -60,18 +60,23 @@
                                (current-module))))
    #:on-error 'pass))
 
-(define* (start-repl #:optional (lang (current-language)) #:key
-                     (level (1+ (or (fluid-ref *repl-level*) -1)))
-                     (welcome (equal? level 0)))
+
+
+;;;
+;;; The repl
+;;;
+
+(define* (start-repl #:optional (lang (current-language)))
   (let ((repl (make-repl lang))
         (status #f))
-    (if welcome
-        (repl-welcome repl))
-    (with-fluids ((*repl-level* level)
+    (with-fluids ((*repl-stack* (cons repl
+                                      (or (fluid-ref *repl-stack*) '())))
                   (*debug-input-port*
                    (or (fluid-ref *debug-input-port*) (current-input-port)))
                   (*debug-output-port*
                    (or (fluid-ref *debug-output-port*) (current-output-port))))
+      (if (null? (cdr (fluid-ref *repl-stack*)))
+          (repl-welcome repl))
       (let prompt-loop ()
         (let ((exp (prompting-meta-read repl)))
           (cond


hooks/post-receive
-- 
GNU Guile