diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-05-04 12:13:53 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-05-04 12:13:53 +0200 |
commit | 7f2f6a2cb2c4205ec22c2ca80a9c3675b6d7a4ea (patch) | |
tree | 2ba0de9063c0259543356702c6af06312b90e2a6 | |
parent | ffacb7954b8d4e52a2714bbc2437032a000041a5 (diff) | |
download | gnu-guix-7f2f6a2cb2c4205ec22c2ca80a9c3675b6d7a4ea.tar gnu-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.scm | 22 |
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) |