diff options
author | Ludovic Courtès <ludo@gnu.org> | 2020-07-24 22:58:08 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2020-07-25 19:11:36 +0200 |
commit | a5e2fc73760a2ae023f2e56bdbf8025971f90e64 (patch) | |
tree | 2933826e391a889723e1db12699c74a845b7c4c5 /guix/diagnostics.scm | |
parent | 07dbdbd766760ce0121c1ac96fee766135fe7320 (diff) | |
download | guix-a5e2fc73760a2ae023f2e56bdbf8025971f90e64.tar guix-a5e2fc73760a2ae023f2e56bdbf8025971f90e64.tar.gz |
utils: Move <location> and '&error-location' to (guix diagnostics).
* guix/utils.scm (<location>, source-properties->location)
(location->source-properties, &error-location): Move to...
* guix/diagnostics.scm: ... here.
* gnu.scm: Adjust imports accordingly.
* gnu/machine.scm: Likewise.
* gnu/system.scm: Likewise.
* gnu/tests.scm: Likewise.
* guix/inferior.scm: Likewise.
* tests/channels.scm: Likewise.
* tests/packages.scm: Likewise.
Diffstat (limited to 'guix/diagnostics.scm')
-rw-r--r-- | guix/diagnostics.scm | 60 |
1 files changed, 58 insertions, 2 deletions
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm index 6c0753aef4..8b24b1b994 100644 --- a/guix/diagnostics.scm +++ b/guix/diagnostics.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,8 +19,9 @@ (define-module (guix diagnostics) #:use-module (guix colors) #:use-module (guix i18n) - #:autoload (guix utils) (<location>) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-35) #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (warning @@ -28,8 +29,20 @@ report-error leave + <location> + location + location? + location-file + location-line + location-column + source-properties->location + location->source-properties location->string + &error-location + error-location? + error-location + guix-warning-port program-name)) @@ -162,6 +175,45 @@ messages." (program-name) (program-name) (prefix-color prefix))))) + +;; A source location. +(define-record-type <location> + (make-location file line column) + location? + (file location-file) ; file name + (line location-line) ; 1-indexed line + (column location-column)) ; 0-indexed column + +(define (location file line column) + "Return the <location> object for the given FILE, LINE, and COLUMN." + (and line column file + (make-location file line column))) + +(define (source-properties->location loc) + "Return a location object based on the info in LOC, an alist as returned +by Guile's `source-properties', `frame-source', `current-source-location', +etc." + ;; In accordance with the GCS, start line and column numbers at 1. Note + ;; that unlike LINE and `port-column', COL is actually 1-indexed here... + (match loc + ((('line . line) ('column . col) ('filename . file)) ;common case + (and file line col + (make-location file (+ line 1) col))) + (#f + #f) + (_ + (let ((file (assq-ref loc 'filename)) + (line (assq-ref loc 'line)) + (col (assq-ref loc 'column))) + (location file (and line (+ line 1)) col))))) + +(define (location->source-properties loc) + "Return the source property association list based on the info in LOC, +a location object." + `((line . ,(and=> (location-line loc) 1-)) + (column . ,(location-column loc)) + (filename . ,(location-file loc)))) + (define (location->string loc) "Return a human-friendly, GNU-standard representation of LOC." (match loc @@ -169,6 +221,10 @@ messages." (($ <location> file line column) (format #f "~a:~a:~a" file line column)))) +(define-condition-type &error-location &error + error-location? + (location error-location)) ;<location> + (define guix-warning-port (make-parameter (current-warning-port))) |