summaryrefslogtreecommitdiff
path: root/guix/gexp.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-11-05 14:32:04 +0100
committerLudovic Courtès <ludo@gnu.org>2020-11-05 16:13:50 +0100
commit18fc84bce86eedb85d44a8708a9a5ef7c1b23da5 (patch)
treea197fec5851a732439e91476cdc1efef101ed42d /guix/gexp.scm
parent61d9c4458eef35a2a3fce94f113031d86b9f4d8d (diff)
gexp: Store the source code location in <gexp>.
* guix/gexp.scm (<gexp>)[location]: New field. (gexp-location): New procedure. (write-gexp): Print the location of GEXP. (gexp->derivation): Adjust call to 'make-gexp'. (gexp): Likewise.
Diffstat (limited to 'guix/gexp.scm')
-rw-r--r--guix/gexp.scm20
1 files changed, 16 insertions, 4 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 9339b226b7..97a6101868 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -146,12 +146,17 @@
;; "G expressions".
(define-record-type <gexp>
- (make-gexp references modules extensions proc)
+ (make-gexp references modules extensions proc location)
gexp?
(references gexp-references) ;list of <gexp-input>
(modules gexp-self-modules) ;list of module names
(extensions gexp-self-extensions) ;list of lowerable things
- (proc gexp-proc)) ;procedure
+ (proc gexp-proc) ;procedure
+ (location %gexp-location)) ;location alist
+
+(define (gexp-location gexp)
+ "Return the source code location of GEXP."
+ (and=> (%gexp-location gexp) source-properties->location))
(define (write-gexp gexp port)
"Write GEXP on PORT."
@@ -164,6 +169,11 @@
(write (apply (gexp-proc gexp)
(gexp-references gexp))
port))
+
+ (let ((loc (gexp-location gexp)))
+ (when loc
+ (format port " ~a" (location->string loc))))
+
(format port " ~a>"
(number->string (object-address gexp) 16)))
@@ -1084,7 +1094,8 @@ The other arguments are as for 'derivation'."
(make-gexp (gexp-references exp)
(append modules (gexp-self-modules exp))
(gexp-self-extensions exp)
- (gexp-proc exp))))
+ (gexp-proc exp)
+ (gexp-location exp))))
(mlet* %store-monad ( ;; The following binding forces '%current-system' and
;; '%current-target-system' to be looked up at >>=
@@ -1414,7 +1425,8 @@ execution environment."
current-imported-modules
current-imported-extensions
(lambda #,formals
- #,sexp)))))))
+ #,sexp)
+ (current-source-location)))))))
;;;