summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gnu.scm5
-rw-r--r--gnu/machine.scm2
-rw-r--r--gnu/system.scm5
-rw-r--r--gnu/tests.scm2
-rw-r--r--guix/diagnostics.scm60
-rw-r--r--guix/inferior.scm3
-rw-r--r--guix/utils.scm71
-rw-r--r--tests/channels.scm2
-rw-r--r--tests/packages.scm3
9 files changed, 86 insertions, 67 deletions
diff --git a/gnu.scm b/gnu.scm
index 2c29b6dc3f0..5f593bd5694 100644
--- a/gnu.scm
+++ b/gnu.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io> 3;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io>
4;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> 4;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
5;;; 5;;;
@@ -20,7 +20,8 @@
20 20
21(define-module (gnu) 21(define-module (gnu)
22 #:use-module (guix i18n) 22 #:use-module (guix i18n)
23 #:use-module (guix utils) 23 #:use-module ((guix utils) #:select (&fix-hint))
24 #:use-module (guix diagnostics)
24 #:use-module (srfi srfi-34) 25 #:use-module (srfi srfi-34)
25 #:use-module (srfi srfi-35) 26 #:use-module (srfi srfi-35)
26 #:use-module (ice-9 match) 27 #:use-module (ice-9 match)
diff --git a/gnu/machine.scm b/gnu/machine.scm
index 434d78ab413..667a988f990 100644
--- a/gnu/machine.scm
+++ b/gnu/machine.scm
@@ -23,7 +23,7 @@
23 #:use-module (guix monads) 23 #:use-module (guix monads)
24 #:use-module (guix records) 24 #:use-module (guix records)
25 #:use-module (guix store) 25 #:use-module (guix store)
26 #:use-module ((guix utils) #:select (source-properties->location)) 26 #:use-module ((guix diagnostics) #:select (source-properties->location))
27 #:use-module (srfi srfi-35) 27 #:use-module (srfi srfi-35)
28 #:export (environment-type 28 #:export (environment-type
29 environment-type? 29 environment-type?
diff --git a/gnu/system.scm b/gnu/system.scm
index de5f25a35d0..6ae15ab23bd 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -35,8 +35,9 @@
35 #:use-module (guix packages) 35 #:use-module (guix packages)
36 #:use-module (guix derivations) 36 #:use-module (guix derivations)
37 #:use-module (guix profiles) 37 #:use-module (guix profiles)
38 #:use-module (guix ui) 38 #:use-module ((guix utils) #:select (substitute-keyword-arguments))
39 #:use-module (guix utils) 39 #:use-module (guix i18n)
40 #:use-module (guix diagnostics)
40 #:use-module (gnu packages base) 41 #:use-module (gnu packages base)
41 #:use-module (gnu packages bash) 42 #:use-module (gnu packages bash)
42 #:use-module (gnu packages cross-base) 43 #:use-module (gnu packages cross-base)
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 705bf561a65..83528a40f01 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -20,7 +20,7 @@
20 20
21(define-module (gnu tests) 21(define-module (gnu tests)
22 #:use-module (guix gexp) 22 #:use-module (guix gexp)
23 #:use-module (guix utils) 23 #:use-module (guix diagnostics)
24 #:use-module (guix records) 24 #:use-module (guix records)
25 #:use-module ((guix ui) #:select (warn-about-load-error)) 25 #:use-module ((guix ui) #:select (warn-about-load-error))
26 #:use-module (gnu bootloader) 26 #:use-module (gnu bootloader)
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm
index 6c0753aef43..8b24b1b9942 100644
--- a/guix/diagnostics.scm
+++ b/guix/diagnostics.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -19,8 +19,9 @@
19(define-module (guix diagnostics) 19(define-module (guix diagnostics)
20 #:use-module (guix colors) 20 #:use-module (guix colors)
21 #:use-module (guix i18n) 21 #:use-module (guix i18n)
22 #:autoload (guix utils) (<location>) 22 #:use-module (srfi srfi-9)
23 #:use-module (srfi srfi-26) 23 #:use-module (srfi srfi-26)
24 #:use-module (srfi srfi-35)
24 #:use-module (ice-9 format) 25 #:use-module (ice-9 format)
25 #:use-module (ice-9 match) 26 #:use-module (ice-9 match)
26 #:export (warning 27 #:export (warning
@@ -28,8 +29,20 @@
28 report-error 29 report-error
29 leave 30 leave
30 31
32 <location>
33 location
34 location?
35 location-file
36 location-line
37 location-column
38 source-properties->location
39 location->source-properties
31 location->string 40 location->string
32 41
42 &error-location
43 error-location?
44 error-location
45
33 guix-warning-port 46 guix-warning-port
34 program-name)) 47 program-name))
35 48
@@ -162,6 +175,45 @@ messages."
162 (program-name) (program-name) 175 (program-name) (program-name)
163 (prefix-color prefix))))) 176 (prefix-color prefix)))))
164 177
178
179;; A source location.
180(define-record-type <location>
181 (make-location file line column)
182 location?
183 (file location-file) ; file name
184 (line location-line) ; 1-indexed line
185 (column location-column)) ; 0-indexed column
186
187(define (location file line column)
188 "Return the <location> object for the given FILE, LINE, and COLUMN."
189 (and line column file
190 (make-location file line column)))
191
192(define (source-properties->location loc)
193 "Return a location object based on the info in LOC, an alist as returned
194by Guile's `source-properties', `frame-source', `current-source-location',
195etc."
196 ;; In accordance with the GCS, start line and column numbers at 1. Note
197 ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
198 (match loc
199 ((('line . line) ('column . col) ('filename . file)) ;common case
200 (and file line col
201 (make-location file (+ line 1) col)))
202 (#f
203 #f)
204 (_
205 (let ((file (assq-ref loc 'filename))
206 (line (assq-ref loc 'line))
207 (col (assq-ref loc 'column)))
208 (location file (and line (+ line 1)) col)))))
209
210(define (location->source-properties loc)
211 "Return the source property association list based on the info in LOC,
212a location object."
213 `((line . ,(and=> (location-line loc) 1-))
214 (column . ,(location-column loc))
215 (filename . ,(location-file loc))))
216
165(define (location->string loc) 217(define (location->string loc)
166 "Return a human-friendly, GNU-standard representation of LOC." 218 "Return a human-friendly, GNU-standard representation of LOC."
167 (match loc 219 (match loc
@@ -169,6 +221,10 @@ messages."
169 (($ <location> file line column) 221 (($ <location> file line column)
170 (format #f "~a:~a:~a" file line column)))) 222 (format #f "~a:~a:~a" file line column))))
171 223
224(define-condition-type &error-location &error
225 error-location?
226 (location error-location)) ;<location>
227
172 228
173(define guix-warning-port 229(define guix-warning-port
174 (make-parameter (current-warning-port))) 230 (make-parameter (current-warning-port)))
diff --git a/guix/inferior.scm b/guix/inferior.scm
index d347754bbc5..77820872b35 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -21,9 +21,10 @@
21 #:use-module (srfi srfi-9 gnu) 21 #:use-module (srfi srfi-9 gnu)
22 #:use-module (srfi srfi-34) 22 #:use-module (srfi srfi-34)
23 #:use-module (srfi srfi-35) 23 #:use-module (srfi srfi-35)
24 #:use-module ((guix diagnostics)
25 #:select (source-properties->location))
24 #:use-module ((guix utils) 26 #:use-module ((guix utils)
25 #:select (%current-system 27 #:select (%current-system
26 source-properties->location
27 call-with-temporary-directory 28 call-with-temporary-directory
28 version>? version-prefix? 29 version>? version-prefix?
29 cache-directory)) 30 cache-directory))
diff --git a/guix/utils.scm b/guix/utils.scm
index 17a96370f16..64894ecf1fd 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -37,13 +37,27 @@
37 #:use-module (guix memoization) 37 #:use-module (guix memoization)
38 #:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively)) 38 #:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively))
39 #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) 39 #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
40 #:use-module (guix diagnostics) ;<location>, &error-location, etc.
40 #:use-module (ice-9 format) 41 #:use-module (ice-9 format)
41 #:use-module (ice-9 regex) 42 #:use-module (ice-9 regex)
42 #:use-module (ice-9 match) 43 #:use-module (ice-9 match)
43 #:use-module (ice-9 format) 44 #:use-module (ice-9 format)
44 #:use-module ((ice-9 iconv) #:prefix iconv:) 45 #:use-module ((ice-9 iconv) #:prefix iconv:)
45 #:use-module (system foreign) 46 #:use-module (system foreign)
46 #:re-export (memoize) ; for backwards compatibility 47 #:re-export (memoize ;for backwards compatibility
48
49 <location>
50 location
51 location?
52 location-file
53 location-line
54 location-column
55 source-properties->location
56 location->source-properties
57
58 &error-location
59 error-location?
60 error-location)
47 #:export (strip-keyword-arguments 61 #:export (strip-keyword-arguments
48 default-keyword-arguments 62 default-keyword-arguments
49 substitute-keyword-arguments 63 substitute-keyword-arguments
@@ -51,19 +65,6 @@
51 65
52 current-source-directory 66 current-source-directory
53 67
54 <location>
55 location
56 location?
57 location-file
58 location-line
59 location-column
60 source-properties->location
61 location->source-properties
62
63 &error-location
64 error-location?
65 error-location
66
67 &fix-hint 68 &fix-hint
68 fix-hint? 69 fix-hint?
69 condition-fix-hint 70 condition-fix-hint
@@ -834,48 +835,6 @@ be determined."
834 ;; raising an error would upset Geiser users 835 ;; raising an error would upset Geiser users
835 #f)))))) 836 #f))))))
836 837
837;; A source location.
838(define-record-type <location>
839 (make-location file line column)
840 location?
841 (file location-file) ; file name
842 (line location-line) ; 1-indexed line
843 (column location-column)) ; 0-indexed column
844
845(define (location file line column)
846 "Return the <location> object for the given FILE, LINE, and COLUMN."
847 (and line column file
848 (make-location file line column)))
849
850(define (source-properties->location loc)
851 "Return a location object based on the info in LOC, an alist as returned
852by Guile's `source-properties', `frame-source', `current-source-location',
853etc."
854 ;; In accordance with the GCS, start line and column numbers at 1. Note
855 ;; that unlike LINE and `port-column', COL is actually 1-indexed here...
856 (match loc
857 ((('line . line) ('column . col) ('filename . file)) ;common case
858 (and file line col
859 (make-location file (+ line 1) col)))
860 (#f
861 #f)
862 (_
863 (let ((file (assq-ref loc 'filename))
864 (line (assq-ref loc 'line))
865 (col (assq-ref loc 'column)))
866 (location file (and line (+ line 1)) col)))))
867
868(define (location->source-properties loc)
869 "Return the source property association list based on the info in LOC,
870a location object."
871 `((line . ,(and=> (location-line loc) 1-))
872 (column . ,(location-column loc))
873 (filename . ,(location-file loc))))
874
875(define-condition-type &error-location &error
876 error-location?
877 (location error-location)) ;<location>
878
879(define-condition-type &fix-hint &condition 838(define-condition-type &fix-hint &condition
880 fix-hint? 839 fix-hint?
881 (hint condition-fix-hint)) ;string 840 (hint condition-fix-hint)) ;string
diff --git a/tests/channels.scm b/tests/channels.scm
index cde3b668fb1..55a0537e0fa 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -26,7 +26,7 @@
26 #:use-module (guix derivations) 26 #:use-module (guix derivations)
27 #:use-module (guix sets) 27 #:use-module (guix sets)
28 #:use-module (guix gexp) 28 #:use-module (guix gexp)
29 #:use-module ((guix utils) 29 #:use-module ((guix diagnostics)
30 #:select (error-location? error-location location-line)) 30 #:select (error-location? error-location location-line))
31 #:use-module ((guix build utils) #:select (which)) 31 #:use-module ((guix build utils) #:select (which))
32 #:use-module (git) 32 #:use-module (git)
diff --git a/tests/packages.scm b/tests/packages.scm
index 6aa36170d2b..0a4bf83c40d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -23,7 +23,8 @@
23 #:use-module (guix monads) 23 #:use-module (guix monads)
24 #:use-module (guix grafts) 24 #:use-module (guix grafts)
25 #:use-module ((guix gexp) #:select (local-file local-file-file)) 25 #:use-module ((guix gexp) #:select (local-file local-file-file))
26 #:use-module ((guix utils) 26 #:use-module (guix utils)
27 #:use-module ((guix diagnostics)
27 ;; Rename the 'location' binding to allow proper syntax 28 ;; Rename the 'location' binding to allow proper syntax
28 ;; matching when setting the 'location' field of a package. 29 ;; matching when setting the 'location' field of a package.
29 #:renamer (lambda (name) 30 #:renamer (lambda (name)
generated by cgit v1.2.3 (git 2.25.1) at 2026-09-03 06:45:40 +0000