Re: [PATCH 3/5] build: Add 'emacs-build-system'

[Federico Beffa <beffa@ieee.org>]

[-- Attachment #1: Type: text/plain, Size: 4115 bytes --]

Thanks for the review!

I've done the suggested modifications apart from the comments below.

On Thu, Jun 25, 2015 at 2:33 PM, Ludovic Courtès <ludo@gnu.org> wrote:
> Federico Beffa <beffa@ieee.org> skribis:
>> +(define-syntax lambda*-with-emacs-env
>> +  (lambda (x)
>> +    "Creates a 'lambda*' expression where the following variables are bound to
>> +the values expected by the 'emacs-build-system': 'emacs', 'out', 'name-ver',
>> +'name', 'elpa-name-ver', 'elpa-name', 'info-dir', 'el-dir'.  The first
>> +parameter of the syntax must be a list of symbols which become key parameters
>> +of the procedure.  'inputs' and 'outputs' are automatically added to them.
>> +The remaining parameters become the body of the procedure."
>
> Interesting trick.
>
>> +    (syntax-case x ()
>> +      ((k (p ...) e1 e2 ...)
>> +       (with-syntax (((outputs inputs emacs out name-ver name elpa-name-ver
>> +                               elpa-name info-dir el-dir)
>> +                      (map (cut datum->syntax #'k <>)
>> +                           '(outputs inputs emacs out name-ver name
>> +                                     elpa-name-ver elpa-name
>> +                                     info-dir el-dir))))
>> +         #'(lambda* (#:key outputs inputs p ... #:allow-other-keys)
>> +             (let* ((emacs (string-append (assoc-ref inputs "emacs")
>> +                                          "/bin/emacs"))
>> +                    (out (assoc-ref outputs "out"))
>> +                    (name-ver (store-dir->name-version out))
>> +                    (name (package-name->name+version name-ver))
>> +                    (elpa-name-ver (store-dir->elpa-name-version out))
>> +                    (elpa-name (package-name->name+version elpa-name-ver))
>> +                    (info-dir (string-append out "/share/info/" name-ver))
>> +                    (el-dir (string-append out %install-suffix
>> +                                           "/" elpa-name-ver)))
>> +               e1 e2 ...)))))))
>
> The problem is that this forcefully introduces bindings in an opaque way
> (that is, regardless of whether the ‘outputs’ binding appears in the
> source, there’s an ‘outputs’ binding that magically appears; this is
> “unhygienic” or “non referentially transparent,” or just “bad”.  ;-))
>
> Ideally, the identifiers that appear in the macro expansion should
> either be in the source, or be unique (compiler-generated.)

I was so sure that you would say so, that I did a copy of the file
before removing the 'let's and introducing the syntax.

If this would be proposed as a general utility, then I would agree
with you. But it's not. It is a module internal implementation detail
aimed at reducing boilerplate in this particular place only (where all
procedures need 'outputs' and most of the other variables) and every
introduced binding is documented. The name tells what it does in such
an obvious way that it makes the code shorter without degrading
readability.

In fact there are also popular general utilities promoted by highly
regarded programmers, which introduce what you call "bad" macros:
http://ep.yimg.com/ty/cdn/paulgraham/onlisp.pdf Chapter 14.

In any case, I've reverted to the boilerplate version (correcting it
according to the other comments).

>> +  (filter (lambda (p)
>> +            (and (pair? p)
>> +                 (emacs-package? (package-name->name+version (first p)))))
>
> (match-lambda
>   ((label . directory)
>    (emacs-package? (package-name+version directory))))
>
> (Which means the ‘first’ above should have been ‘second’?)

I'm not sure I understand your comment:
'package-name->name+version' takes a package name, therefore I pass it
the 1st element of each input.
'emacs-package?' checks for the agreed prefix in the name. Prior to
this check I discard the version suffix to make sure that, e.g.,
"emacs-123.456", is not confused for an emacs package.

(By the way, 'match-lambda' appears not to be documented in Guile.)

Thanks,
Fede

[-- Attachment #2: 0003-build-Add-emacs-build-system.patch --]
[-- Type: text/x-diff, Size: 16717 bytes --]

From e24d0b11280f4fcd106f371b98b7481f7c044eb0 Mon Sep 17 00:00:00 2001
From: Federico Beffa <beffa@fbengineering.ch>
Date: Sun, 21 Jun 2015 10:10:05 +0200
Subject: [PATCH 3/5] build: Add 'emacs-build-system'.

* Makefile.am (MODULES): Add 'guix/build-system/emacs.scm' and
  'guix/build/emacs-build-system.scm'.
* guix/build-system/emacs.scm: New file.
* guix/build/emacs-build-system.scm: New file.
* doc/guix.texi (Build Systems): Document it.
---
 Makefile.am                       |   2 +
 doc/guix.texi                     |  13 +++
 guix/build-system/emacs.scm       | 141 +++++++++++++++++++++++++++
 guix/build/emacs-build-system.scm | 197 ++++++++++++++++++++++++++++++++++++++
 4 files changed, 353 insertions(+)
 create mode 100644 guix/build-system/emacs.scm
 create mode 100644 guix/build/emacs-build-system.scm

diff --git a/Makefile.am b/Makefile.am
index c027fb3..a013b7a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -49,6 +49,7 @@ MODULES =					\
   guix/licenses.scm				\
   guix/build-system.scm				\
   guix/build-system/cmake.scm			\
+  guix/build-system/emacs.scm			\
   guix/build-system/glib-or-gtk.scm		\
   guix/build-system/gnu.scm			\
   guix/build-system/haskell.scm			\
@@ -67,6 +68,7 @@ MODULES =					\
   guix/ui.scm					\
   guix/build/download.scm			\
   guix/build/cmake-build-system.scm		\
+  guix/build/emacs-build-system.scm		\
   guix/build/git.scm				\
   guix/build/glib-or-gtk-build-system.scm	\
   guix/build/gnu-build-system.scm		\
diff --git a/doc/guix.texi b/doc/guix.texi
index 9ef6021..3e47900 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2404,6 +2404,19 @@ Which Haskell compiler is used can be specified with the @code{#:haskell}
 parameter which defaults to @code{ghc}.
 @end defvr
 
+@defvr {Scheme Variable} emacs-build-system
+This variable is exported by @code{(guix build-system emacs)}.  It
+implements an installation procedure similar to the one of Emacs' own
+packaging system (@pxref{Packages,,, emacs, The GNU Emacs Manual}).
+
+It first creates the @code{@var{package}-autoloads.el} file, then it
+byte compiles all Emacs Lisp files.  Differently from the Emacs
+packaging system, the Info documentation files are moved to the standard
+documentation directory and the @file{dir} file is deleted.  Each
+package is installed in its own directory under
+@file{share/emacs/site-lisp/guix.d}.
+@end defvr
+
 Lastly, for packages that do not need anything as sophisticated, a
 ``trivial'' build system is provided.  It is trivial in the sense that
 it provides basically no support: it does not pull any implicit inputs,
diff --git a/guix/build-system/emacs.scm b/guix/build-system/emacs.scm
new file mode 100644
index 0000000..03c1eb2
--- /dev/null
+++ b/guix/build-system/emacs.scm
@@ -0,0 +1,141 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;;
+;;; 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 emacs)
+  #: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 (%emacs-build-system-modules
+            emacs-build
+            emacs-build-system))
+
+;; Commentary:
+;;
+;; Standard build procedure for Emacs packages.  This is implemented as an
+;; extension of 'gnu-build-system'.
+;;
+;; Code:
+
+(define %emacs-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build emacs-build-system)
+    (guix build emacs-utils)
+    ,@%gnu-build-system-modules))
+
+(define (default-emacs)
+  "Return the default Emacs package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((emacs-mod (resolve-interface '(gnu packages emacs))))
+    ;; we use 'emacs' instead of 'emacs-no-x' because the latter appears not
+    ;; to be loading some macros and causes problems to some packages.  For
+    ;; example, with the latter AUCTeX gives the error message:
+    ;; "(invalid-function dbus-ignore-errors)".
+    (module-ref emacs-mod 'emacs)))
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                (emacs (default-emacs))
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+  (define private-keywords
+    '(#:target #:emacs #:inputs #:native-inputs))
+
+  (and (not target)                               ;XXX: no cross-compilation
+       (bag
+         (name name)
+         (system system)
+         (host-inputs `(,@(if source
+                              `(("source" ,source))
+                              '())
+                        ,@inputs
+
+                        ;; Keep the standard inputs of 'gnu-build-system'.
+                        ,@(standard-packages)))
+         (build-inputs `(("emacs" ,emacs)
+                         ,@native-inputs))
+         (outputs outputs)
+         (build emacs-build)
+         (arguments (strip-keyword-arguments private-keywords arguments)))))
+
+(define* (emacs-build store name inputs
+                      #:key source
+                      (tests? #t)
+                      (test-target "test")
+                      (configure-flags ''())
+                      (phases '(@ (guix build emacs-build-system)
+                                  %standard-phases))
+                      (outputs '("out"))
+                      (search-paths '())
+                      (system (%current-system))
+                      (guile #f)
+                      (imported-modules %emacs-build-system-modules)
+                      (modules '((guix build emacs-build-system)
+                                 (guix build utils)
+                                 (guix build emacs-utils))))
+  "Build SOURCE using EMACS, and with INPUTS."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (emacs-build #:name ,name
+                    #:source ,(match (assoc-ref inputs "source")
+                                (((? derivation? source))
+                                 (derivation->output-path source))
+                                ((source)
+                                 source)
+                                (source
+                                 source))
+                    #:configure-flags ,configure-flags
+                    #:system ,system
+                    #:test-target ,test-target
+                    #: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                                         ; 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 emacs-build-system
+  (build-system
+    (name 'emacs)
+    (description "The build system for Emacs packages")
+    (lower lower)))
+
+;;; emacs.scm ends here
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
new file mode 100644
index 0000000..b70e0f6
--- /dev/null
+++ b/guix/build/emacs-build-system.scm
@@ -0,0 +1,197 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;;
+;;; 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 emacs-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build utils)
+  #:use-module (guix build emacs-utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 match)
+  #:export (%standard-phases
+            emacs-build))
+
+;; Commentary:
+;;
+;; Builder-side code of the build procedure for ELPA Emacs packages.
+;;
+;; Code:
+
+;; Directory suffix where we install ELPA packages.  We avoid ".../elpa" as
+;; Emacs expects to find the ELPA repository 'archive-contents' file and the
+;; archive signature.
+(define %install-suffix "/share/emacs/site-lisp/guix.d")
+
+(define* (build #:key outputs inputs #:allow-other-keys)
+  "Compile .el files."
+  (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
+         (out (assoc-ref outputs "out"))
+         (elpa-name-ver (store-directory->elpa-name-version out))
+         (el-dir (string-append out %install-suffix "/" elpa-name-ver))
+         (deps-dirs (emacs-inputs-directories inputs)))
+    (setenv "SHELL" "sh")
+    (parameterize ((%emacs emacs))
+      (emacs-byte-compile-directory el-dir
+                                    (emacs-inputs-el-directories deps-dirs)))))
+
+(define* (patch-el-files #:key outputs #:allow-other-keys)
+  "Substitute the absolute \"/bin/\" directory with the right location in the
+store in '.el' files."
+  (let* ((out (assoc-ref outputs "out"))
+         (elpa-name-ver (store-directory->elpa-name-version out))
+         (el-dir (string-append out %install-suffix "/" elpa-name-ver))
+         (substitute-cmd (lambda ()
+                           (substitute* (find-files "." "\\.el$")
+                             (("\"/bin/(.*)\"" _ cmd)
+                              (string-append "\"" (which cmd) "\""))))))
+    (with-directory-excursion el-dir
+      ;; Some old '.el' files (e.g., tex-buf.el in AUCTeX) are still encoded
+      ;; with the "ISO-8859-1" locale.
+      (unless (false-if-exception (substitute-cmd))
+        (with-fluids ((%default-port-encoding "ISO-8859-1"))
+          (substitute-cmd))))
+    #t))
+
+(define* (install #:key outputs #:allow-other-keys)
+  "Install the package contents."
+  (let* ((out (assoc-ref outputs "out"))
+         (elpa-name-ver (store-directory->elpa-name-version out))
+         (src-dir (getcwd))
+         (tgt-dir (string-append out %install-suffix "/" elpa-name-ver)))
+    (copy-recursively src-dir tgt-dir)
+    #t))
+
+(define* (move-doc #:key outputs #:allow-other-keys)
+  "Move info files from the ELPA package directory to the info directory."
+  (let* ((out (assoc-ref outputs "out"))
+         (elpa-name-ver (store-directory->elpa-name-version out))
+         (el-dir (string-append out %install-suffix "/" elpa-name-ver))
+         (name-ver (store-directory->name-version out))
+         (info-dir (string-append out "/share/info/" name-ver))
+         (info-files (find-files el-dir "\\.info$")))
+    (unless (null? info-files)
+      (mkdir-p info-dir)
+      (with-directory-excursion el-dir
+        (when (file-exists? "dir") (delete-file "dir"))
+        (for-each (lambda (f)
+                    (copy-file f (string-append info-dir "/" (basename f)))
+                    (delete-file f))
+                  info-files)))
+    #t))
+
+(define* (make-autoloads #:key outputs inputs #:allow-other-keys)
+  "Generate the autoloads file."
+  (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs"))
+         (out (assoc-ref outputs "out"))
+         (elpa-name-ver (store-directory->elpa-name-version out))
+         (elpa-name (package-name->name+version elpa-name-ver))
+         (el-dir (string-append out %install-suffix "/" elpa-name-ver)))
+    (parameterize ((%emacs emacs))
+      (emacs-generate-autoloads elpa-name el-dir))
+    #t))
+
+(define (emacs-package? name)
+  "Check if NAME correspond to the name of an Emacs package."
+  (string-prefix? "emacs-" name))
+
+(define (emacs-inputs inputs)
+  "Retrieve the list of Emacs packages from INPUTS."
+  (filter (lambda (p)
+            (and (pair? p)
+                 (emacs-package? (package-name->name+version (first p)))))
+          inputs))
+
+(define (emacs-inputs-directories inputs)
+  "Extract the list of Emacs package directories from INPUTS."
+  (let ((emacs-ins (emacs-inputs inputs)))
+    (match emacs-ins
+      (((name . dir) ...) dir))))
+
+(define (emacs-inputs-el-directories dirs)
+  "Build the list of Emacs Lisp directories from the Emacs package directory
+DIRS."
+  (map (lambda (d)
+         (string-append d %install-suffix "/"
+                        (store-directory->elpa-name-version d)))
+       dirs))
+
+(define (package-name-version->elpa-name-version name-ver)
+  "Convert the Guix package NAME-VER to the corresponding ELPA name-version
+format.  Essnetially drop the prefix used in Guix."
+  (let ((name (store-directory->name-version name-ver)))
+    (if (emacs-package? name-ver)
+        (store-directory->name-version name-ver)
+        name-ver)))
+
+(define (store-directory->elpa-name-version store-dir)
+  "Given a store directory STORE-DIR return the part of the basename after the
+second hyphen.  This corresponds to 'name-version' as used in ELPA packages."
+  ((compose package-name-version->elpa-name-version
+            store-directory->name-version)
+   store-dir))
+
+(define (store-directory->name-version store-dir)
+  "Given a store directory STORE-DIR return the part of the basename
+after the first hyphen.  This corresponds to 'name-version' of the package."
+  (let* ((base (basename store-dir)))
+    (string-drop base
+                 (+ 1 (string-index base #\-)))))
+
+;; from (guix utils).  Should we put it in (guix build utils)?
+(define (package-name->name+version name)
+  "Given NAME, a package name like \"foo-0.9.1b\", return two values:
+\"foo\" and \"0.9.1b\".  When the version part is unavailable, NAME and
+#f are returned.  The first hyphen followed by a digit is considered to
+introduce the version part."
+  ;; See also `DrvName' in Nix.
+
+  (define number?
+    (cut char-set-contains? char-set:digit <>))
+
+  (let loop ((chars   (string->list name))
+             (prefix '()))
+    (match chars
+      (()
+       (values name #f))
+      ((#\- (? number? n) rest ...)
+       (values (list->string (reverse prefix))
+               (list->string (cons n rest))))
+      ((head tail ...)
+       (loop tail (cons head prefix))))))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (delete 'configure)
+    (delete 'check)
+    (delete 'install)
+    (replace 'build build)
+    (add-before 'build 'install install)
+    (add-after 'install 'make-autoloads make-autoloads)
+    (add-after 'make-autoloads 'patch-el-files patch-el-files)
+    (add-after 'make-autoloads 'move-doc move-doc)))
+
+(define* (emacs-build #:key inputs (phases %standard-phases)
+                      #:allow-other-keys #:rest args)
+  "Build the given Emacs package, applying all of PHASES in order."
+  (apply gnu:gnu-build
+         #:inputs inputs #:phases phases
+         args))
+
+;;; emacs-build-system.scm ends here
-- 
2.2.1