GNU bug report logs - #32205
[PATCH 0/3] Add 'guile-build-system' and use it

Previous Next

Package: guix-patches;

Reported by: Ludovic Courtès <ludo <at> gnu.org>

Date: Wed, 18 Jul 2018 21:18:01 UTC

Severity: normal

Tags: patch

Done: ludo <at> gnu.org (Ludovic Courtès)

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 32205 in the body.
You can then email your comments to 32205 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#32205; Package guix-patches. (Wed, 18 Jul 2018 21:18:01 GMT) Full text and rfc822 format available.

Acknowledgement sent to Ludovic Courtès <ludo <at> gnu.org>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Wed, 18 Jul 2018 21:18:01 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/3] Add 'guile-build-system' and use it
Date: Wed, 18 Jul 2018 23:17:25 +0200
Hello!

This factorizes code for Scheme-only packages in ‘guile-build-system’.
No more copy/pasting of ‘trivial-build-system’ snippets!

Ludo’.

Ludovic Courtès (3):
  build-system: Add 'guile-build-system'.
  gnu: Switch several packages to 'guile-build-system'.
  gnu: Add guile-pfds.

 Makefile.am                       |   2 +
 doc/guix.texi                     |  15 +
 gnu/packages/guile.scm            | 585 +++++++++---------------------
 guix/build-system/guile.scm       | 202 +++++++++++
 guix/build/guile-build-system.scm | 153 ++++++++
 5 files changed, 544 insertions(+), 413 deletions(-)
 create mode 100644 guix/build-system/guile.scm
 create mode 100644 guix/build/guile-build-system.scm

-- 
2.18.0





Information forwarded to guix-patches <at> gnu.org:
bug#32205; Package guix-patches. (Wed, 18 Jul 2018 21:22:02 GMT) Full text and rfc822 format available.

Message #8 received at 32205 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 32205 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 3/3] gnu: Add guile-pfds.
Date: Wed, 18 Jul 2018 23:20:43 +0200
* gnu/packages/guile.scm (guile-pfds): New variable.
---
 gnu/packages/guile.scm | 72 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)

diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 2dd04917a..f179f293e 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -1974,6 +1974,78 @@ It has a nice, simple s-expression based syntax.")
      "Guile-colorized provides you with a colorized REPL for GNU Guile.")
     (license license:gpl3+)))
 
+(define-public guile-pfds
+  (package
+    (name "guile-pfds")
+    (version "0.3")
+    (home-page "https://github.com/ijp/pfds")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url home-page)
+                    (commit (string-append "v" version))))
+              (sha256
+               (base32
+                "19y33wg94pf0n98dkfqd1zbw93fgky4sawxsxl6s3vyqwl0yi5vh"))
+              (file-name (string-append name "-" version "-checkout"))))
+    (build-system guile-build-system)
+    (arguments
+     '(#:source-directory "src"
+       #:phases (modify-phases %standard-phases
+                  (add-after 'unpack 'move-files-around
+                    (lambda _
+                      ;; Move files under a pfds/ directory to reflect the
+                      ;; module hierarchy.
+                      (mkdir-p "src/pfds")
+                      (for-each (lambda (file)
+                                  (rename-file file
+                                               (string-append "src/pfds/"
+                                                              file)))
+                                '("bbtrees.sls"
+                                  "deques"
+                                  "deques.sls"
+                                  "dlists.sls"
+                                  "fingertrees.sls"
+                                  "hamts.sls"
+                                  "heaps.sls"
+                                  "private"
+                                  "psqs.sls"
+                                  "queues"
+                                  "queues.sls"
+                                  "sequences.sls"
+                                  "sets.sls"))
+
+                      ;; In Guile <= 2.2.4, there's no way to tell 'guild
+                      ;; compile' to accept the ".sls" extension.  So...
+                      (for-each (lambda (file)
+                                  (rename-file file
+                                               (string-append
+                                                (string-drop-right file 4)
+                                                ".scm")))
+                                (find-files "." "\\.sls$"))
+                      #t)))))
+    (native-inputs
+     `(("guile" ,guile-2.2)))
+    (synopsis "Purely functional data structures for Guile")
+    (description
+     "This package provides purely functional data structures written in R6RS
+Scheme and compiled for Guile.  It has been tested with Racket, Guile 2,
+Vicare Scheme and IronScheme.  Right now it contains:
+
+@itemize
+@item queues
+@item deques
+@item bbtrees
+@item sets
+@item dlists
+@item priority search queues (PSQs)
+@item finger trees
+@item sequences
+@item heaps
+@item hash array mapped tries (HAMTs).
+@end itemize\n")
+    (license license:bsd-3)))
+
 (define-public guile-simple-zmq
   (let ((commit "1f3b7c0b9b249c6fde8e8a632b252d8a1b794424")
         (revision "1"))
-- 
2.18.0





Information forwarded to guix-patches <at> gnu.org:
bug#32205; Package guix-patches. (Wed, 18 Jul 2018 21:22:02 GMT) Full text and rfc822 format available.

Message #11 received at 32205 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 32205 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 1/3] build-system: Add 'guile-build-system'.
Date: Wed, 18 Jul 2018 23:20:41 +0200
* guix/build-system/guile.scm, guix/build/guile-build-system.scm: New
files.
* Makefile.am (MODULES): Add them.
* doc/guix.texi (Build Systems): Document 'guile-build-system'.
---
 Makefile.am                       |   2 +
 doc/guix.texi                     |  15 +++
 guix/build-system/guile.scm       | 202 ++++++++++++++++++++++++++++++
 guix/build/guile-build-system.scm | 153 ++++++++++++++++++++++
 4 files changed, 372 insertions(+)
 create mode 100644 guix/build-system/guile.scm
 create mode 100644 guix/build/guile-build-system.scm

diff --git a/Makefile.am b/Makefile.am
index 6733f4f89..b4cd07ed2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -111,6 +111,7 @@ MODULES =					\
   guix/build-system/asdf.scm			\
   guix/build-system/glib-or-gtk.scm		\
   guix/build-system/gnu.scm			\
+  guix/build-system/guile.scm			\
   guix/build-system/haskell.scm			\
   guix/build-system/perl.scm			\
   guix/build-system/python.scm			\
@@ -149,6 +150,7 @@ MODULES =					\
   guix/build/glib-or-gtk-build-system.scm	\
   guix/build/gnu-build-system.scm		\
   guix/build/gnu-dist.scm			\
+  guix/build/guile-build-system.scm		\
   guix/build/perl-build-system.scm		\
   guix/build/python-build-system.scm		\
   guix/build/ocaml-build-system.scm		\
diff --git a/doc/guix.texi b/doc/guix.texi
index 84347d156..f9b3ef0e5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4045,6 +4045,21 @@ specified with the @code{#:glib} parameter.
 Both phases are executed after the @code{install} phase.
 @end defvr
 
+@defvr {Scheme Variable} guile-build-system
+This build system is for Guile packages that consist exclusively of Scheme
+code and that are so lean that they don't even have a makefile, let alone a
+@file{configure} script.  It compiles Scheme code using @command{guild
+compile} (@pxref{Compilation,,, guile, GNU Guile Reference Manual}) and
+installs the @file{.scm} and @file{.go} files in the right place.  It also
+installs documentation.
+
+This build system supports cross-compilation by using the @code{--target}
+option of @command{guild compile}.
+
+Packages built with @code{guile-build-system} must provide a Guile package in
+their @code{native-inputs} field.
+@end defvr
+
 @defvr {Scheme Variable} minify-build-system
 This variable is exported by @code{(guix build-system minify)}.  It
 implements a minification procedure for simple JavaScript packages.
diff --git a/guix/build-system/guile.scm b/guix/build-system/guile.scm
new file mode 100644
index 000000000..77a5f00b0
--- /dev/null
+++ b/guix/build-system/guile.scm
@@ -0,0 +1,202 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo <at> gnu.org>
+;;;
+;;; 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 guile)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
+  #:use-module (guix search-paths)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system gnu)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-26)
+  #:export (%guile-build-system-modules
+            guile-build-system))
+
+(define %guile-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build guile-build-system)
+    ,@%gnu-build-system-modules))
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+
+  ;; Note: There's no #:guile argument (unlike, for instance,
+  ;; 'ocaml-build-system' which has #:ocaml.)  This is so we can keep
+  ;; procedures like 'package-for-guile-2.0' unchanged and simple.
+
+  (define private-keywords
+    '(#:target #:inputs #:native-inputs))
+
+  (bag
+    (name name)
+    (system system) (target target)
+    (host-inputs `(
+                   ,@inputs))
+    (build-inputs `(,@(if source
+                          `(("source" ,source))
+                          '())
+                    ,@native-inputs
+                    ,@(map (cute assoc <> (standard-packages))
+                           '("tar" "gzip" "bzip2" "xz" "locales"))))
+    (outputs outputs)
+    (build (if target guile-cross-build guile-build))
+    (arguments (strip-keyword-arguments private-keywords arguments))))
+
+(define %compile-flags
+  ;; Flags passed to 'guild compile' by default.  We choose a common
+  ;; denominator between Guile 2.0 and 2.2.
+  ''("-Wunbound-variable" "-Warity-mismatch" "-Wformat"))
+
+(define* (guile-build store name inputs
+                      #:key source
+                      (guile #f)
+                      (phases '%standard-phases)
+                      (outputs '("out"))
+                      (search-paths '())
+                      (system (%current-system))
+                      (source-directory ".")
+                      (compile-flags %compile-flags)
+                      (imported-modules %guile-build-system-modules)
+                      (modules '((guix build guile-build-system)
+                                 (guix build utils))))
+  "Build SOURCE using Guile taken from the native inputs, and with INPUTS."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (guile-build #:name ,name
+                    #:source ,(match (assoc-ref inputs "source")
+                                (((? derivation? source))
+                                 (derivation->output-path source))
+                                ((source)
+                                 source)
+                                (source
+                                 source))
+                    #:source-directory ,source-directory
+                    #:compile-flags ,compile-flags
+                    #:phases ,phases
+                    #:system ,system
+                    #: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                                         ; the default
+       (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* (guile-cross-build store name
+                            #:key
+                            (system (%current-system)) target
+                            native-drvs target-drvs
+                            (guile #f)
+                            source
+                            (outputs '("out"))
+                            (search-paths '())
+                            (native-search-paths '())
+
+                            (phases '%standard-phases)
+                            (source-directory ".")
+                            (compile-flags %compile-flags)
+                            (imported-modules %guile-build-system-modules)
+                            (modules '((guix build guile-build-system)
+                                       (guix build utils))))
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+
+       (let ()
+         (define %build-host-inputs
+           ',(map (match-lambda
+                    ((name (? derivation? drv) sub ...)
+                     `(,name . ,(apply derivation->output-path drv sub)))
+                    ((name path)
+                     `(,name . ,path)))
+                  native-drvs))
+
+         (define %build-target-inputs
+           ',(map (match-lambda
+                    ((name (? derivation? drv) sub ...)
+                     `(,name . ,(apply derivation->output-path drv sub)))
+                    ((name (? package? pkg) sub ...)
+                     (let ((drv (package-cross-derivation store pkg
+                                                          target system)))
+                       `(,name . ,(apply derivation->output-path drv sub))))
+                    ((name path)
+                     `(,name . ,path)))
+                  target-drvs))
+
+         (guile-build #:source ,(match (assoc-ref native-drvs "source")
+                                  (((? derivation? source))
+                                   (derivation->output-path source))
+                                  ((source)
+                                   source)
+                                  (source
+                                   source))
+                      #:system ,system
+                      #:target ,target
+                      #:outputs %outputs
+                      #:source-directory ,source-directory
+                      #:compile-flags ,compile-flags
+                      #:inputs %build-target-inputs
+                      #:native-inputs %build-host-inputs
+                      #:search-paths ',(map search-path-specification->sexp
+                                            search-paths)
+                      #:native-search-paths ',(map
+                                               search-path-specification->sexp
+                                               native-search-paths)
+                      #:phases ,phases))))
+
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system #:graft? #f))
+      (#f                                         ; the default
+       (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
+                                #:system system
+                                #:inputs (append native-drvs target-drvs)
+                                #:outputs outputs
+                                #:modules imported-modules
+                                #:substitutable? substitutable?
+                                #:guile-for-build guile-for-build))
+
+(define guile-build-system
+  (build-system
+    (name 'guile)
+    (description "The build system for simple Guile packages")
+    (lower lower)))
diff --git a/guix/build/guile-build-system.scm b/guix/build/guile-build-system.scm
new file mode 100644
index 000000000..0bed04943
--- /dev/null
+++ b/guix/build/guile-build-system.scm
@@ -0,0 +1,153 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo <at> gnu.org>
+;;;
+;;; 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 guile-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (guix build utils)
+  #:export (target-guile-effective-version
+            %standard-phases
+            guile-build))
+
+(define* (target-guile-effective-version #:optional guile)
+  "Return the effective version of GUILE or whichever 'guile' is in $PATH.
+Return #false if it cannot be determined."
+  (let* ((pipe (open-pipe* OPEN_READ
+                           (if guile
+                               (string-append guile "/bin/guile")
+                               "guile")
+                           "-c" "(display (effective-version))"))
+         (line (read-line pipe)))
+    (and (zero? (close-pipe pipe))
+         (string? line)
+         line)))
+
+(define (file-sans-extension file)                ;TODO: factorize
+  "Return the substring of FILE without its extension, if any."
+  (let ((dot (string-rindex file #\.)))
+    (if dot
+        (substring file 0 dot)
+        file)))
+
+(define %scheme-file-regexp
+  ;; Regexp to match Scheme files.
+  "\\.(scm|sls)$")
+
+(define %documentation-file-regexp
+  ;; Regexp to match README files and the likes.
+  "^(README.*|.*\\.html|.*\\.org|.*\\.md)$")
+
+(define* (set-locale-path #:key inputs native-inputs
+                          #:allow-other-keys)
+  "Set 'GUIX_LOCPATH'."
+  (match (assoc-ref (or native-inputs inputs) "locales")
+    (#f #t)
+    (locales
+     (setenv "GUIX_LOCPATH" (string-append locales "/lib/locale"))
+     #t)))
+
+(define* (build #:key outputs inputs native-inputs
+                (source-directory ".")
+                (compile-flags '())
+                (scheme-file-regexp %scheme-file-regexp)
+                target
+                #:allow-other-keys)
+  "Build files in SOURCE-DIRECTORY that match SCHEME-FILE-REGEXP."
+  (let* ((out        (assoc-ref outputs "out"))
+         (guile      (assoc-ref (or native-inputs inputs) "guile"))
+         (effective  (target-guile-effective-version guile))
+         (module-dir (string-append out "/share/guile/site/"
+                                    effective))
+         (go-dir     (string-append out "/lib/guile/"
+                                    effective "/site-ccache/"))
+         (guild      (string-append guile "/bin/guild"))
+         (flags      (if target
+                         (cons (string-append "--target=" target)
+                               compile-flags)
+                         compile-flags)))
+    (if target
+        (format #t "Cross-compiling for '~a' with Guile ~a...~%"
+                target effective)
+        (format #t "Compiling with Guile ~a...~%" effective))
+    (format #t "compile flags: ~s~%" flags)
+
+    ;; Make installation directories.
+    (mkdir-p module-dir)
+    (mkdir-p go-dir)
+
+    ;; Compile .scm files and install.
+    (setenv "GUILE_AUTO_COMPILE" "0")
+    (setenv "GUILE_LOAD_COMPILED_PATH"
+            (string-append go-dir
+                           (match (getenv "GUILE_LOAD_COMPILED_PATH")
+                             (#f "")
+                             (path (string-append ":" path)))))
+    (for-each (lambda (file)
+                (let* ((go (string-append go-dir
+                                          (file-sans-extension file)
+                                          ".go")))
+                  ;; Install source module.
+                  (install-file (string-append source-directory "/" file)
+                                (string-append module-dir
+                                               "/" (dirname file)))
+
+                  ;; Install and compile module.
+                  (apply invoke guild "compile" "-L" source-directory
+                         "-o" go
+                         (string-append source-directory "/" file)
+                         flags)))
+
+              ;; Arrange to strip SOURCE-DIRECTORY from file names.
+              (with-directory-excursion source-directory
+                (find-files "." scheme-file-regexp)))
+    #t))
+
+(define* (install-documentation #:key outputs
+                                (documentation-file-regexp
+                                 %documentation-file-regexp)
+                                #:allow-other-keys)
+  "Install files that mactch DOCUMENTATION-FILE-REGEXP."
+  (let* ((out (assoc-ref outputs "out"))
+         (doc (string-append out "/share/doc/"
+                             (strip-store-file-name out))))
+    (for-each (cut install-file <> doc)
+              (find-files "." documentation-file-regexp))
+    #t))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (delete 'bootstrap)
+    (delete 'configure)
+    (add-before 'install-locale 'set-locale-path
+      set-locale-path)
+    (replace 'build build)
+    (add-after 'build 'install-documentation
+      install-documentation)
+    (delete 'check)
+    (delete 'strip)
+    (delete 'validate-runpath)
+    (delete 'install)))
+
+(define* (guile-build #:key (phases %standard-phases)
+                      #:allow-other-keys #:rest args)
+  "Build the given Guile package, applying all of PHASES in order."
+  (apply gnu:gnu-build #:phases phases args))
-- 
2.18.0





Information forwarded to guix-patches <at> gnu.org:
bug#32205; Package guix-patches. (Wed, 18 Jul 2018 21:22:03 GMT) Full text and rfc822 format available.

Message #14 received at 32205 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 32205 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 2/3] gnu: Switch several packages to 'guile-build-system'.
Date: Wed, 18 Jul 2018 23:20:42 +0200
* gnu/packages/guile.scm (guile-minikanren)[build-system]: Set to
GUILE-BUILD-SYSTEM.
[arguments]: Remove.
[inputs]: Rename to 'native-inputs'.
(guile-miniadapton): Likewise.
(guile-colorized): Likewise.
(guile-irregex): Likewise, but rewrite 'arguments' field with custom
phases.
(guile-gdbm-ffi): Likewise, and move patch to the 'origin' form.
(guile-simple-zmq): Likewise, and change 'propagated-inputs' to
'inputs'.
(jupyter-guile-kernel): Likewise.
---
 gnu/packages/guile.scm | 513 ++++++++---------------------------------
 1 file changed, 100 insertions(+), 413 deletions(-)

diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 62d292264..2dd04917a 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -74,6 +74,7 @@
   #:use-module (guix download)
   #:use-module (guix git-download)
   #:use-module (guix build-system gnu)
+  #:use-module (guix build-system guile)
   #:use-module (guix build-system trivial)
   #:use-module (guix utils)
   #:use-module (ice-9 match)
@@ -965,60 +966,8 @@ specification.  These are the main features:
               (sha256
                (base32
                 "0r50jlpzi940jlmxyy3ddqqwmj5r12gb4bcv0ssini9v8km13xz6"))))
-    (build-system trivial-build-system)
-    (arguments
-     `(#:modules ((guix build utils))
-       #:builder
-       (begin
-         (use-modules (guix build utils)
-                      (ice-9 match)
-                      (ice-9 popen)
-                      (ice-9 rdelim))
-
-         (let* ((out (assoc-ref %outputs "out"))
-                (guile (assoc-ref %build-inputs "guile"))
-                (effective (read-line
-                            (open-pipe* OPEN_READ
-                                        (string-append guile "/bin/guile")
-                                        "-c" "(display (effective-version))")))
-                (module-dir (string-append out "/share/guile/site/"
-                                           effective))
-                (source (assoc-ref %build-inputs "source"))
-                (doc (string-append out "/share/doc/guile-minikanren"))
-                (scm-files '("minikanren.scm"
-                             "minikanren/mkextraforms.scm"
-                             "minikanren/mkprelude.scm"
-                             "minikanren/mk.scm"))
-                (guild (string-append (assoc-ref %build-inputs "guile")
-                                      "/bin/guild")))
-           ;; Make installation directories.
-           (mkdir-p (string-append module-dir "/minikanren"))
-           (mkdir-p doc)
-
-           ;; Compile .scm files and install.
-           (chdir source)
-           (setenv "GUILE_AUTO_COMPILE" "0")
-           (for-each (lambda (file)
-                       (let* ((dest-file (string-append module-dir "/"
-                                                        file))
-                              (go-file (match (string-split file #\.)
-                                         ((base _)
-                                          (string-append module-dir "/"
-                                                         base ".go")))))
-                         ;; Install source module.
-                         (copy-file file dest-file)
-                         ;; Install compiled module.
-                         (invoke guild "compile"
-                                 "-L" source
-                                 "-o" go-file
-                                 file)))
-                     scm-files)
-
-           ;; Also copy over the README.
-           (install-file "README.org" doc)
-
-           #t))))
-    (inputs
+    (build-system guile-build-system)
+    (native-inputs
      `(("guile" ,guile-2.2)))
     (home-page "https://github.com/ijp/minikanren")
     (synopsis "MiniKanren declarative logic system, packaged for Guile")
@@ -1055,46 +1004,8 @@ See http://minikanren.org/ for more on miniKanren generally.")
                 (sha256
                  (base32
                   "09q51zkw2fypad5xixskfzw2cjhjgs5cswdp3i7cpp651rb3zndh"))))
-      (build-system gnu-build-system)
-      (arguments
-       `(#:modules ((guix build utils)
-                    (ice-9 popen)
-                    (ice-9 rdelim)
-                    (srfi srfi-1)
-                    (guix build gnu-build-system))
-         #:tests? #f                    ; there is no test target
-         #:phases
-         (modify-phases %standard-phases
-           (delete 'configure)
-           (delete 'build)
-           (replace 'install
-             (lambda* (#:key outputs #:allow-other-keys)
-               (let* ((cwd        (getcwd))
-                      (scm-files  (find-files "." "\\.scm$"))
-                      (effective  (read-line
-                                   (open-pipe* OPEN_READ
-                                               "guile" "-c"
-                                               "(display (effective-version))")))
-                      (module-dir (string-append (assoc-ref outputs "out")
-                                                 "/share/guile/site/"
-                                                 effective)))
-
-                 ;; Make installation directories.
-                 (mkdir-p module-dir)
-
-                 (setenv "GUILE_AUTO_COMPILE" "0")
-
-                 ;; Compile .scm files and install.
-                 (every (lambda (file)
-                          (let ((go-file (string-append module-dir "/"
-                                                        (basename file ".scm") ".go")))
-                            ;; Install source module.
-                            (install-file file module-dir)
-                            ;; Compile and install module.
-                            (zero? (system* "guild" "compile" "-L" cwd
-                                            "-o" go-file file))))
-                        scm-files)))))))
-      (inputs
+      (build-system guile-build-system)
+      (native-inputs
        `(("guile" ,guile-2.2)))
       (home-page "https://github.com/fisherdj/miniAdapton")
       (synopsis "Minimal implementation of incremental computation in Guile
@@ -1120,65 +1031,25 @@ understand, extend, and port to host languages other than Scheme.")
               (sha256
                (base32
                 "1ia3m7dp3lcxa048q0gqbiwwsyvn99baw6xkhb4bhhzn4k7bwyqq"))))
-    (build-system gnu-build-system)
+    (build-system guile-build-system)
     (arguments
-     `(#:modules ((guix build utils)
-                  (ice-9 match)
-                  (ice-9 rdelim)
-                  (ice-9 popen)
-                  (guix build gnu-build-system))
-       #:phases
-       (modify-phases %standard-phases
-         (delete 'configure)
-         (delete 'build)
-         (delete 'check)
-         (replace 'install
-           (lambda* (#:key inputs outputs #:allow-other-keys)
-             (let* ((out (assoc-ref outputs "out"))
-                    (effective (read-line
-                                (open-pipe* OPEN_READ
-                                            "guile" "-c"
-                                            "(display (effective-version))")))
-                    (module-dir (string-append out "/share/guile/site/"
-                                               effective))
-                    (source (assoc-ref inputs "source"))
-                    (doc (string-append out "/share/doc/guile-irregex/"))
-                    (guild (string-append (assoc-ref %build-inputs "guile")
-                                          "/bin/guild")))
-               ;; Make installation directories.
-               (mkdir-p (string-append module-dir "/rx/source"))
-               (mkdir-p doc)
-
-               ;; Compile .scm files and install.
-               (setenv "GUILE_AUTO_COMPILE" "0")
-
-               (for-each (lambda (copy-info)
-                           (match copy-info
-                             ((src-file dest-file-basis)
-                              (let* ((dest-file (string-append
-                                                 module-dir dest-file-basis
-                                                 ".scm"))
-                                     (go-file (string-append
-                                               module-dir dest-file-basis
-                                               ".go")))
-                                ;; Install source module.
-                                (copy-file src-file
-                                           dest-file)
-                                ;; Install compiled module.
-                                (invoke guild "compile"
-                                        "-L" (getcwd)
-                                        "-o" go-file
-                                        src-file)))))
-                         '(("irregex-guile.scm" "/rx/irregex")
-                           ("irregex.scm" "/rx/source/irregex")
-                           ;; Not really reachable via guile's packaging system,
-                           ;; but nice to have around
-                           ("irregex-utils.scm" "/rx/source/irregex-utils")))
-
-               ;; Also copy over the README.
-               (install-file "irregex.html" doc)
-               #t))))))
-    (inputs
+     '(#:phases (modify-phases %standard-phases
+                  (add-after 'unpack 'move-files-around
+                    (lambda _
+                      ;; Move the relevant source files to src/ and create the
+                      ;; rx/ directory to match the expected module hierarchy.
+                      (mkdir-p "src/rx/source")
+                      (rename-file "irregex-guile.scm"
+                                   "src/rx/irregex.scm")
+                      (rename-file "irregex.scm"
+                                   "src/rx/source/irregex.scm")
+                      ;; Not really reachable via guile's packaging system,
+                      ;; but nice to have around.
+                      (rename-file "irregex-utils.scm"
+                                   "src/rx/source/irregex-utils.scm")
+                      #t)))
+       #:source-directory "src"))
+    (native-inputs
      `(("guile" ,guile-2.2)))
     (home-page "http://synthcode.com/scheme/irregex")
     (synopsis "S-expression based regular expressions")
@@ -1207,83 +1078,35 @@ inspired by the SCSH regular expression system.")
                     (url "https://github.com/ijp/guile-gdbm.git")
                     (commit "fa1d5b6231d0e4d096687b378c025f2148c5f246")))
               (file-name (string-append name "-" version "-checkout"))
+              (patches (search-patches
+                        "guile-gdbm-ffi-support-gdbm-1.14.patch"))
               (sha256
                (base32
                 "1j8wrsw7v9w6qkl47xz0rdikg50v16nn6kbs3lgzcymjzpa7babj"))))
-    (build-system trivial-build-system)
+    (build-system guile-build-system)
+    (arguments
+     '(#:phases (modify-phases %standard-phases
+                  (add-after 'unpack 'move-examples
+                    (lambda* (#:key outputs #:allow-other-keys)
+                      ;; Move examples where they belong.
+                      (let* ((out (assoc-ref outputs "out"))
+                             (doc (string-append out "/share/doc/"
+                                                 (strip-store-file-name out)
+                                                 "/examples")))
+                        (copy-recursively "examples" doc)
+                        (delete-file-recursively "examples")
+                        #t)))
+                  (add-after 'unpack 'set-libgdbm-file-name
+                    (lambda* (#:key inputs #:allow-other-keys)
+                      (substitute* "gdbm.scm"
+                        (("\\(dynamic-link \"libgdbm\"\\)")
+                         (format #f "(dynamic-link \"~a/lib/libgdbm.so\")"
+                                 (assoc-ref inputs "gdbm"))))
+                      #t)))))
+    (native-inputs
+     `(("guile" ,guile-2.2)))
     (inputs
-     `(("guile" ,guile-2.2)
-       ;; patch-and-repack doesn't work for git checkouts,
-       ;; so we must apply the patch manually.
-       ("patch" ,patch)
-       ("patch-file" ,(search-patch
-                       "guile-gdbm-ffi-support-gdbm-1.14.patch"))))
-    (propagated-inputs
      `(("gdbm" ,gdbm)))
-    (arguments
-     `(#:modules
-       ((guix build utils))
-       #:builder
-       (begin
-         (use-modules (guix build utils)
-                      (ice-9 rdelim)
-                      (ice-9 popen))
-
-         ;; Avoid warnings we can safely ignore
-         (setenv "GUILE_AUTO_COMPILE" "0")
-
-         (let* ((out (assoc-ref %outputs "out"))
-                (effective-version
-                 (read-line
-                  (open-pipe* OPEN_READ
-                              (string-append
-                               (assoc-ref %build-inputs "guile")
-                               "/bin/guile")
-                              "-c" "(display (effective-version))")))
-                (module-dir (string-append out "/share/guile/site/"
-                                           effective-version))
-                (source (assoc-ref %build-inputs "source"))
-                (doc (string-append out "/share/doc"))
-                (guild (string-append (assoc-ref %build-inputs "guile")
-                                      "/bin/guild"))
-                (gdbm.scm-dest
-                 (string-append module-dir "/gdbm.scm"))
-                (gdbm.go-dest
-                 (string-append module-dir "/gdbm.go"))
-                (compile-file
-                 (lambda (in-file out-file)
-                   (invoke guild "compile" "-o" out-file in-file))))
-           ;; Switch directory for compiling and installing
-           (chdir source)
-
-           ;; Install the documentation.
-           (install-file "README.md" doc)
-           (copy-recursively "examples" (string-append doc "/examples"))
-
-           ;; Make installation directories.
-           (mkdir-p module-dir)
-
-           ;; copy the source
-           (copy-file "gdbm.scm" gdbm.scm-dest)
-
-           ;; Patch the FFI
-           (substitute* gdbm.scm-dest
-             (("\\(dynamic-link \"libgdbm\"\\)")
-              (format #f "(dynamic-link \"~a/lib/libgdbm.so\")"
-                      (assoc-ref %build-inputs "gdbm"))))
-
-           ;; Apply the patch to add support for gdbm-1.14.
-           (let ((patch-command (string-append (assoc-ref %build-inputs "patch")
-                                               "/bin/patch"))
-                 (patch-file (assoc-ref %build-inputs "patch-file")))
-             (with-directory-excursion (dirname gdbm.scm-dest)
-               (format #t "applying '~a'...~%" patch-file)
-               (invoke patch-command "--force" "--input" patch-file)))
-
-           ;; compile to the destination
-           (compile-file gdbm.scm-dest gdbm.go-dest)
-
-           #t))))
     (home-page "https://github.com/ijp/guile-gdbm")
     (synopsis "Guile bindings to the GDBM library via Guile's FFI")
     (description
@@ -2142,32 +1965,8 @@ It has a nice, simple s-expression based syntax.")
               (sha256
                (base32
                 "16xhc3an6aglnca8xl3mvgi8hsqzqn68vsl5ga4bz8bvbap5fn4p"))))
-    (build-system gnu-build-system)
-    (arguments
-     `(#:modules ((system base compile)
-                  ,@%gnu-build-system-modules)
-       #:tests? #f ;No tests included
-       #:phases
-       (modify-phases %standard-phases
-         (delete 'configure) ;No configure script
-         (replace 'install
-           (lambda* (#:key outputs inputs #:allow-other-keys)
-             (let* ((out (assoc-ref outputs "out"))
-                    (module-dir (string-append out "/share/guile/site/2.2"))
-                    (language-dir (string-append module-dir "/ice-9"))
-                    (guild (string-append (assoc-ref inputs "guile")
-                                          "/bin/guild")))
-               ;; The original 'make install' is too primitive.
-
-               ;; copy the source
-               (install-file "ice-9/colorized.scm" language-dir)
-
-               ;; compile to the destination
-               (compile-file "ice-9/colorized.scm"
-                             #:output-file (string-append
-                                            language-dir "/colorized.go"))
-               #t))))))
-    (inputs
+    (build-system guile-build-system)
+    (native-inputs
      `(("guile" ,guile-2.2)))
     (home-page "https://github.com/NalaGinrut/guile-colorized")
     (synopsis "Colorized REPL for Guile")
@@ -2191,72 +1990,20 @@ It has a nice, simple s-expression based syntax.")
           (base32
            "0nj2pd5bsmmgd3c54wh4sixfhmsv1arsq7yam2d7487h3n9q57r7"))
          (file-name (git-file-name name version))))
-      (build-system trivial-build-system)
+      (build-system guile-build-system)
       (arguments
-       `(#:modules ((guix build utils))
-         #:builder
-         (begin
-           (use-modules (guix build utils)
-                        (srfi srfi-26)
-                        (ice-9 match)
-                        (ice-9 popen)
-                        (ice-9 rdelim))
-
-           (let* ((out (assoc-ref %outputs "out"))
-                  (guile (assoc-ref %build-inputs "guile"))
-                  (effective (read-line
-                              (open-pipe* OPEN_READ
-                                          (string-append guile "/bin/guile")
-                                          "-c" "(display (effective-version))")))
-                  (module-dir (string-append out "/share/guile/site/"
-                                             effective))
-                  (go-dir     (string-append out "/lib/guile/"
-                                             effective "/site-ccache/"))
-                  (source     (string-append (assoc-ref %build-inputs "source")
-                                             "/src"))
-                  (scm-file "simple-zmq.scm")
-                  (guild (string-append (assoc-ref %build-inputs "guile")
-                                        "/bin/guild"))
-                  (zmq  (assoc-ref %build-inputs "zeromq"))
-                  (deps (list zmq))
-                  (path (string-join
-                         (map (cut string-append <>
-                                   "/lib/")
-                              deps)
-                         ":")))
-             ;; Make installation directories.
-             (mkdir-p module-dir)
-             (mkdir-p go-dir)
-
-             ;; Compile .scm files and install.
-             (chdir source)
-             (setenv "GUILE_AUTO_COMPILE" "0")
-             (for-each (lambda (file)
-                         (let* ((dest-file (string-append module-dir "/"
-                                                          file))
-                                (go-file (match (string-split file #\.)
-                                           ((base _)
-                                            (string-append go-dir "/"
-                                                           base ".go")))))
-                           ;; Install source module.
-                           (copy-file file dest-file)
-                           (substitute* dest-file
-                             (("\\(dynamic-link \"libzmq\"\\)")
-                              (format #f "(dynamic-link \"~a/lib/libzmq.so\")"
-                                      (assoc-ref %build-inputs "zeromq"))))
-
-                           ;; Install and compile module.
-                           (unless (zero? (system* guild "compile"
-                                                   "-L" source
-                                                   "-o" go-file
-                                                   dest-file))
-                             (error (format #f "Failed to compile ~s to ~s!"
-                                            file go-file)))))
-                       (list scm-file))
-             #t))))
-      (inputs
+       `(#:source-directory "src"
+         #:phases (modify-phases %standard-phases
+                    (add-after 'unpack 'set-libzmq-file-name
+                      (lambda* (#:key inputs #:allow-other-keys)
+                        (substitute* "src/simple-zmq.scm"
+                          (("\\(dynamic-link \"libzmq\"\\)")
+                           (format #f "(dynamic-link \"~a/lib/libzmq.so\")"
+                                   (assoc-ref inputs "zeromq"))))
+                        #t)))))
+      (native-inputs
        `(("guile" ,guile-2.2)))
-      (propagated-inputs
+      (inputs
        `(("zeromq" ,zeromq)))
       (home-page "https://github.com/jerry40/guile-simple-zmq")
       (synopsis "Guile wrapper over ZeroMQ library")
@@ -2280,106 +2027,46 @@ messaging library.")
          (sha256
           (base32
            "0y5jr0f0dyskvsawqbf6n0bpg8jirw4mhqbarf2a6p9lxhqha9s9"))))
-      (build-system trivial-build-system)
+      (build-system guile-build-system)
       (arguments
-       `(#:modules ((guix build utils))
-         #:builder
-         (begin
-           (use-modules (guix build utils)
-                        (srfi srfi-26)
-                        (ice-9 match)
-                        (ice-9 popen)
-                        (ice-9 rdelim))
-
-           (let* ((out (assoc-ref %outputs "out"))
-                  (guile (assoc-ref %build-inputs "guile"))
-                  (effective (read-line
-                              (open-pipe* OPEN_READ
-                                          (string-append guile "/bin/guile")
-                                          "-c" "(display (effective-version))")))
-                  (module-dir (string-append out "/share/guile/site/"
-                                             effective))
-                  (kernel-dir (string-append out "/share/jupyter/kernels/guile"))
-                  (go-dir     (string-append out "/lib/guile/"
-                                             effective
-                                             "/site-ccache"))
-                  (source     (string-append (assoc-ref %build-inputs "source")
-                                             "/src"))
-                  (scm-files '("hmac.scm"
-                               "tools.scm"
-                               "guile-jupyter-kernel.scm"))
-                  (kernel-file "kernel.json")
-                  (guild  (string-append (assoc-ref %build-inputs "guile")
-                                         "/bin/guild"))
-                  (g-szmq (assoc-ref %build-inputs "guile-simple-zmq"))
-                  (json   (assoc-ref %build-inputs "guile-json"))
-                  (deps   (list g-szmq json))
-                  (path   (string-join
-                           (map (cut string-append <>
-                                     "/share/guile/site/"
-                                     effective)
-                                deps)
-                           ":"))
-                  (gopath (string-join
-                           (map (cut string-append <>
-                                     "/lib/guile/" effective
-                                     "/site-ccache/")
-                                deps)
-                           ":")))
-
-             ;; Make installation directories.
-             (mkdir-p module-dir)
-             (mkdir-p kernel-dir)
-             (mkdir-p go-dir)
-
-             ;; Make a writable copy of SOURCE.
-             (copy-recursively source ".")
-
-             ;; Record the absolute file name of the 'openssl' command.
-             (substitute* "hmac.scm"
-               (("openssl")
-                (string-append (assoc-ref %build-inputs "openssl")
-                               "/bin/openssl")))
-
-             ;; Compile .scm files and install.
-             (setenv "GUILE_AUTO_COMPILE" "0")
-             (setenv "GUILE_LOAD_PATH" path)
-             (setenv "GUILE_LOAD_COMPILED_PATH" gopath)
-
-             (for-each (lambda (file)
-                         (let* ((dest-file (string-append module-dir "/"
-                                                          file))
-                                (go-file (match (string-split file #\.)
-                                           ((base _)
-                                            (string-append go-dir "/"
-                                                           base ".go")))))
-                           ;; Install source module.
-                           (copy-file file dest-file)
-
-                           ;; Install compiled module.
-                           (unless (zero? (system* guild "compile"
-                                                   "-L" source
-                                                   "-o" go-file
-                                                   file))
-                             (error (format #f "Failed to compile ~s to ~s!"
-                                            file go-file)))))
-                       scm-files)
-
-             ;; Install kernel
-             (copy-file kernel-file (string-append kernel-dir "/"
-                                                   kernel-file))
-             ;; Fix hard-coded file name in the kernel
-             (substitute* (string-append kernel-dir "/"
-                                         kernel-file)
-               (("/home/jerry/.local/share/jupyter/kernels/guile/guile-jupyter-kernel.scm")
-                (string-append module-dir "/guile-jupyter-kernel.scm"))
-               (("\"guile\"")
-                (string-append "\"" (assoc-ref %build-inputs "guile")
-                               "/bin/guile\""))
-               (("-s")
-                (string-append "--no-auto-compile\", \"-s")))
-
-             #t))))
+       '(#:phases (modify-phases %standard-phases
+                    (add-after 'unpack 'set-openssl-file-name
+                      (lambda* (#:key inputs #:allow-other-keys)
+                        ;; Record the absolute file name of the 'openssl'
+                        ;; command.
+                        (substitute* "src/hmac.scm"
+                          (("openssl")
+                           (string-append (assoc-ref inputs "openssl")
+                                          "/bin/openssl")))
+                        #t))
+
+                    ;; XXX: The code uses 'include' to include its own source
+                    ;; files, and "-L src" isn't enough in this case.
+                    (add-before 'build 'chdir
+                      (lambda _ (chdir "src") #t))
+                    (add-after 'build 'chdir-back
+                      (lambda _ (chdir "..") #t))
+
+                    (add-after 'install 'install-kernel
+                      (lambda* (#:key inputs outputs #:allow-other-keys)
+                        (let* ((out (assoc-ref outputs "out"))
+                               (dir (string-append
+                                     out "/share/jupyter/kernels/guile")))
+                          ;; Install kernel.
+                          (install-file "src/kernel.json" dir)
+
+                          ;; Fix hard-coded file name in the kernel.
+                          (substitute* (string-append dir "/kernel.json")
+                            (("/home/.*/guile-jupyter-kernel.scm")
+                             (string-append out "/share/guile/site/"
+                                            (target-guile-effective-version)
+                                            "/guile-jupyter-kernel.scm"))
+                            (("\"guile\"")
+                             (string-append "\"" (assoc-ref inputs "guile")
+                                            "/bin/guile\""))
+                            (("-s")
+                             (string-append "--no-auto-compile\", \"-s")))
+                          #t))))))
       (inputs
        `(("openssl" ,openssl)
          ("guile" ,guile-2.2)))
-- 
2.18.0





Reply sent to ludo <at> gnu.org (Ludovic Courtès):
You have taken responsibility. (Mon, 23 Jul 2018 10:27:01 GMT) Full text and rfc822 format available.

Notification sent to Ludovic Courtès <ludo <at> gnu.org>:
bug acknowledged by developer. (Mon, 23 Jul 2018 10:27:01 GMT) Full text and rfc822 format available.

Message #19 received at 32205-done <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: 32205-done <at> debbugs.gnu.org
Subject: Re: [bug#32205] [PATCH 0/3] Add 'guile-build-system' and use it
Date: Mon, 23 Jul 2018 12:26:23 +0200
Ludovic Courtès <ludo <at> gnu.org> skribis:

> Ludovic Courtès (3):
>   build-system: Add 'guile-build-system'.
>   gnu: Switch several packages to 'guile-build-system'.
>   gnu: Add guile-pfds.

Pushed!

Ludo’.




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Mon, 20 Aug 2018 11:24:05 GMT) Full text and rfc822 format available.

This bug report was last modified 6 years and 356 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.