ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 13:49:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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 @@ (define (make-user-module modules)
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 @@ (define (frame-with-source 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)
(call-with-output-string
(lambda (port)
@ -238,12 +247,7 @@ (define tag
;; 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)