1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00

cleanups to ,finish

* 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

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))) (let ((idx (add-trap-at-source-location! file line)))
(format #t "Trap ~a: ~a.~%" idx (trap-name idx))))) (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) (define-stack-command (finish repl)
"finish "finish
Run until the current frame finishes. Run until the current frame finishes.
Resume execution, breaking when the current frame finishes." Resume execution, breaking when the current frame finishes."
(let ((msg (format #f "Return from ~a" cur))) (let ((handler (repl-pop-continuation-resumer
(define resume-repl (format #f "Return from ~a" cur))))
;; Capture the dynamic environment with this prompt thing. The (add-ephemeral-trap-at-frame-finish! cur handler)
;; 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)
(throw 'quit))) (throw 'quit)))
(define-meta-command (tracepoint repl (form)) (define-meta-command (tracepoint repl (form))

View file

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

View file

@ -604,7 +604,7 @@
;; Traps calls and returns for a given procedure, keeping track of the call depth. ;; Traps calls and returns for a given procedure, keeping track of the call depth.
;; ;;
(define* (trap-calls-to-procedure proc apply-handler return-handler (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 proc procedure?)
(arg-check apply-handler procedure?) (arg-check apply-handler procedure?)
(arg-check return-handler procedure?) (arg-check return-handler procedure?)