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.

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index d23c6c4..3f47d9b 100644 (file)
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -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))

diff --git a/module/system/vm/trap-state.scm b/module/system/vm/trap-state.scm
index f45f981..1f21615 100644 (file)
--- a/module/system/vm/trap-state.scm
+++ b/module/system/vm/trap-state.scm
@@ -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

diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index dfaedc5..8564929 100644 (file)
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -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?)