Commit | Line | Data |
---|---|---|
64f032d7 | 1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2020 raingloom <raingloom@riseup.net> | |
7d873f19 | 3 | ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> |
64f032d7 | 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 chicken) | |
21 | #:use-module (guix utils) | |
7d873f19 LC |
22 | #:use-module (guix gexp) |
23 | #:use-module (guix store) | |
24 | #:use-module (guix monads) | |
64f032d7 | 25 | #:use-module (guix search-paths) |
26 | #:use-module (guix build-system) | |
27 | #:use-module (guix build-system gnu) | |
28 | #:use-module (guix packages) | |
29 | #:use-module (ice-9 match) | |
30 | #:export (%chicken-build-system-modules | |
31 | chicken-build | |
32 | chicken-build-system)) | |
33 | ||
34 | (define %chicken-build-system-modules | |
35 | ;; Build-side modules imported and used by default. | |
36 | `((guix build chicken-build-system) | |
37 | (guix build union) | |
38 | ,@%gnu-build-system-modules)) | |
39 | ||
40 | (define (default-chicken) | |
41 | ;; Lazily resolve the binding to avoid a circular dependency. | |
42 | ;; TODO is this actually needed in every build system? | |
43 | (let ((chicken (resolve-interface '(gnu packages chicken)))) | |
44 | (module-ref chicken 'chicken))) | |
45 | ||
46 | (define* (lower name | |
47 | #:key source inputs native-inputs outputs system target | |
48 | (chicken (default-chicken)) | |
49 | #:allow-other-keys | |
50 | #:rest arguments) | |
51 | "Return a bag for NAME." | |
52 | (define private-keywords | |
7d873f19 | 53 | '(#:target #:chicken #:inputs #:native-inputs)) |
64f032d7 | 54 | |
55 | ;; TODO: cross-compilation support | |
56 | (and (not target) | |
57 | (bag | |
58 | (name name) | |
59 | (system system) | |
60 | (host-inputs `(,@(if source | |
61 | `(("source" ,source)) | |
62 | '()) | |
63 | ,@inputs | |
64 | ||
65 | ;; Keep the standard inputs of 'gnu-build-system', since | |
66 | ;; Chicken compiles Scheme by using C as an intermediate | |
67 | ;; language. | |
68 | ,@(standard-packages))) | |
69 | (build-inputs `(("chicken" ,chicken) | |
70 | ,@native-inputs)) | |
71 | (outputs outputs) | |
72 | (build chicken-build) | |
73 | (arguments (strip-keyword-arguments private-keywords arguments))))) | |
74 | ||
7d873f19 LC |
75 | (define* (chicken-build name inputs |
76 | #:key | |
77 | source | |
78 | (phases '(@ (guix build chicken-build-system) | |
79 | %standard-phases)) | |
80 | (outputs '("out")) | |
81 | (search-paths '()) | |
82 | (egg-name "") | |
83 | (unpack-path "") | |
84 | (build-flags ''()) | |
85 | (tests? #t) | |
86 | (system (%current-system)) | |
87 | (guile #f) | |
88 | (imported-modules %chicken-build-system-modules) | |
89 | (modules '((guix build chicken-build-system) | |
90 | (guix build union) | |
91 | (guix build utils)))) | |
64f032d7 | 92 | (define builder |
7d873f19 LC |
93 | (with-imported-modules imported-modules |
94 | #~(begin | |
95 | (use-modules #$@modules) | |
96 | (chicken-build #:name #$name | |
97 | #:source #+source | |
98 | #:system #$system | |
99 | #:phases #$phases | |
100 | #:outputs #$(outputs->gexp outputs) | |
101 | #:search-paths '#$(map search-path-specification->sexp | |
102 | search-paths) | |
103 | #:egg-name #$egg-name | |
104 | #:unpack-path #$unpack-path | |
105 | #:build-flags #$build-flags | |
106 | #:tests? #$tests? | |
107 | #:inputs #$(input-tuples->gexp inputs))))) | |
64f032d7 | 108 | |
7d873f19 LC |
109 | (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) |
110 | system #:graft? #f))) | |
111 | (gexp->derivation name builder | |
112 | #:system system | |
113 | #:guile-for-build guile))) | |
64f032d7 | 114 | |
115 | (define chicken-build-system | |
116 | (build-system | |
117 | (name 'chicken) | |
118 | (description | |
119 | "Build system for Chicken Scheme programs") | |
120 | (lower lower))) |