[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-43-gd8e2ba2

[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=d8e2ba23fc30cd705f9e3dacb149cf5395299f5d

The branch, master has been updated
       via  d8e2ba23fc30cd705f9e3dacb149cf5395299f5d (commit)
       via  65bce2375965ab8b563200ff622dd55543ab83fd (commit)
      from  194865d2f7df43aec742c7cdd658050bb4caeb94 (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 d8e2ba23fc30cd705f9e3dacb149cf5395299f5d
Author: Andy Wingo <address@hidden>
Date:   Tue Sep 21 21:48:09 2010 +0200

    (system repl command) cleanups
    
    * module/system/repl/command.scm (profile, trace, inspect)
      (pretty-print): Use repl-prepare-eval-thunk instead of the lower-level
      compile and make-program.

commit 65bce2375965ab8b563200ff622dd55543ab83fd
Author: Andy Wingo <address@hidden>
Date:   Tue Sep 21 21:37:11 2010 +0200

    breakpoints from recursive prompts work
    
    * module/system/vm/traps.scm (new-disabled-trap): Don't manipulate the
      VM trace level in the enable and disable handlers. Unfortunately, this
      makes traps not work unless you enable hooks, but given that
      vm_dispatch_hook has to set trace-level to 0, there needs to be an
      object with a broader view of what traps are enabled. That object is
      the hook state.
    
    * module/system/vm/trap-state.scm (trap-state->trace-level): New
      procedure.
      (with-default-trap-handler): Add an optional trap-state argument. Now
      makes sure that the vm-trace-level is set appropriately during the
      execution of the thunk, allowing for breakpoints from recursive
      prompts.

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

Summary of changes:
 module/system/repl/command.scm  |    8 ++++----
 module/system/vm/trap-state.scm |   23 +++++++++++++++++++----
 module/system/vm/traps.scm      |    2 --
 3 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index ed1cba9..cb467ce 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -438,7 +438,7 @@ Time execution."
 Profile execution."
   ;; FIXME opts
   (apply statprof
-         (make-program (repl-compile repl (repl-parse repl form)))
+         (repl-prepare-eval-thunk repl (repl-parse repl form))
          opts))
 
 (define-meta-command (trace repl (form) . opts)
@@ -447,7 +447,7 @@ Trace execution."
   ;; FIXME: doc options, or somehow deal with them better
   (apply vm-trace
          (the-vm)
-         (make-program (repl-compile repl (repl-parse repl form)))
+         (repl-prepare-eval-thunk repl (repl-parse repl form))
          opts))
 
 
@@ -630,14 +630,14 @@ Enable a trap."
 (define-stack-command (inspect repl (form))
   "inspect EXP
 Inspect the result(s) of evaluating EXP."
-  (call-with-values (make-program (repl-compile repl (repl-parse repl form)))
+  (call-with-values (repl-prepare-eval-thunk repl (repl-parse repl form))
     (lambda args
       (for-each %inspect args))))
 
 (define-meta-command (pretty-print repl (form))
   "pretty-print EXP
 Pretty-print the result(s) of evaluating EXP."
-  (call-with-values (make-program (repl-compile repl (repl-parse repl form)))
+  (call-with-values (repl-prepare-eval-thunk repl (repl-parse repl form))
     (lambda args
       (for-each
        (lambda (x)
diff --git a/module/system/vm/trap-state.scm b/module/system/vm/trap-state.scm
index 4277dd3..3264500 100644
--- a/module/system/vm/trap-state.scm
+++ b/module/system/vm/trap-state.scm
@@ -22,6 +22,7 @@
 
 (define-module (system vm trap-state)
   #:use-module (system base syntax)
+  #:use-module ((srfi srfi-1) #:select (fold))
   #:use-module (system vm vm)
   #:use-module (system vm traps)
   #:export (list-traps
@@ -37,10 +38,6 @@
 
 (define %default-trap-handler (make-fluid))
 
-(define (with-default-trap-handler handler thunk)
-  (with-fluids ((%default-trap-handler handler))
-    (thunk)))
-
 (define (default-trap-handler frame idx trap-name)
   (let ((default-handler (fluid-ref %default-trap-handler)))
     (if default-handler
@@ -87,6 +84,14 @@
 (define (remove-trap-wrapper! trap-state wrapper)
   (delq wrapper (trap-state-wrappers trap-state)))
 
+(define (trap-state->trace-level trap-state)
+  (fold (lambda (wrapper level)
+          (if (trap-wrapper-enabled? wrapper)
+              (1+ level)
+              level))
+        0
+        (trap-state-wrappers trap-state)))
+
 (define (wrapper-at-index trap-state idx)
   (let lp ((wrappers (trap-state-wrappers trap-state)))
     (cond
@@ -135,6 +140,16 @@
 ;;; API
 ;;;
 
+(define* (with-default-trap-handler handler thunk
+                                    #:optional (trap-state (the-trap-state)))
+  (with-fluids ((%default-trap-handler handler))
+    (dynamic-wind
+      (lambda ()
+        (set-vm-trace-level! (the-vm) (trap-state->trace-level trap-state)))
+      thunk
+      (lambda ()
+        (set-vm-trace-level! (the-vm) 0)))))
+
 (define* (list-traps #:optional (trap-state (the-trap-state)))
   (map (lambda (wrapper)
          (cons (trap-wrapper-index wrapper)
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index 824e2a4..e568ad8 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -87,14 +87,12 @@
     (define* (enable-trap #:optional frame)
       (if enabled? (error "trap already enabled"))
       (enable frame)
-      (set-vm-trace-level! vm (1+ (vm-trace-level vm)))
       (set! enabled? #t)
       disable-trap)
     
     (define* (disable-trap #:optional frame)
       (if disabled? (error "trap already disabled"))
       (disable frame)
-      (set-vm-trace-level! vm (1- (vm-trace-level vm)))
       (set! disabled? #t)
       enable-trap)
 


hooks/post-receive
-- 
GNU Guile