diff options
| -rw-r--r-- | guix/gexp.scm | 74 |
1 files changed, 51 insertions, 23 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index 2a4b36519c..5c614f3e12 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -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) |