mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

cleanups to ,finish

Browse source 
* module/system/repl/command.scm (repl-pop-continuation-resumer): Factor
  out of finish.
  (finish): Adapt.

* module/system/vm/trap-state.scm (add-ephemeral-trap-at-frame-finish!):
  Rename to add "ephemeral" to the name.

* module/system/vm/traps.scm (trap-calls-to-procedure): Remove unused
  #:width kwarg.
This commit is contained in:
Andy Wingo 2010-10-06 21:17:06 +02:00
parent 5f8760e467
commit e8e4e7310c
3 changed files with 33 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

54
module/system/repl/command.scm
View file

@ -594,37 +594,39 @@ Note that the given source location must be inside a procedure."
(let ((idx (add-trap-at-source-location! file line)))
(format #t "Trap ~a: ~a.~%" idx (trap-name idx)))))
(define (repl-pop-continuation-resumer msg)
;; Capture the dynamic environment with this prompt thing. The
;; result is a procedure that takes a frame.
(% (call-with-values
(lambda ()
(abort
(lambda (k)
;; Call frame->stack-vector before reinstating the
;; continuation, so that we catch the %stacks fluid at
;; the time of capture.
(lambda (frame)
(k frame
(frame->stack-vector
(frame-previous frame)))))))
(lambda (from stack)
(format #t "~a~%" msg)
(let ((vals (frame-return-values from)))
(if (null? vals)
(format #t "No return values.~%" msg)
(begin
(format #t "Return values:~%" msg)
(for-each (lambda (x) (repl-print repl x)) vals))))
((module-ref (resolve-interface '(system repl repl)) 'start-repl)
#:debug (make-debug stack 0 msg))))))
(define-stack-command (finish repl)
"finish
Run until the current frame finishes.
Resume execution, breaking when the current frame finishes."
(let ((msg (format #f "Return from ~a" cur)))
(define resume-repl
;; Capture the dynamic environment with this prompt thing. The
;; result is a procedure that takes a frame.
(% (call-with-values
(lambda ()
(abort
(lambda (k)
;; Call frame->stack-vector before reinstating the
;; continuation, so that we catch the %stacks fluid at
;; the time of capture.
(lambda (frame)
(k frame
(frame->stack-vector
(frame-previous frame)))))))
(lambda (from stack)
(format #t "~a~%" msg)
(let ((vals (frame-return-values from)))
(if (null? vals)
(format #t "No return values.~%" msg)
(begin
(format #t "Return values:~%" msg)
(for-each (lambda (x) (repl-print repl x)) vals))))
((module-ref (resolve-interface '(system repl repl)) 'start-repl)
#:debug (make-debug stack 0 msg))))))
(add-trap-at-frame-finish! cur resume-repl)
(let ((handler (repl-pop-continuation-resumer
(format #f "Return from ~a" cur))))
(add-ephemeral-trap-at-frame-finish! cur handler)
(throw 'quit)))
(define-meta-command (tracepoint repl (form))

7
module/system/vm/trap-state.scm
View file

@ -39,7 +39,7 @@
add-trap-at-procedure-call!
add-trace-at-procedure-call!
add-trap-at-source-location!
add-trap-at-frame-finish!))
add-ephemeral-trap-at-frame-finish!))
(define %default-trap-handler (make-fluid))
@ -239,8 +239,9 @@
(format #f "Breakpoint at ~a:~a" file user-line)))))
;; handler := frame -> nothing
(define* (add-trap-at-frame-finish! frame handler
#:optional (trap-state (the-trap-state)))
(define* (add-ephemeral-trap-at-frame-finish! frame handler
#:optional (trap-state
(the-trap-state)))
(let* ((idx (next-ephemeral-index! trap-state))
(trap (trap-frame-finish
frame

2
module/system/vm/traps.scm
View file

@ -604,7 +604,7 @@
;; Traps calls and returns for a given procedure, keeping track of the call depth.
;;
(define* (trap-calls-to-procedure proc apply-handler return-handler
#:key (width 80) (vm (the-vm)))
#:key (vm (the-vm)))
(arg-check proc procedure?)
(arg-check apply-handler procedure?)
(arg-check return-handler procedure?)