diff options
| -rw-r--r-- | gnu.scm | 5 | ||||
| -rw-r--r-- | gnu/machine.scm | 2 | ||||
| -rw-r--r-- | gnu/system.scm | 5 | ||||
| -rw-r--r-- | gnu/tests.scm | 2 | ||||
| -rw-r--r-- | guix/diagnostics.scm | 60 | ||||
| -rw-r--r-- | guix/inferior.scm | 3 | ||||
| -rw-r--r-- | guix/utils.scm | 71 | ||||
| -rw-r--r-- | tests/channels.scm | 2 | ||||
| -rw-r--r-- | tests/packages.scm | 3 |
9 files changed, 86 insertions, 67 deletions
@@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; @@ -20,7 +20,8 @@ (define-module (gnu) #:use-module (guix i18n) - #:use-module (guix utils) + #:use-module ((guix utils) #:select (&fix-hint)) + #:use-module (guix diagnostics) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) diff --git a/gnu/machine.scm b/gnu/machine.scm index 434d78ab41..667a988f99 100644 --- a/gnu/machine.scm +++ b/gnu/machine.scm @@ -23,7 +23,7 @@ #:use-module (guix monads) #:use-module (guix records) #:use-module (guix store) - #:use-module ((guix utils) #:select (source-properties->location)) + #:use-module ((guix diagnostics) #:select (source-properties->location)) #:use-module (srfi srfi-35) #:export (environment-type environment-type? diff --git a/gnu/system.scm b/gnu/system.scm index de5f25a35d..6ae15ab23b 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -35,8 +35,9 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix profiles) - #:use-module (guix ui) - #:use-module (guix utils) + #:use-module ((guix utils) #:select (substitute-keyword-arguments)) + #:use-module (guix i18n) + #:use-module (guix diagnostics) #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages cross-base) diff --git a/gnu/tests.scm b/gnu/tests.scm index 705bf561a6..83528a40f0 100644 --- a/gnu/tests.scm +++ b/gnu/tests.scm @@ -20,7 +20,7 @@ (define-module (gnu tests) #:use-module (guix gexp) - #:use-module (guix utils) + #:use-module (guix diagnostics) #:use-module (guix records) #:use-module ((guix ui) #:select (warn-about-load-error)) #:use-module (gnu bootloader) 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))) diff --git a/guix/inferior.scm b/guix/inferior.scm index d347754bbc..77820872b3 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -21,9 +21,10 @@ #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module ((guix diagnostics) + #:select (source-properties->location)) #:use-module ((guix utils) #:select (%current-system - source-properties->location call-with-temporary-directory version>? version-prefix? cache-directory)) diff --git a/guix/utils.scm b/guix/utils.scm index 17a96370f1..64894ecf1f 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -37,13 +37,27 @@ #:use-module (guix memoization) #:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) + #:use-module (guix diagnostics) ;<location>, &error-location, etc. #:use-module (ice-9 format) #:use-module (ice-9 regex) #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module ((ice-9 iconv) #:prefix iconv:) #:use-module (system foreign) - #:re-export (memoize) ; for backwards compatibility + #:re-export (memoize ;for backwards compatibility + + <location> + location + location? + location-file + location-line + location-column + source-properties->location + location->source-properties + + &error-location + error-location? + error-location) #:export (strip-keyword-arguments default-keyword-arguments substitute-keyword-arguments @@ -51,19 +65,6 @@ current-source-directory - <location> - location - location? - location-file - location-line - location-column - source-properties->location - location->source-properties - - &error-location - error-location? - error-location - &fix-hint fix-hint? condition-fix-hint @@ -834,48 +835,6 @@ be determined." ;; raising an error would upset Geiser users #f)))))) -;; 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-condition-type &error-location &error - error-location? - (location error-location)) ;<location> - (define-condition-type &fix-hint &condition fix-hint? (hint condition-fix-hint)) ;string diff --git a/tests/channels.scm b/tests/channels.scm index cde3b668fb..55a0537e0f 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -26,7 +26,7 @@ #:use-module (guix derivations) #:use-module (guix sets) #:use-module (guix gexp) - #:use-module ((guix utils) + #:use-module ((guix diagnostics) #:select (error-location? error-location location-line)) #:use-module ((guix build utils) #:select (which)) #:use-module (git) diff --git a/tests/packages.scm b/tests/packages.scm index 6aa36170d2..0a4bf83c40 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -23,7 +23,8 @@ #:use-module (guix monads) #:use-module (guix grafts) #:use-module ((guix gexp) #:select (local-file local-file-file)) - #:use-module ((guix utils) + #:use-module (guix utils) + #:use-module ((guix diagnostics) ;; Rename the 'location' binding to allow proper syntax ;; matching when setting the 'location' field of a package. #:renamer (lambda (name) |