guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-172-g0


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-11-172-g0803914
Date: Sat, 10 Jul 2010 11:54:02 +0000

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=080391439568fa3b27283c266ed4b47fa635620f

The branch, master has been updated
       via  080391439568fa3b27283c266ed4b47fa635620f (commit)
       via  5273854080c0536563ca1538716a1e18dfde187b (commit)
       via  dc3b2661183786587350b19b97aefeec556cc54e (commit)
       via  c27d140ab4a5e5f6aad5a6e3912d06fb074358aa (commit)
       via  8c8a13ecf5ee7c2d8342259cb9d187b8b16f1327 (commit)
       via  2b12193df297be2051e816def21f75bfd358c8db (commit)
       via  a38dd31ffc2855cd3c2cbe4659a6cc6398d07cc5 (commit)
       via  a85f90f5ac5c3c5f830e295c0ca7b006141b1a83 (commit)
      from  d26a26f6c0fbdb971995d1b3dcf3345831eb12d7 (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 080391439568fa3b27283c266ed4b47fa635620f
Author: Andy Wingo <address@hidden>
Date:   Sat Jul 10 12:32:24 2010 +0200

    print column numbers in backtraces
    
    * module/system/repl/debug.scm (print-frame): Print column numbers too.

commit 5273854080c0536563ca1538716a1e18dfde187b
Author: Andy Wingo <address@hidden>
Date:   Sat Jul 10 12:21:50 2010 +0200

    finally, backtraces only showing frames for the computation
    
    * module/system/repl/repl.scm (run-repl): Run the thunk in a stack in a
      prompt, similar to the default prompt. Gives proper backtraces.
    
    * module/system/repl/error-handling.scm (call-with-error-handling):
      Narrow one more outer frame, for the %start-stack thunk invocation.
    
    * module/ice-9/boot-9.scm (%start-stack): Reindent.

commit dc3b2661183786587350b19b97aefeec556cc54e
Author: Andy Wingo <address@hidden>
Date:   Sat Jul 10 11:38:47 2010 +0200

    update manual for value history on by default
    
    * doc/ref/compiler.texi: Update for new ,pp meta-command.
    * doc/ref/scheme-using.texi (Using Guile Interactively): Show value
      history in examples.
      (Value Historyx): Update docs to mention the repl option and the
      programmatic interface.

commit c27d140ab4a5e5f6aad5a6e3912d06fb074358aa
Author: Andy Wingo <address@hidden>
Date:   Sat Jul 10 11:19:19 2010 +0200

    validating repl options; value-history on by default
    
    * module/system/repl/common.scm: Use (ice-9 history). Turns on value
      history by default.
      (repl-default-options): Expand the format of options to include an
      optional value transformer, run when setting a value. Add prompt and
      value-history options.
      (repl-prepare-eval-thunk): Use repl-option-ref.
      (repl-option-ref): Error if the option is unknown.
      (repl-option-set!, repl-default-option-set!): Error if the option is
      unknown. Pass the val through the transformer procedure.
      (repl-default-prompt-set!): Just use repl-default-option-set!.
    
    * module/system/repl/command.scm (option): Update for the new options
      format.

commit 8c8a13ecf5ee7c2d8342259cb9d187b8b16f1327
Author: Andy Wingo <address@hidden>
Date:   Sat Jul 10 11:16:16 2010 +0200

    value-history-enabled? accessor
    
    * module/ice-9/history.scm (value-history-enabled?): Add accessor.
      (enable-value-history!, disable-value-history!): Adapt.

commit 2b12193df297be2051e816def21f75bfd358c8db
Author: Andy Wingo <address@hidden>
Date:   Sat Jul 10 10:49:01 2010 +0200

    heap/literal fixes for repl-default-options
    
    * module/system/repl/common.scm (repl-default-options): Heap-allocate
      the repl-default-options, to avoid mutating a literal.
      (make-repl): Copy repl-default-options.

commit a38dd31ffc2855cd3c2cbe4659a6cc6398d07cc5
Author: Andy Wingo <address@hidden>
Date:   Sat Jul 10 10:44:29 2010 +0200

    add utils to turn value history on and off, and to clear it
    
    * module/ice-9/history.scm (enable-value-history!)
      (disable-value-history!, clear-value-history!): New exports.

commit a85f90f5ac5c3c5f830e295c0ca7b006141b1a83
Author: Andy Wingo <address@hidden>
Date:   Sat Jul 10 10:21:22 2010 +0200

    capture default dynamic state in (guile-user)
    
    * libguile/init.c (scm_i_init_guile): Move the call to
      scm_init_threads_default_dynamic_state after the call to
      scm_load_startup_files, so that the default dynamic state is in the
      (guile-user) module, not (guile).

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

Summary of changes:
 doc/ref/compiler.texi                 |    2 +-
 doc/ref/scheme-using.texi             |   52 +++++++++++++++++++++++++++------
 libguile/init.c                       |    6 ++-
 module/ice-9/boot-9.scm               |    2 +-
 module/ice-9/history.scm              |   32 +++++++++++++++++--
 module/system/repl/command.scm        |    4 +-
 module/system/repl/common.scm         |   49 +++++++++++++++++++++---------
 module/system/repl/debug.scm          |    8 +++--
 module/system/repl/error-handling.scm |   22 ++++++++------
 module/system/repl/repl.scm           |    8 ++++-
 10 files changed, 138 insertions(+), 47 deletions(-)

diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi
index c54123a..1883099 100644
--- a/doc/ref/compiler.texi
+++ b/doc/ref/compiler.texi
@@ -709,7 +709,7 @@ to play around with it at the REPL, as can be seen in this 
annotated
 example:
 
 @example
-scheme@@(guile-user)> (pp (compile '(+ 32 10) #:to 'assembly))
+scheme@@(guile-user)> ,pp (compile '(+ 32 10) #:to 'assembly)
 (load-program
   ((:LCASE16 . 2))  ; Labels, unused in this case.
   8                 ; Length of the thunk that was compiled.
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index c5667ae..98fee16 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -15,12 +15,12 @@ simple examples.
 
 @lisp
 scheme@@(guile-user)> (+ 3 4 5)
-12
+$1 = 12
 scheme@@(guile-user)> (display "Hello world!\n")
 Hello world!
 scheme@@(guile-user)> (values 'a 'b)
-a
-b
+$2 = a
+$3 = b
 @end lisp
 
 @noindent
@@ -83,12 +83,46 @@ scheme@@(guile-user)> (cons $2 $1)
 $4 = (362880 0 1 2 3 4 5 6 7 8 9)
 @end lisp
 
-To enable value history, type @code{(use-modules (ice-9 history))} at
-the Guile prompt, or add this to your @file{.guile} file.  (It is not
-enabled by default, to avoid the possibility of conflicting with some
-other use you may have for the variables @code{$1}, @code{$2},
address@hidden, and also because it prevents the stored evaluation results
-from being garbage collected, which some people may not want.)
+Value history is enabled by default, because Guile's REPL imports the
address@hidden(ice-9 history)} module. Value history may be turned off or on 
within the
+repl, using the options interface:
+
address@hidden
+scheme@@(guile-user)> ,option value-history #f
+scheme@@(guile-user)> 'foo
+foo
+scheme@@(guile-user)> ,option value-history #t
+scheme@@(guile-user)> 'bar
+$5 = bar
address@hidden lisp
+
+Note that previously recorded values are still accessible, even if value 
history
+is off. In rare cases, these references to past computations can cause Guile to
+use too much memory. One may clear these values, possibly enabling garbage
+collection, via the @code{clear-value-history!} procedure, described below.
+
+The programmatic interface to value history is in a module:
+
address@hidden
+(use-modules (ice-9 history))
address@hidden lisp
+
address@hidden {Scheme Procedure} value-history-enabled?
+Return true iff value history is enabled.
address@hidden deffn
+
address@hidden {Scheme Procedure} enable-value-history!
+Turn on value history, if it was off.
address@hidden deffn
+
address@hidden {Scheme Procedure} disable-value-history!
+Turn off value history, if it was on.
address@hidden deffn
+
address@hidden {Scheme Procedure} clear-value-history!
+Clear the value history. If the stored values are not captured by some other
+data structure or closure, they may then be reclaimed by the garbage collector.
address@hidden deffn
 
 
 @node Error Handling
diff --git a/libguile/init.c b/libguile/init.c
index 6313b65..4843910 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -570,8 +570,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_i_init_deprecated ();
 #endif
 
-  scm_init_threads_default_dynamic_state ();
-
   scm_initialized_p = 1;
 
 #ifdef STACK_CHECKING
@@ -585,6 +583,10 @@ scm_i_init_guile (SCM_STACKITEM *base)
   atexit (cleanup_for_exit);
   scm_load_startup_files ();
   scm_init_load_should_autocompile ();
+
+  /* Capture the dynamic state after loading boot-9, so that new threads end up
+     in the guile-user module. */
+  scm_init_threads_default_dynamic_state ();
 }
 
 /*
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f8b3eb0..e7ef923 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1056,7 +1056,7 @@ If there is no handler at all, Guile prints an error and 
then exits."
                                      (or (fluid-ref %stacks) '()))))
          (thunk)))
      (lambda (k . args)
-              (%start-stack tag (lambda () (apply k args)))))))
+       (%start-stack tag (lambda () (apply k args)))))))
 (define-syntax start-stack
   (syntax-rules ()
     ((_ tag exp)
diff --git a/module/ice-9/history.scm b/module/ice-9/history.scm
index e9097c2..7761dae 100644
--- a/module/ice-9/history.scm
+++ b/module/ice-9/history.scm
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2000, 2001, 2004, 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
@@ -17,10 +17,16 @@
 
 ;;;; A simple value history support
 
-(define-module (ice-9 history))
+(define-module (ice-9 history)
+  #:export (value-history-enabled? enable-value-history! disable-value-history!
+            clear-value-history!))
 
 (process-define-module '((value-history)))
 
+(define *value-history-enabled?* #f)
+(define (value-history-enabled?)
+  *value-history-enabled?*)
+
 (define (use-value-history x)
   (module-use! (current-module)
               (resolve-interface '(value-history))))
@@ -37,5 +43,23 @@
            (module-export! history (list s))
            (set! count c))))))
 
-(add-hook! before-eval-hook use-value-history)
-(add-hook! before-print-hook save-value-history)
+(define (enable-value-history!)
+  (if (not (value-history-enabled?))
+      (begin
+        (add-hook! before-eval-hook use-value-history)
+        (add-hook! before-print-hook save-value-history)
+        (set! *value-history-enabled?* #t))))
+
+(define (disable-value-history!)
+  (if (value-history-enabled?)
+      (begin
+        (remove-hook! before-eval-hook use-value-history)
+        (remove-hook! before-print-hook save-value-history)
+        (set! *value-history-enabled?* #f))))
+
+(define (clear-value-history!)
+  (let ((history (resolve-module '(value-history))))
+    (hash-clear! (module-obarray history))
+    (hash-clear! (module-obarray (module-public-interface history)))))
+
+(enable-value-history!)
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 54a9ef5..1beaf31 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -305,8 +305,8 @@ Show description/documentation."
 List/show/set options."
   (pmatch args
     (()
-     (for-each (lambda (key+val)
-                (format #t "~A\t~A\n" (car key+val) (cdr key+val)))
+     (for-each (lambda (spec)
+                (format #t "  ~A~24t~A\n" (car spec) (cadr spec)))
               (repl-options repl)))
     ((,key)
      (display (repl-option-ref repl key))
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 9d71e99..4fc8697 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -24,6 +24,7 @@
   #:use-module (system base language)
   #:use-module (system vm program)
   #:use-module (ice-9 control)
+  #:use-module (ice-9 history)
   #:export (<repl> make-repl repl-language repl-options
             repl-tm-stats repl-gc-stats repl-inport repl-outport repl-debug
             repl-welcome repl-prompt
@@ -104,14 +105,27 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
   language options tm-stats gc-stats inport outport debug)
 
 (define repl-default-options
-  '((compile-options . (#:warnings (unbound-variable arity-mismatch)))
-    (trace . #f)
-    (interp . #f)))
+  (copy-tree
+   `((compile-options (#:warnings (unbound-variable arity-mismatch)) #f)
+     (trace #f #f)
+     (interp #f #f)
+     (prompt #f ,(lambda (prompt)
+                   (cond
+                    ((not prompt) #f)
+                    ((string? prompt) (lambda (repl) prompt))
+                    ((thunk? prompt) (lambda (repl) (prompt)))
+                    ((procedure? prompt) prompt)
+                    (else (error "Invalid prompt" prompt)))))
+     (value-history
+      ,(value-history-enabled?)
+      ,(lambda (x)
+         (if x (enable-value-history!) (disable-value-history!))
+         (->bool x))))))
 
 (define %make-repl make-repl)
 (define* (make-repl lang #:optional debug)
   (%make-repl #:language (lookup-language lang)
-              #:options repl-default-options
+              #:options (copy-tree repl-default-options)
               #:tm-stats (times)
               #:gc-stats (gc-stats)
               #:inport (current-input-port)
@@ -157,7 +171,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
   (let* ((eval (language-evaluator (repl-language repl))))
     (if (and eval
              (or (null? (language-compilers (repl-language repl)))
-                 (assq-ref (repl-options repl) 'interp)))
+                 (repl-option-ref repl 'interp)))
         (lambda () (eval form (current-module)))
         (make-program (repl-compile repl form)))))
 
@@ -177,22 +191,27 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more 
details.")
        (newline (repl-outport repl)))))
 
 (define (repl-option-ref repl key)
-  (assq-ref (repl-options repl) key))
+  (cadr (or (assq key (repl-options repl))
+            (error "unknown repl option" key))))
 
 (define (repl-option-set! repl key val)
-  (set! (repl-options repl) (assq-set! (repl-options repl) key val)))
+  (let ((spec (or (assq key (repl-options repl))
+                  (error "unknown repl option" key))))
+    (set-car! (cdr spec)
+              (if (procedure? (caddr spec))
+                  ((caddr spec) val)
+                  val))))
 
 (define (repl-default-option-set! key val)
-  (set! repl-default-options (assq-set! repl-default-options key val)))
+  (let ((spec (or (assq key repl-default-options)
+                  (error "unknown repl option" key))))
+    (set-car! (cdr spec)
+              (if (procedure? (caddr spec))
+                  ((caddr spec) val)
+                  val))))
 
 (define (repl-default-prompt-set! prompt)
-  (repl-default-option-set!
-   'prompt
-   (cond
-    ((string? prompt) (lambda (repl) prompt))
-    ((thunk? prompt) (lambda (repl) (prompt)))
-    ((procedure? prompt) prompt)
-    (else (error "Invalid prompt" prompt)))))
+  (repl-default-option-set! 'prompt prompt))
 
 
 ;;;
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 361498a..1164c6b 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -84,11 +84,13 @@
         "unknown file"))
   (let* ((source (frame-source frame))
          (file (source:pretty-file source))
-         (line (and=> source source:line)))
+         (line (and=> source source:line))
+         (col (and=> source source:column)))
     (if (and file (not (equal? file (source:pretty-file last-source))))
         (format port "~&In ~a:~&" file))
-    (format port "~:[~*~6_~;~5d:~]~:[~*~3_~;~3d~] ~v:@y~%"
-            line line index index width (frame-call-representation frame))
+    (format port "address@hidden:[~*~3_~;~3d~] ~v:@y~%"
+            (if line (format #f "~a:~a" line col) "")
+            index index width (frame-call-representation frame))
     (if full?
         (print-locals frame #:width width
                       #:per-line-prefix "     "))))
diff --git a/module/system/repl/error-handling.scm 
b/module/system/repl/error-handling.scm
index d7d43bd..28b5428 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -88,15 +88,19 @@
                 (format #t " or `,q' to return to the old prompt.\n")
                 (let ((debug
                        (make-debug
-                        (narrow-stack->vector
-                         stack
-                         ;; Cut three frames from the top of the stack:
-                         ;; make-stack, this one, and the throw handler.
-                         3 
-                         ;; Narrow the end of the stack to the most recent
-                         ;; start-stack.
-                         (and (pair? (fluid-ref %stacks))
-                              (cdar (fluid-ref %stacks))))
+                        (let ((tag (and (pair? (fluid-ref %stacks))
+                                        (cdar (fluid-ref %stacks)))))
+                          (narrow-stack->vector
+                           stack
+                           ;; Cut three frames from the top of the stack:
+                           ;; make-stack, this one, and the throw handler.
+                           3 
+                           ;; Narrow the end of the stack to the most recent
+                           ;; start-stack.
+                           tag
+                           ;; And one more frame, because %start-stack invoking
+                           ;; the start-stack thunk has its own frame too.
+                           0 (and tag 1)))
                         0)))
                   ((@ (system repl repl) start-repl) #:debug debug)))))))
         ((pass)
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index fba6776..21998ba 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -106,6 +106,12 @@
          (abort))))))
 
 (define (run-repl repl)
+  (define (with-stack-and-prompt thunk)
+    (call-with-prompt (default-prompt-tag)
+                      (lambda () (start-stack #t (thunk)))
+                      (lambda (k proc)
+                        (with-stack-and-prompt (lambda () (proc k))))))
+  
   (% (with-fluids ((*repl-stack*
                     (cons repl (or (fluid-ref *repl-stack*) '()))))
        (if (null? (cdr (fluid-ref *repl-stack*)))
@@ -140,7 +146,7 @@
                                          (repl-parse repl exp))))))
                                (run-hook before-eval-hook exp)
                                (with-error-handling
-                                 (start-stack #t (% (thunk)))))
+                                 (with-stack-and-prompt thunk)))
                              (lambda (k) (values))))
                       (lambda l
                         (for-each (lambda (v)


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]