.

zilti/build-system/chicken.scm

@@ -54,46 +54,6 @@ EXTENSION is the file name extension, such as '.tar.gz'."
   (let ((chicken (resolve-interface '(gnu packages chicken))))
     (module-ref chicken 'chicken)))
 
-(define* (lower name
-                #:key source inputs native-inputs outputs system target
-                (chicken (default-chicken))
-                #:allow-other-keys
-                #:rest arguments)
-  "Return a bag for NAME."
-  (define private-keywords
-    '(#:target #:chicken #:inputs #:native-inputs #:outputs))
-
-  ;; TODO: cross-compilation support
-  (and (not target)
-       (bag
-         (name name)
-         (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
-
-                        ;; Keep the standard inputs of 'gnu-build-system', since
-                        ;; Chicken compiles Scheme by using C as an intermediate
-                        ;; language.
-                        ,@(standard-packages)))
-         (build-inputs `(("chicken" ,chicken)
-                         ,@native-inputs))
-         (outputs outputs)
-         (build chicken-build)
-         (arguments
-          (substitute-keyword-arguments
-              (strip-keyword-arguments private-keywords arguments)
-            ((#:extra-directories extra-directories)
-             `(list ,@(append-map
-                       (lambda (name)
-                         (match (assoc name inputs)
-                           ((_ pkg)
-                            (match (package-transitive-propagated-inputs pkg)
-                              (((propagated-names . _) ...)
-                               (cons name propagated-names))))))
-                       extra-directories))))))))
-
 (define* (chicken-build name inputs
                         #:key source
                         (tests? #t)
@@ -114,7 +74,25 @@ EXTENSION is the file name extension, such as '.tar.gz'."
                                    (guix build utils))))
   (define builder
     (with-imported-modules imported-modules
-      #~(use-modules #$@(sexp->gexp modules))))
+      #~(begin
+          (use-modules #$@(sexp->gexp modules))
+          (chicken-build
+           #:name #$name
+           #:source #+source
+           #:system #$system
+           #:phases #$phases
+           #:configure-flags #$configure-flags
+           #:extra-directories #$extra-directories
+           #:parallel-build? #$parallel-build?
+           #:outputs #$(outputs->gexp outputs)
+           #:search-paths '#$(sexp->gexp
+                              (map search-path-specification->sexp
+                                   search-paths))
+           #:egg-name #$egg-name
+           #:unpack-path #$unpack-path
+           #:build-flags #$build-flags
+           #:tests? #$tests?
+           #:inputs #$(input-tuples->gexp inputs)))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))
@@ -122,6 +100,49 @@ EXTENSION is the file name extension, such as '.tar.gz'."
                       #:system system
                       #:guile-for-build guile)))
 
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                (chicken (default-chicken))
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+  (define private-keywords
+    '(#:target #:chicken #:inputs #:native-inputs #:outputs))
+
+  (bag
+    (name name)
+    (system system)
+    (target target)
+    (build-inputs `(,@(if source
+                          `(("source" ,source))
+                          '())
+                    ,@`(("chicken" ,chicken))
+                    ,@native-inputs
+                    ,@(if target '() inputs)
+                    ,@(if target
+                          (standard-cross-packages target 'host)
+                          '())
+                    ,@standard-packages))
+    (host-inputs (if target inputs '()))
+    (target-inputs (if target
+                       (standard-cross-packages target 'target)
+                       '()))
+    (outputs outputs)
+    ;; TODO: Cross-build support
+    (build (if target '() chicken-build))
+    (arguments
+     (substitute-keyword-arguments
+         (strip-keyword-arguments private-keywords arguments)
+       ((#:extra-directories extra-directories)
+        `(list (,@(append-map
+                   (lambda (name)
+                     (match (assoc name inputs)
+                       ((_ pkg)
+                        (match (package-transitive-propagated-inputs pkg)
+                          (((propagated-names . _) ...)
+                           (cons name propagated-names))))))
+                   extra-directories))))))))
+
 (define chicken-build-system
   (build-system
     (name 'chicken)