diff options
| author | Maxime Devos <maximedevos@telenet.be> | 2021-06-28 19:24:44 +0200 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2021-06-30 13:53:00 +0200 |
| commit | d9e0ae07db5cb9f949c11f4ee77146a070c2618c (patch) | |
| tree | eb4222919d1f19cf852f92ecea58fe4704d9d2a4 /guix/gexp.scm | |
| parent | ebf07a06f0a29eac6b5f115b10fc1eb7574f060c (diff) | |
| download | guix-patches-d9e0ae07db5cb9f949c11f4ee77146a070c2618c.tar guix-patches-d9e0ae07db5cb9f949c11f4ee77146a070c2618c.tar.gz | |
guix: gexp: Define gexp->approximate-sexp.
It will be used in the 'optional-tests' linter.
* guix/gexp.scm (gexp->approximate-sexp): New procedure.
* tests/gexp.scm
("no references", "unquoted gexp", "unquoted gexp (native)")
("spliced gexp", "unspliced gexp, approximated")
("unquoted gexp, approximated"): Test it.
* doc/gexp.scm ("G-Expressions"): Document it.
Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
Diffstat (limited to 'guix/gexp.scm')
| -rw-r--r-- | guix/gexp.scm | 19 |
1 files changed, 19 insertions, 0 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 187f5c5e85..f3d278b3e6 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +43,7 @@ with-imported-modules with-extensions let-system + gexp->approximate-sexp gexp-input gexp-input? @@ -157,6 +159,23 @@ "Return the source code location of GEXP." (and=> (%gexp-location gexp) source-properties->location)) +(define* (gexp->approximate-sexp gexp) + "Return the S-expression corresponding to GEXP, but do not lower anything. +As a result, the S-expression will be approximate if GEXP has references." + (define (gexp-like? thing) + (or (gexp? thing) (gexp-input? thing))) + (apply (gexp-proc gexp) + (map (lambda (reference) + (match reference + (($ <gexp-input> thing output native) + (if (gexp-like? thing) + (gexp->approximate-sexp thing) + ;; Simply returning 'thing' won't work in some + ;; situations; see 'write-gexp' below. + '(*approximate*))) + (_ '(*approximate*)))) + (gexp-references gexp)))) + (define (write-gexp gexp port) "Write GEXP on PORT." (display "#<gexp " port) |