[jackhill/guix/guix.git] / guix / build-system / asdf.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system asdf)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix memoization)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module ((guix build utils)
                #:select ((package-name->name+version
                           . hyphen-separated-name->name+version)))
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (gnu packages)
  #:export (%asdf-build-system-modules
            %asdf-build-modules
            asdf-build
            asdf-build-system/sbcl
            asdf-build-system/ecl
            asdf-build-system/source
            sbcl-package->cl-source-package
            sbcl-package->ecl-package))

;; Commentary:
;;
;; Standard build procedure for asdf packages.  This is implemented as an
;; extension of 'gnu-build-system'.
;;
;; Code:

(define %asdf-build-system-modules
  ;; Imported build-side modules
  `((guix build asdf-build-system)
    (guix build lisp-utils)
    ,@%gnu-build-system-modules))

(define %asdf-build-modules
  ;; Used (visible) build-side modules
  '((guix build asdf-build-system)
    (guix build utils)
    (guix build lisp-utils)))

(define (default-lisp implementation)
  "Return the default package for the lisp IMPLEMENTATION."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((lisp-module (resolve-interface '(gnu packages lisp))))
    (module-ref lisp-module implementation)))

(define* (lower/source name
                       #:key source inputs outputs native-inputs system target
                       #:allow-other-keys
                       #:rest arguments)
  "Return a bag for NAME"
  (define private-keywords
    '(#:target #:inputs #:native-inputs))

  (and (not target)
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs
                        ,@(standard-packages)))
         (build-inputs native-inputs)
         (outputs outputs)
         (build asdf-build/source)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (asdf-build/source store name inputs
                            #:key source outputs
                            (phases '(@ (guix build asdf-build-system)
                                        %standard-phases/source))
                            (search-paths '())
                            (system (%current-system))
                            (guile #f)
                            (imported-modules %asdf-build-system-modules)
                            (modules %asdf-build-modules))
  (define builder
    `(begin
       (use-modules ,@modules)
       (asdf-build/source #:name ,name
                          #:source ,(match (assoc-ref inputs "source")
                                      (((? derivation? source))
                                       (derivation->output-path source))
                                      ((source) source)
                                      (source source))
                          #:system ,system
                          #:phases ,phases
                          #:outputs %outputs
                          #:search-paths ',(map search-path-specification->sexp
                                                search-paths)
                          #:inputs %build-inputs)))

  (define guile-for-build
    (match guile
      ((? package?)
       (package-derivation store guile system #:graft? #f))
      (#f
       (let* ((distro (resolve-interface '(gnu packages commencement)))
              (guile (module-ref distro 'guile-final)))
         (package-derivation store guile system #:graft? #f)))))

  (build-expression->derivation store name builder
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define* (package-with-build-system from-build-system to-build-system
                                    from-prefix to-prefix
                                    #:key variant-property
                                    phases-transformer)
  "Return a precedure which takes a package PKG which uses FROM-BUILD-SYSTEM,
and returns one using TO-BUILD-SYSTEM.  If PKG was prefixed by FROM-PREFIX,
the resulting package will be prefixed by TO-PREFIX.  Inputs of PKG are
recursively transformed using the same rule.  The result's #:phases argument
will be modified by PHASES-TRANSFORMER, an S-expression which evaluates on the
build side to a procedure of one argument.

VARIANT-PROPERTY can be added to a package's properties to indicate that the
corresponding package promise should be used as the result of this
transformation.  This allows the result to differ from what the transformation
would otherwise produce.

If TO-BUILD-SYSTEM is asdf-build-system/source, the resulting package will be
set up using CL source package conventions."
  (define target-is-source? (eq? asdf-build-system/source to-build-system))

  (define (transform-package-name name)
    (if (string-prefix? from-prefix name)
        (let ((new-name (string-drop name (string-length from-prefix))))
          (if (string-prefix? to-prefix new-name)
              new-name
              (string-append to-prefix new-name)))
        name))

  (define (has-from-build-system? pkg)
    (eq? from-build-system (package-build-system pkg)))

  (define (find-input-package pkg)
    (let* ((name (package-name pkg))
           (new-name (transform-package-name name))
           (pkgs (find-packages-by-name new-name)))
      (if (null? pkgs) #f (list-ref pkgs 0))))

  (define transform
    (mlambda (pkg)
      (define rewrite
        (match-lambda
          ((name content . rest)
           (let* ((is-package? (package? content))
                  (new-content (if is-package?
                                   (or (find-input-package content)
                                       (transform content))
                                   content)))
             `(,name ,new-content ,@rest)))))

      ;; Special considerations for source packages: CL inputs become
      ;; propagated, and un-handled arguments are removed.

      (define (new-propagated-inputs)
        (if target-is-source?
            (map rewrite
                 (append
                  (filter (match-lambda
                            ((_ input . _)
                             (has-from-build-system? input)))
                          (append (package-inputs pkg)
                                  ;; The native inputs might be needed just
                                  ;; to load the system.
                                  (package-native-inputs pkg)))
                  (package-propagated-inputs pkg)))

            (map rewrite (package-propagated-inputs pkg))))

      (define (new-inputs inputs-getter)
        (if target-is-source?
            (map rewrite
                 (filter (match-lambda
                           ((_ input . _)
                            (not (has-from-build-system? input))))
                         (inputs-getter pkg)))
            (map rewrite (inputs-getter pkg))))

      (define base-arguments
        (if target-is-source?
            (strip-keyword-arguments
             '(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file)
             (package-arguments pkg))
            (package-arguments pkg)))

      (cond
       ((and variant-property
             (assoc-ref (package-properties pkg) variant-property))
        => force)

       ((has-from-build-system? pkg)
        (package
          (inherit pkg)
          (location (package-location pkg))
          (name (transform-package-name (package-name pkg)))
          (build-system to-build-system)
          (arguments
           (substitute-keyword-arguments base-arguments
             ((#:phases phases) (list phases-transformer phases))))
          (inputs (new-inputs package-inputs))
          (propagated-inputs (new-propagated-inputs))
          (native-inputs (append (if target-is-source?
                                     (list (list (package-name pkg) pkg))
                                     '())
                                 (new-inputs package-native-inputs)))
          (outputs (if target-is-source?
                       '("out")
                       (package-outputs pkg)))))
       (else pkg))))

  transform)

(define (strip-variant-as-necessary variant pkg)
  (define properties (package-properties pkg))
  (if (assoc variant properties)
      (package
        (inherit pkg)
        (properties (alist-delete variant properties)))
      pkg))

(define (lower lisp-type)
  (lambda* (name
            #:key source inputs outputs native-inputs system target
            (lisp (default-lisp (string->symbol lisp-type)))
            #:allow-other-keys
            #:rest arguments)
    "Return a bag for NAME"
    (define private-keywords
      '(#:target #:inputs #:native-inputs #:lisp))

    (and (not target)
         (bag
           (name name)
           (system system)
           (host-inputs `(,@(if source
                                `(("source" ,source))
                                '())
                          ,@inputs
                          ,@(standard-packages)))
           (build-inputs `((,lisp-type ,lisp)
                           ,@native-inputs))
           (outputs outputs)
           (build (asdf-build lisp-type))
           (arguments (strip-keyword-arguments private-keywords arguments))))))

(define (asdf-build lisp-type)
  (lambda* (store name inputs
                  #:key source outputs
                  (tests? #t)
                  (asd-file #f)
                  (asd-system-name #f)
                  (test-asd-file #f)
                  (phases '(@ (guix build asdf-build-system)
                              %standard-phases))
                  (search-paths '())
                  (system (%current-system))
                  (guile #f)
                  (imported-modules %asdf-build-system-modules)
                  (modules %asdf-build-modules))

    (define system-name
      (or asd-system-name
          (string-drop
           ;; NAME is the value returned from `package-full-name'.
           (hyphen-separated-name->name+version name)
           (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.

    (define builder
      `(begin
         (use-modules ,@modules)
         (parameterize ((%lisp (string-append
                                (assoc-ref %build-inputs ,lisp-type)
                                "/bin/" ,lisp-type))
                        (%lisp-type ,lisp-type))
           (asdf-build #:name ,name
                       #:source ,(match (assoc-ref inputs "source")
                                   (((? derivation? source))
                                    (derivation->output-path source))
                                   ((source) source)
                                   (source source))
                       #:asd-file ,(or asd-file (string-append system-name ".asd"))
                       #:asd-system-name ,system-name
                       #:test-asd-file ,test-asd-file
                       #:system ,system
                       #:tests? ,tests?
                       #:phases ,phases
                       #:outputs %outputs
                       #:search-paths ',(map search-path-specification->sexp
                                             search-paths)
                       #:inputs %build-inputs))))

    (define guile-for-build
      (match guile
        ((? package?)
         (package-derivation store guile system #:graft? #f))
        (#f
         (let* ((distro (resolve-interface '(gnu packages commencement)))
                (guile (module-ref distro 'guile-final)))
           (package-derivation store guile system #:graft? #f)))))

    (build-expression->derivation store name builder
                                  #:inputs inputs
                                  #:system system
                                  #:modules imported-modules
                                  #:outputs outputs
                                  #:guile-for-build guile-for-build)))

(define asdf-build-system/sbcl
  (build-system
    (name 'asdf/sbcl)
    (description "The build system for ASDF binary packages using SBCL")
    (lower (lower "sbcl"))))

(define asdf-build-system/ecl
  (build-system
    (name 'asdf/ecl)
    (description "The build system for ASDF binary packages using ECL")
    (lower (lower "ecl"))))

(define asdf-build-system/source
  (build-system
    (name 'asdf/source)
    (description "The build system for ASDF source packages")
    (lower lower/source)))

(define sbcl-package->cl-source-package
  (let* ((property 'cl-source-variant)
         (transformer
          (package-with-build-system asdf-build-system/sbcl
                                     asdf-build-system/source
                                     "sbcl-"
                                     "cl-"
                                     #:variant-property property
                                     #:phases-transformer
                                     '(const %standard-phases/source))))
    (lambda (pkg)
      (transformer
       (strip-variant-as-necessary property pkg)))))

(define sbcl-package->ecl-package
  (let* ((property 'ecl-variant)
         (transformer
          (package-with-build-system asdf-build-system/sbcl
                                     asdf-build-system/ecl
                                     "sbcl-"
                                     "ecl-"
                                     #:variant-property property
                                     #:phases-transformer
                                     'identity)))
    (lambda (pkg)
      (transformer
       (strip-variant-as-necessary property pkg)))))

;;; asdf.scm ends here
Commit	Line	Data
a1b30f99	1	;;; GNU Guix --- Functional package management for GNU
0e1371be	2	;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
5cace974	3	;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
a1b30f99 AP	4	;;;
	5	;;; This file is part of GNU Guix.
	6	;;;
	7	;;; GNU Guix is free software; you can redistribute it and/or modify it
	8	;;; under the terms of the GNU General Public License as published by
	9	;;; the Free Software Foundation; either version 3 of the License, or (at
	10	;;; your option) any later version.
	11	;;;
	12	;;; GNU Guix is distributed in the hope that it will be useful, but
	13	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	14	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	;;; GNU General Public License for more details.
	16	;;;
	17	;;; You should have received a copy of the GNU General Public License
	18	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	19
	20	(define-module (guix build-system asdf)
	21	#:use-module (guix store)
	22	#:use-module (guix utils)
8bc1935c	23	#:use-module (guix memoization)
a1b30f99 AP	24	#:use-module (guix packages)
	25	#:use-module (guix derivations)
	26	#:use-module (guix search-paths)
457702b1 AP	27	#:use-module ((guix build utils)
	28	#:select ((package-name->name+version
	29	. hyphen-separated-name->name+version)))
a1b30f99 AP	30	#:use-module (guix build-system)
	31	#:use-module (guix build-system gnu)
	32	#:use-module (ice-9 match)
	33	#:use-module (ice-9 regex)
	34	#:use-module (srfi srfi-1)
	35	#:use-module (srfi srfi-26)
5cace974	36	#:use-module (gnu packages)
a1b30f99 AP	37	#:export (%asdf-build-system-modules
	38	%asdf-build-modules
	39	asdf-build
	40	asdf-build-system/sbcl
	41	asdf-build-system/ecl
	42	asdf-build-system/source
	43	sbcl-package->cl-source-package
	44	sbcl-package->ecl-package))
	45
	46	;; Commentary:
	47	;;
	48	;; Standard build procedure for asdf packages. This is implemented as an
	49	;; extension of 'gnu-build-system'.
	50	;;
	51	;; Code:
	52
	53	(define %asdf-build-system-modules
	54	;; Imported build-side modules
	55	`((guix build asdf-build-system)
	56	(guix build lisp-utils)
	57	,@%gnu-build-system-modules))
	58
	59	(define %asdf-build-modules
	60	;; Used (visible) build-side modules
	61	'((guix build asdf-build-system)
	62	(guix build utils)
	63	(guix build lisp-utils)))
	64
	65	(define (default-lisp implementation)
	66	"Return the default package for the lisp IMPLEMENTATION."
dece8c91	67	;; Lazily resolve the binding to avoid a circular dependency.
a1b30f99 AP	68	(let ((lisp-module (resolve-interface '(gnu packages lisp))))
	69	(module-ref lisp-module implementation)))
	70
	71	(define* (lower/source name
	72	#:key source inputs outputs native-inputs system target
	73	#:allow-other-keys
	74	#:rest arguments)
	75	"Return a bag for NAME"
	76	(define private-keywords
	77	'(#:target #:inputs #:native-inputs))
	78
	79	(and (not target)
	80	(bag
	81	(name name)
	82	(system system)
	83	(host-inputs `(,@(if source
	84	`(("source" ,source))
	85	'())
	86	,@inputs
	87	,@(standard-packages)))
	88	(build-inputs native-inputs)
	89	(outputs outputs)
	90	(build asdf-build/source)
	91	(arguments (strip-keyword-arguments private-keywords arguments)))))
	92
	93	(define* (asdf-build/source store name inputs
	94	#:key source outputs
	95	(phases '(@ (guix build asdf-build-system)
	96	%standard-phases/source))
	97	(search-paths '())
	98	(system (%current-system))
	99	(guile #f)
	100	(imported-modules %asdf-build-system-modules)
	101	(modules %asdf-build-modules))
	102	(define builder
	103	`(begin
	104	(use-modules ,@modules)
	105	(asdf-build/source #:name ,name
	106	#:source ,(match (assoc-ref inputs "source")
	107	(((? derivation? source))
	108	(derivation->output-path source))
	109	((source) source)
	110	(source source))
	111	#:system ,system
	112	#:phases ,phases
	113	#:outputs %outputs
	114	#:search-paths ',(map search-path-specification->sexp
	115	search-paths)
	116	#:inputs %build-inputs)))
	117
	118	(define guile-for-build
	119	(match guile
	120	((? package?)
	121	(package-derivation store guile system #:graft? #f))
	122	(#f
	123	(let* ((distro (resolve-interface '(gnu packages commencement)))
	124	(guile (module-ref distro 'guile-final)))
	125	(package-derivation store guile system #:graft? #f)))))
	126
	127	(build-expression->derivation store name builder
	128	#:inputs inputs
	129	#:system system
	130	#:modules imported-modules
	131	#:outputs outputs
132	#:guile-for-build guile-for-build))
133
134	(define* (package-with-build-system from-build-system to-build-system
135	from-prefix to-prefix
136	#:key variant-property
137	phases-transformer)
138	"Return a precedure which takes a package PKG which uses FROM-BUILD-SYSTEM,
139	and returns one using TO-BUILD-SYSTEM. If PKG was prefixed by FROM-PREFIX,
140	the resulting package will be prefixed by TO-PREFIX. Inputs of PKG are
141	recursively transformed using the same rule. The result's #:phases argument
142	will be modified by PHASES-TRANSFORMER, an S-expression which evaluates on the
143	build side to a procedure of one argument.
144
145	VARIANT-PROPERTY can be added to a package's properties to indicate that the
146	corresponding package promise should be used as the result of this
147	transformation. This allows the result to differ from what the transformation
148	would otherwise produce.
149
150	If TO-BUILD-SYSTEM is asdf-build-system/source, the resulting package will be
151	set up using CL source package conventions."
152	(define target-is-source? (eq? asdf-build-system/source to-build-system))
153
154	(define (transform-package-name name)
155	(if (string-prefix? from-prefix name)
156	(let ((new-name (string-drop name (string-length from-prefix))))
157	(if (string-prefix? to-prefix new-name)
158	new-name
159	(string-append to-prefix new-name)))
160	name))
161
162	(define (has-from-build-system? pkg)
163	(eq? from-build-system (package-build-system pkg)))
164
5cace974 GLV	165	(define (find-input-package pkg)
	166	(let* ((name (package-name pkg))
	167	(new-name (transform-package-name name))
	168	(pkgs (find-packages-by-name new-name)))
	169	(if (null? pkgs) #f (list-ref pkgs 0))))
	170
a1b30f99	171	(define transform
8bc1935c LC	172	(mlambda (pkg)
	173	(define rewrite
	174	(match-lambda
	175	((name content . rest)
	176	(let* ((is-package? (package? content))
5cace974 GLV	177	(new-content (if is-package?
	178	(or (find-input-package content)
	179	(transform content))
	180	content)))
8bc1935c LC	181	`(,name ,new-content ,@rest)))))
	182
	183	;; Special considerations for source packages: CL inputs become
	184	;; propagated, and un-handled arguments are removed.
	185
804b9b18	186	(define (new-propagated-inputs)
8bc1935c LC	187	(if target-is-source?
	188	(map rewrite
	189	(append
a1b30f99 AP	190	(filter (match-lambda
a1b30f99 AP	191	((_ input . _)
8bc1935c LC	192	(has-from-build-system? input)))
	193	(append (package-inputs pkg)
	194	;; The native inputs might be needed just
	195	;; to load the system.
	196	(package-native-inputs pkg)))
	197	(package-propagated-inputs pkg)))
	198
	199	(map rewrite (package-propagated-inputs pkg))))
	200
	201	(define (new-inputs inputs-getter)
	202	(if target-is-source?
	203	(map rewrite
	204	(filter (match-lambda
	205	((_ input . _)
	206	(not (has-from-build-system? input))))
	207	(inputs-getter pkg)))
	208	(map rewrite (inputs-getter pkg))))
	209
	210	(define base-arguments
	211	(if target-is-source?
	212	(strip-keyword-arguments
	213	'(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file)
	214	(package-arguments pkg))
	215	(package-arguments pkg)))
	216
	217	(cond
	218	((and variant-property
	219	(assoc-ref (package-properties pkg) variant-property))
	220	=> force)
	221
	222	((has-from-build-system? pkg)
	223	(package
	224	(inherit pkg)
	225	(location (package-location pkg))
	226	(name (transform-package-name (package-name pkg)))
	227	(build-system to-build-system)
	228	(arguments
	229	(substitute-keyword-arguments base-arguments
	230	((#:phases phases) (list phases-transformer phases))))
	231	(inputs (new-inputs package-inputs))
804b9b18	232	(propagated-inputs (new-propagated-inputs))
c3f1f095 PN	233	(native-inputs (append (if target-is-source?
	234	(list (list (package-name pkg) pkg))
	235	'())
	236	(new-inputs package-native-inputs)))
8bc1935c LC	237	(outputs (if target-is-source?
	238	'("out")
	239	(package-outputs pkg)))))
	240	(else pkg))))
a1b30f99 AP	241
	242	transform)
	243
	244	(define (strip-variant-as-necessary variant pkg)
	245	(define properties (package-properties pkg))
	246	(if (assoc variant properties)
	247	(package
	248	(inherit pkg)
	249	(properties (alist-delete variant properties)))
	250	pkg))
	251
6de91ba2	252	(define (lower lisp-type)
a1b30f99 AP	253	(lambda* (name
a1b30f99 AP	254	#:key source inputs outputs native-inputs system target
6de91ba2	255	(lisp (default-lisp (string->symbol lisp-type)))
a1b30f99 AP	256	#:allow-other-keys
	257	#:rest arguments)
	258	"Return a bag for NAME"
	259	(define private-keywords
	260	'(#:target #:inputs #:native-inputs #:lisp))
	261
	262	(and (not target)
	263	(bag
	264	(name name)
	265	(system system)
	266	(host-inputs `(,@(if source
	267	`(("source" ,source))
	268	'())
	269	,@inputs
	270	,@(standard-packages)))
6de91ba2	271	(build-inputs `((,lisp-type ,lisp)
a1b30f99 AP	272	,@native-inputs))
a1b30f99 AP	273	(outputs outputs)
6de91ba2	274	(build (asdf-build lisp-type))
a1b30f99 AP	275	(arguments (strip-keyword-arguments private-keywords arguments))))))
a1b30f99 AP	276
6de91ba2	277	(define (asdf-build lisp-type)
a1b30f99 AP	278	(lambda* (store name inputs
	279	#:key source outputs
	280	(tests? #t)
a1b30f99	281	(asd-file #f)
457702b1	282	(asd-system-name #f)
0383afa0	283	(test-asd-file #f)
a1b30f99 AP	284	(phases '(@ (guix build asdf-build-system)
	285	%standard-phases))
	286	(search-paths '())
	287	(system (%current-system))
	288	(guile #f)
	289	(imported-modules %asdf-build-system-modules)
	290	(modules %asdf-build-modules))
	291
457702b1 AP	292	(define system-name
	293	(or asd-system-name
	294	(string-drop
	295	;; NAME is the value returned from `package-full-name'.
	296	(hyphen-separated-name->name+version name)
	297	(1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
	298
a1b30f99 AP	299	(define builder
	300	`(begin
	301	(use-modules ,@modules)
b4c9f0c5 AP	302	(parameterize ((%lisp (string-append
	303	(assoc-ref %build-inputs ,lisp-type)
	304	"/bin/" ,lisp-type))
	305	(%lisp-type ,lisp-type))
	306	(asdf-build #:name ,name
	307	#:source ,(match (assoc-ref inputs "source")
	308	(((? derivation? source))
	309	(derivation->output-path source))
	310	((source) source)
	311	(source source))
0186a463	312	#:asd-file ,(or asd-file (string-append system-name ".asd"))
457702b1	313	#:asd-system-name ,system-name
0383afa0	314	#:test-asd-file ,test-asd-file
b4c9f0c5 AP	315	#:system ,system
	316	#:tests? ,tests?
	317	#:phases ,phases
	318	#:outputs %outputs
	319	#:search-paths ',(map search-path-specification->sexp
	320	search-paths)
	321	#:inputs %build-inputs))))
a1b30f99 AP	322
	323	(define guile-for-build
	324	(match guile
	325	((? package?)
	326	(package-derivation store guile system #:graft? #f))
	327	(#f
	328	(let* ((distro (resolve-interface '(gnu packages commencement)))
	329	(guile (module-ref distro 'guile-final)))
	330	(package-derivation store guile system #:graft? #f)))))
	331
	332	(build-expression->derivation store name builder
	333	#:inputs inputs
	334	#:system system
	335	#:modules imported-modules
	336	#:outputs outputs
	337	#:guile-for-build guile-for-build)))
	338
	339	(define asdf-build-system/sbcl
	340	(build-system
	341	(name 'asdf/sbcl)
	342	(description "The build system for ASDF binary packages using SBCL")
	343	(lower (lower "sbcl"))))
	344
	345	(define asdf-build-system/ecl
	346	(build-system
	347	(name 'asdf/ecl)
	348	(description "The build system for ASDF binary packages using ECL")
	349	(lower (lower "ecl"))))
	350
	351	(define asdf-build-system/source
	352	(build-system
	353	(name 'asdf/source)
	354	(description "The build system for ASDF source packages")
	355	(lower lower/source)))
	356
	357	(define sbcl-package->cl-source-package
	358	(let* ((property 'cl-source-variant)
	359	(transformer
	360	(package-with-build-system asdf-build-system/sbcl
	361	asdf-build-system/source
	362	"sbcl-"
	363	"cl-"
	364	#:variant-property property
	365	#:phases-transformer
	366	'(const %standard-phases/source))))
	367	(lambda (pkg)
	368	(transformer
	369	(strip-variant-as-necessary property pkg)))))
	370
	371	(define sbcl-package->ecl-package
	372	(let* ((property 'ecl-variant)
	373	(transformer
	374	(package-with-build-system asdf-build-system/sbcl
	375	asdf-build-system/ecl
	376	"sbcl-"
	377	"ecl-"
	378	#:variant-property property
	379	#:phases-transformer
	380	'identity)))
	381	(lambda (pkg)
	382	(transformer
	383	(strip-variant-as-necessary property pkg)))))
	384
	385	;;; asdf.scm ends here