aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMaxime Devos <maximedevos@telenet.be>2021-06-28 19:24:44 +0200
committerMathieu Othacehe <othacehe@gnu.org>2021-06-30 13:53:00 +0200
commitd9e0ae07db5cb9f949c11f4ee77146a070c2618c (patch)
treeeb4222919d1f19cf852f92ecea58fe4704d9d2a4
parentebf07a06f0a29eac6b5f115b10fc1eb7574f060c (diff)
downloadguix-d9e0ae07db5cb9f949c11f4ee77146a070c2618c.tar
guix-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>
-rw-r--r--doc/guix.texi10
-rw-r--r--guix/gexp.scm19
-rw-r--r--tests/gexp.scm31
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!"))))