Add native compilation to emacs.

Credit to Andrew Whatson for doing all the work.

(https://github.com/flatwhatson/guix-channel)

3 files changed, 174 insertions, 0 deletions

diff --git a/yellowsquid/packages/emacs.scm b/yellowsquid/packages/emacs.scm
new file mode 100644
index 0000000..2242465
--- /dev/null
+++ b/yellowsquid/packages/emacs.scm
@@ -0,0 +1,94 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Andrew Whatson <whatson@gmail.com>
+;;;
+;;; This file is NOT part of GNU Guix.
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (yellowsquid packages emacs)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages emacs)
+  #:use-module (gnu packages gcc)
+  #:use-module (gnu packages xorg)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (guix utils)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (yellowsquid packages)
+  #:use-module (yellowsquid packages gcc))
+
+(define emacs-with-native-comp
+  (lambda* (emacs gcc #:optional full-aot)
+    (let ((libgccjit (libgccjit-for-gcc gcc)))
+      (package
+        (inherit emacs)
+        (source
+         (origin
+           (inherit (package-source emacs))
+           (patches
+            (append (search-patches "emacs-native-comp-exec-path.patch")
+                    (filter
+                     (lambda (f)
+                       (not (any (cut string-match <> f)
+                                 '("/emacs-exec-path\\.patch$"
+                                   "/emacs-ignore-empty-xim-styles\\.patch$"))))
+                     (origin-patches (package-source emacs)))))))
+        (arguments
+         (substitute-keyword-arguments (package-arguments emacs)
+           ((#:make-flags flags ''())
+            (if full-aot
+                #~(cons* "NATIVE_FULL_AOT=1" #$flags)
+                flags))
+           ((#:configure-flags flags)
+            #~(cons* "--with-native-compilation" #$flags))
+           ((#:phases phases)
+            #~(modify-phases #$phases
+               ;; Add build-time library paths for libgccjit.
+               (add-before 'configure 'set-libgccjit-path
+                 (lambda* (#:key inputs #:allow-other-keys)
+                   (let ((libgccjit-libdir
+                          (string-append (assoc-ref inputs "libgccjit")
+                                         "/lib/gcc/" %host-type "/"
+                                         #$(package-version libgccjit) "/")))
+                     (setenv "LIBRARY_PATH"
+                             (string-append libgccjit-libdir ":"
+                                            (getenv "LIBRARY_PATH"))))
+                   #t))
+               ;; Add runtime library paths for libgccjit.
+               (add-after 'unpack 'patch-driver-options
+                 (lambda* (#:key inputs #:allow-other-keys)
+                   (substitute* "lisp/emacs-lisp/comp.el"
+                     (("\\(defcustom native-comp-driver-options nil")
+                      (format
+                       #f "(defcustom native-comp-driver-options '(~s ~s ~s ~s)"
+                       (string-append
+                        "-B" (assoc-ref inputs "binutils") "/bin/")
+                       (string-append
+                        "-B" (assoc-ref inputs "glibc") "/lib/")
+                       (string-append
+                        "-B" (assoc-ref inputs "libgccjit") "/lib/")
+                       (string-append
+                        "-B" (assoc-ref inputs "libgccjit") "/lib/gcc/"))))
+                   #t))))))
+        (native-inputs
+         (modify-inputs (package-native-inputs emacs)
+           (prepend gcc)))
+        (inputs
+         (modify-inputs (package-inputs emacs)
+           (prepend glibc libgccjit libxcomposite)))))))
+
+(define-public emacs-native-comp
+  (emacs-with-native-comp emacs gcc-12))
diff --git a/yellowsquid/packages/gcc.scm b/yellowsquid/packages/gcc.scm
new file mode 100644
index 0000000..945650d
--- /dev/null
+++ b/yellowsquid/packages/gcc.scm
@@ -0,0 +1,64 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Andrew Whatson <whatson@gmail.com>
+;;;
+;;; This file is NOT part of GNU Guix.
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (yellowsquid packages gcc)
+  #:use-module (guix memoization)
+  #:use-module (guix packages)
+  #:use-module (guix utils)
+  #:use-module (srfi srfi-1)
+  #:export (libgccjit-for-gcc))
+
+(define libgccjit-for-gcc
+  (mlambda (gcc)
+    (package
+      (inherit gcc)
+      (name "libgccjit")
+      (outputs (delete "lib" (package-outputs gcc)))
+      (properties (alist-delete 'hidden? (package-properties gcc)))
+      (arguments
+       (substitute-keyword-arguments `(#:modules ((guix build gnu-build-system)
+                                                  (guix build utils)
+                                                  (ice-9 regex)
+                                                  (srfi srfi-1)
+                                                  (srfi srfi-26))
+                                       ,@(package-arguments gcc))
+         ((#:configure-flags flags)
+          `(append '("--disable-bootstrap"
+                     "--disable-libatomic"
+                     "--disable-libgomp"
+                     "--disable-libquadmath"
+                     "--disable-libssp"
+                     "--enable-host-shared"
+                     "--enable-checking=release"
+                     "--enable-languages=jit")
+                   (remove (cut string-match "--enable-languages.*" <>)
+                           ,flags)))
+         ((#:phases phases)
+          `(modify-phases ,phases
+             (add-after 'install 'remove-broken-or-conflicting-files
+               (lambda* (#:key outputs #:allow-other-keys)
+                 (for-each delete-file
+                           (find-files (string-append (assoc-ref outputs "out") "/bin")
+                                       ".*(c\\+\\+|cpp|g\\+\\+|gcov|gcc|gcc-.*)"))
+                 #t))))))
+      (inputs
+       (alist-delete "libstdc++"
+                     (package-inputs gcc)))
+      (native-inputs
+       `(("gcc" ,gcc)
+         ,@(package-native-inputs gcc))))))
diff --git a/yellowsquid/packages/patches/emacs-native-comp-exec-path.patch b/yellowsquid/packages/patches/emacs-native-comp-exec-path.patch
new file mode 100644
index 0000000..11f6167
--- /dev/null
+++ b/yellowsquid/packages/patches/emacs-native-comp-exec-path.patch
@@ -0,0 +1,16 @@
+Do not capture the build-time value of $PATH in the 'emacs' executable
+since this can noticeably increase the size of the closure of Emacs
+with things like GCC being referenced.
+
+--- a/lisp/loadup.el
++++ b/lisp/loadup.el
+@@ -526,7 +526,8 @@
+                         ((equal dump-mode "dump") "emacs")
+                         ((equal dump-mode "bootstrap") "emacs")
+                         ((equal dump-mode "pbootstrap") "bootstrap-emacs.pdmp")
+-                        (t (error "Unrecognized dump mode %s" dump-mode)))))
++                        (t (error "Unrecognized dump mode %s" dump-mode))))
++          (exec-path nil))
+       (when (and (featurep 'native-compile)
+                  (equal dump-mode "pdump"))
+         ;; Don't enable this before bootstrap is completed, as the