diff options
| -rw-r--r-- | doc/guix.texi | 10 | ||||
| -rw-r--r-- | guix/gexp.scm | 19 | ||||
| -rw-r--r-- | tests/gexp.scm | 31 |
3 files changed, 60 insertions, 0 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index e0668b1f5f..e39e4eb7be 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10046,6 +10046,16 @@ corresponding to @var{obj} for @var{system}, cross-compiling for has an associated gexp compiler, such as a @code{<package>}. @end deffn +@deffn {Procedure} gexp->approximate-sexp @var{gexp} +Sometimes, it may be useful to convert a G-exp into a S-exp. For +example, some linters (@pxref{Invoking guix lint}) peek into the build +phases of a package to detect potential problems. This conversion can +be achieved with this procedure. However, some information can be lost +in the process. More specifically, lowerable objects will be silently +replaced with some arbitrary object -- currently the list +@code{(*approximate*)}, but this may change. +@end deffn + @node Invoking guix repl @section Invoking @command{guix repl} 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) diff --git a/tests/gexp.scm b/tests/gexp.scm index 834e78b9a0..39a47d4e8c 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,6 +90,36 @@ (test-begin "gexp") +(test-equal "no references" + '(display "hello gexp->approximate-sexp!") + (gexp->approximate-sexp #~(display "hello gexp->approximate-sexp!"))) + +(test-equal "unquoted gexp" + '(display "hello") + (let ((inside #~"hello")) + (gexp->approximate-sexp #~(display #$inside)))) + +(test-equal "unquoted gexp (native)" + '(display "hello") + (let ((inside #~"hello")) + (gexp->approximate-sexp #~(display #+inside)))) + +(test-equal "spliced gexp" + '(display '(fresh vegetables)) + (let ((inside #~(fresh vegetables))) + (gexp->approximate-sexp #~(display '(#$@inside))))) + +(test-equal "unspliced gexp, approximated" + ;; (*approximate*) is really an implementation detail + '(display '(*approximate*)) + (let ((inside (file-append coreutils "/bin/hello"))) + (gexp->approximate-sexp #~(display '(#$@inside))))) + +(test-equal "unquoted gexp, approximated" + '(display '(*approximate*)) + (let ((inside (file-append coreutils "/bin/hello"))) + (gexp->approximate-sexp #~(display '#$inside)))) + (test-equal "no refs" '(display "hello!") (let ((exp (gexp (display "hello!")))) |