aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-05-04 12:13:53 +0200
committerLudovic Courtès <ludo@gnu.org>2018-05-04 12:13:53 +0200
commit7f2f6a2cb2c4205ec22c2ca80a9c3675b6d7a4ea (patch)
tree2ba0de9063c0259543356702c6af06312b90e2a6
parentffacb7954b8d4e52a2714bbc2437032a000041a5 (diff)
downloadguix-7f2f6a2cb2c4205ec22c2ca80a9c3675b6d7a4ea.tar
guix-7f2f6a2cb2c4205ec22c2ca80a9c3675b6d7a4ea.tar.gz
ui: Factorize 'last-frame-with-source'.
* guix/ui.scm (last-frame-with-source): New procedure. (load*)[frame-with-source]: Remove. Use 'last-frame-with-source'.
-rw-r--r--guix/ui.scm22
1 files changed, 13 insertions, 9 deletions
diff --git a/guix/ui.scm b/guix/ui.scm
index 536c36e3fe..223d2eb2a0 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -173,9 +173,9 @@ messages."
modules)
module))
-(define* (load* file user-module
- #:key (on-error 'nothing-special))
- "Load the user provided Scheme source code FILE."
+(define (last-frame-with-source stack)
+ "Walk stack upwards and return the last frame that has source location
+information, or #f if it could not be found."
(define (frame-with-source frame)
;; Walk from FRAME upwards until source location information is found.
(let loop ((frame frame)
@@ -186,6 +186,15 @@ messages."
frame
(loop (frame-previous frame) frame)))))
+ (let* ((depth (stack-length stack))
+ (last (and (> depth 0) (stack-ref stack 0))))
+ (frame-with-source (if (> depth 1)
+ (stack-ref stack 1) ;skip the 'throw' frame
+ last))))
+
+(define* (load* file user-module
+ #:key (on-error 'nothing-special))
+ "Load the user provided Scheme source code FILE."
(define (error-string frame args)
(call-with-output-string
(lambda (port)
@@ -238,12 +247,7 @@ messages."
;; Capture the stack up to this procedure call, excluded, and pass
;; the faulty stack frame to 'report-load-error'.
(let* ((stack (make-stack #t handle-error tag))
- (depth (stack-length stack))
- (last (and (> depth 0) (stack-ref stack 0)))
- (frame (frame-with-source
- (if (> depth 1)
- (stack-ref stack 1) ;skip the 'throw' frame
- last))))
+ (frame (last-frame-with-source stack)))
(report-load-error file args frame)