From 6266c46181d2880684c89999519423be8d8a8ea3 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Sun, 22 Dec 2019 17:25:59 +0100
Subject: [PATCH] wip: Add a canonical-package gexp compiler.

---
 gnu/packages/base.scm         |  6 ++++++
 gnu/packages/commencement.scm | 40 +++++++++++++++++++++++++++++++++++
 2 files changed, 46 insertions(+)

diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index e8150708c0..22b6e05dae 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -1337,6 +1337,12 @@ package needs iconv ,@(libiconv-if-needed) should be added."
          (proc  (module-ref iface 'canonical-package)))
     (proc package)))
 
+(define-public (canonical-package* package)
+  ;; Avoid circular dependency by lazily resolving 'commencement'.
+  (let* ((iface (resolve-interface '(gnu packages commencement)))
+         (proc  (module-ref iface 'make-canonical-package)))
+    (proc package)))
+
 (define-public (%final-inputs)
   "Return the list of \"final inputs\"."
   ;; Avoid circular dependency by lazily resolving 'commencement'.
diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index 14ecf246d4..41ab430388 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -54,8 +54,11 @@
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system trivial)
   #:use-module (guix memoization)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
@@ -2613,5 +2616,42 @@ Fortran development to be installed in user profiles.  This includes
 gfortran, as well as libc (headers and binaries, plus debugging symbols
 in the @code{debug} output), and binutils.")))
 
+(define-record-type <canonical-package>
+  (%make-canonical-package name)
+  canonical-package?
+  (name canonical-package-name))
+
+(define-public (make-canonical-package package)
+  (%make-canonical-package package))
+
+(define-gexp-compiler (canonical-package-compiler
+                       (canonical-package <canonical-package>) system target)
+  ;; Return the 'canonical' variant of PACKAGE---i.e., if PACKAGE is one of
+  ;; the implicit inputs of 'gnu-build-system', return that one, otherwise
+  ;; return PACKAGE.
+  ;;
+  ;; The goal is to avoid duplication in cases like GUILE-FINAL vs. GUILE-2.2,
+  ;; COREUTILS-FINAL vs. COREUTILS, etc.
+  (let ((name->package (fold (lambda (input result)
+                               (match input
+                                 ((_ package . outputs)
+                                  (vhash-cons (package-full-name package)
+                                              package result))))
+                             vlist-null
+                             `(("guile" ,guile-final)
+                               ,@%final-inputs)))
+        (package (canonical-package-name canonical-package)))
+    ;; XXX: This doesn't handle dependencies of the final inputs, such as
+    ;; libunistring, GMP, etc.
+    (match (vhash-assoc (package-full-name package) name->package)
+      ((_ . canon)
+       ;; In general we want CANON, except if we're cross-compiling: CANON
+       ;; uses explicit inputs, so it is "anchored" in the bootstrapped
+       ;; process, with dependencies on things that cannot be
+       ;; cross-compiled.
+       (if target
+           (package->cross-derivation package target system)
+           (package->derivation (pk canon) system)))
+      (_ (package->derivation package system)))))
 
 ;;; commencement.scm ends here
-- 
2.24.0