diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-11-05 14:32:04 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-11-05 16:13:50 +0100 |
| commit | 18fc84bce86eedb85d44a8708a9a5ef7c1b23da5 (patch) | |
| tree | a197fec5851a732439e91476cdc1efef101ed42d | |
| parent | 61d9c4458eef35a2a3fce94f113031d86b9f4d8d (diff) | |
| download | guix-18fc84bce86eedb85d44a8708a9a5ef7c1b23da5.tar guix-18fc84bce86eedb85d44a8708a9a5ef7c1b23da5.tar.gz | |
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.
| -rw-r--r-- | guix/gexp.scm | 20 | ||||
| -rw-r--r-- | tests/gexp.scm | 2 |
2 files changed, 17 insertions, 5 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))))))) ;;; diff --git a/tests/gexp.scm b/tests/gexp.scm index 1beeb67c21..0487f2a96d 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1413,7 +1413,7 @@ (test-assert "printer" (string-match "^#<gexp \\(string-append .*#<package coreutils.*\ - \"/bin/uname\"\\) [[:xdigit:]]+>$" + \"/bin/uname\"\\) [[:graph:]]+tests/gexp\\.scm:[0-9]+:[0-9]+ [[:xdigit:]]+>$" (with-output-to-string (lambda () (write |