gexp: Compilers can now return lowerable objects.

* guix/gexp.scm (lower-object): Iterate if LOWERED is a struct.
(lower+expand-object): New procedure.
(gexp->sexp): Use it.
(define-gexp-compiler): Adjust docstring.
This commit is contained in:
Ludovic Courtès 2017-11-14 17:10:17 +01:00 committed by Tobias Geerinckx-Rice
parent a8b8ca6fd3
commit 56eafb812f
No known key found for this signature in database
GPG Key ID: 0DB0FF884F556D79
1 changed files with 51 additions and 23 deletions

View File

@ -226,32 +226,62 @@ procedure to expand it; otherwise return #f."
corresponding to OBJ for SYSTEM, cross-compiling for TARGET if TARGET is true.
OBJ must be an object that has an associated gexp compiler, such as a
<package>."
(match (lookup-compiler obj)
(#f
(raise (condition (&gexp-input-error (input obj)))))
(lower
;; Cache in STORE the result of lowering OBJ.
(mlet %store-monad ((target (if (eq? target 'current)
(current-target-system)
(return target)))
(graft? (grafting?)))
(mcached (let ((lower (lookup-compiler obj)))
(lower obj system target))
obj
system target graft?)))))
(mlet %store-monad ((target (if (eq? target 'current)
(current-target-system)
(return target)))
(graft? (grafting?)))
(let loop ((obj obj))
(match (lookup-compiler obj)
(#f
(raise (condition (&gexp-input-error (input obj)))))
(lower
;; Cache in STORE the result of lowering OBJ.
(mcached (mlet %store-monad ((lowered (lower obj system target)))
(if (and (struct? lowered)
(not (derivation? lowered)))
(loop lowered)
(return lowered)))
obj
system target graft?))))))
(define* (lower+expand-object obj
#:optional (system (%current-system))
#:key target (output "out"))
"Return as a value in %STORE-MONAD the output of object OBJ expands to for
SYSTEM and TARGET. Object such as <package>, <file-append>, or <plain-file>
expand to file names, but it's possible to expand to a plain data type."
(let loop ((obj obj)
(expand (and (struct? obj) (lookup-expander obj))))
(match (lookup-compiler obj)
(#f
(raise (condition (&gexp-input-error (input obj)))))
(lower
(mlet* %store-monad ((graft? (grafting?))
(lowered (mcached (lower obj system target)
obj
system target graft?)))
;; LOWER might return something that needs to be further
;; lowered.
(if (struct? lowered)
;; If we lack an expander, delegate to that of LOWERED.
(if (not expand)
(loop lowered (lookup-expander lowered))
(return (expand obj lowered output)))
(return lowered))))))) ;self-quoting
(define-syntax define-gexp-compiler
(syntax-rules (=> compiler expander)
"Define NAME as a compiler for objects matching PREDICATE encountered in
gexps.
In the simplest form of the macro, BODY must return a derivation for PARAM, an
object that matches PREDICATE, for SYSTEM and TARGET (the latter of which is
#f except when cross-compiling.)
In the simplest form of the macro, BODY must return (1) a derivation for
a record of the specified type, for SYSTEM and TARGET (the latter of which is
#f except when cross-compiling), (2) another record that can itself be
compiled down to a derivation, or (3) an object of a primitive data type.
The more elaborate form allows you to specify an expander:
(define-gexp-compiler something something?
(define-gexp-compiler something-compiler <something>
compiler => (lambda (param system target) ...)
expander => (lambda (param drv output) ...))
@ -1148,12 +1178,10 @@ and in the current monad setting (system type, etc.)"
(or n? native?)))
refs))
(($ <gexp-input> (? struct? thing) output n?)
(let ((target (if (or n? native?) #f target))
(expand (lookup-expander thing)))
(mlet %store-monad ((obj (lower-object thing system
#:target target)))
;; OBJ must be either a derivation or a store file name.
(return (expand thing obj output)))))
(let ((target (if (or n? native?) #f target)))
(lower+expand-object thing system
#:target target
#:output output)))
(($ <gexp-input> (? self-quoting? x))
(return x))
(($ <gexp-input> x)