me/guix
Archived
1
0
Fork 0
Code Activity

ui: Factorize 'last-frame-with-source'.

Browse source 
* guix/ui.scm (last-frame-with-source): New procedure.
(load*)[frame-with-source]: Remove.
Use 'last-frame-with-source'.
This commit is contained in:
Ludovic Courtès 2018-05-04 12:13:53 +02:00
parent ffacb7954b
commit 7f2f6a2cb2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
guix/ui.scm
View file

@ -173,9 +173,9 @@ messages."
modules) modules)
module)) module))
(define* (load* file user-module (define (last-frame-with-source stack)
#:key (on-error 'nothing-special)) "Walk stack upwards and return the last frame that has source location
"Load the user provided Scheme source code FILE." information, or #f if it could not be found."
(define (frame-with-source frame) (define (frame-with-source frame)
;; Walk from FRAME upwards until source location information is found. ;; Walk from FRAME upwards until source location information is found.
(let loop ((frame frame) (let loop ((frame frame)
@ -186,6 +186,15 @@ messages."
frame frame
(loop (frame-previous frame) 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) (define (error-string frame args)
(call-with-output-string (call-with-output-string
(lambda (port) (lambda (port)
@ -238,12 +247,7 @@ messages."
;; Capture the stack up to this procedure call, excluded, and pass ;; Capture the stack up to this procedure call, excluded, and pass
;; the faulty stack frame to 'report-load-error'. ;; the faulty stack frame to 'report-load-error'.
(let* ((stack (make-stack #t handle-error tag)) (let* ((stack (make-stack #t handle-error tag))
(depth (stack-length stack)) (frame (last-frame-with-source 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))))
(report-load-error file args frame) (report-load-error file args frame)