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:
parent
5f8760e467
commit
e8e4e7310c
3 changed files with 33 additions and 30 deletions
|
@ -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))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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?)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue