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:
parent
a8b8ca6fd3
commit
56eafb812f
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user