From 73b2dfe98591073104fd069622ede2acab0c7655 Mon Sep 17 00:00:00 2001
Message-Id: <73b2dfe98591073104fd069622ede2acab0c7655.1694806866.git.striness@tilde.club>
From: Ulf Herrman <striness@tilde.club>
Date: Fri, 15 Sep 2023 07:38:24 -0500
Subject: [PATCH 1/5] guix: packages: rewrite arguments with `package-mapping'.

* guix/gexp.scm (make-gexp, gexp-references, gexp-self-modules,
  gexp-self-extensions, gexp-proc, %gexp-location): export.
* guix/packages.scm (build-system-with-package-mapping): replace `rewrite'
  argument with `rewrite-input' and `rewrite-argument' arguments.  Use
  `rewrite-argument' to rewrite bag arguments.
  (package-mapping): rewrite package arguments when `deep?' is true.
---
 guix/gexp.scm     |  7 ++++++
 guix/packages.scm | 56 ++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 53 insertions(+), 10 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 0fe4f1c98a..6acd3116d4 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -39,6 +39,13 @@ (define-module (guix gexp)
   #:use-module (ice-9 match)
   #:export (gexp
             gexp?
+            make-gexp
+            gexp-references
+            gexp-self-modules
+            gexp-self-extensions
+            gexp-proc
+            %gexp-location
+
             sexp->gexp
             with-imported-modules
             with-extensions
diff --git a/guix/packages.scm b/guix/packages.scm
index ba98bb0fb4..1334def142 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1431,7 +1431,7 @@ (define* (package-closure packages #:key (system (%current-system)))
                    (vhash-consq package #t visited)
                    (fold set-insert closure dependencies))))))))
 
-(define (build-system-with-package-mapping bs rewrite)
+(define (build-system-with-package-mapping bs rewrite-input rewrite-argument)
   "Return a variant of BS, a build system, that rewrites a bag's inputs by
 passing them through REWRITE, a procedure that takes an input tuplet and
 returns a \"rewritten\" input tuplet."
@@ -1442,9 +1442,10 @@ (define (build-system-with-package-mapping bs rewrite)
     (let ((lowered (apply lower args)))
       (bag
         (inherit lowered)
-        (build-inputs (map rewrite (bag-build-inputs lowered)))
-        (host-inputs (map rewrite (bag-host-inputs lowered)))
-        (target-inputs (map rewrite (bag-target-inputs lowered))))))
+        (build-inputs (map rewrite-input (bag-build-inputs lowered)))
+        (host-inputs (map rewrite-input (bag-host-inputs lowered)))
+        (target-inputs (map rewrite-input (bag-target-inputs lowered)))
+        (arguments (map rewrite-argument (bag-arguments lowered))))))
 
   (build-system
     (inherit bs)
@@ -1456,13 +1457,32 @@ (define* (package-mapping proc #:optional (cut? (const #f))
 depended on and returns the resulting package.  The procedure stops recursion
 when CUT? returns true for a given package.  When DEEP? is true, PROC is
 applied to implicit inputs as well."
-  (define (rewrite input)
+  (define (rewrite-input input)
     (match input
       ((label (? package? package) outputs ...)
        (cons* label (replace package) outputs))
       (_
        input)))
 
+  (define (rewrite-argument arg)
+    (match arg
+      ((? package? p)
+       (replace p))
+      ((? gexp-input? gi)
+       (gexp-input (rewrite-argument (gexp-input-thing gi))
+                   (gexp-input-output gi)
+                   #:native? (gexp-input-native? gi)))
+      ((? gexp? gxp)
+       (make-gexp (map rewrite-argument (gexp-references gxp))
+                  (gexp-self-modules gxp)
+                  (gexp-self-extensions gxp)
+                  (gexp-proc gxp)
+                  (%gexp-location gxp)))
+      ((lst ...)
+       (map rewrite-argument lst))
+      (_
+       arg)))
+
   (define mapping-property
     ;; Property indicating whether the package has already been processed.
     (gensym " package-mapping-done"))
@@ -1484,7 +1504,8 @@ (define* (package-mapping proc #:optional (cut? (const #f))
                      (inherit p)
                      (location (package-location p))
                      (replacement (package-replacement p))
-                     (propagated-inputs (map rewrite (package-propagated-inputs p)))
+                     (propagated-inputs (map rewrite-input
+                                             (package-propagated-inputs p)))
                      (properties `((,mapping-property . #t)
                                    ,@(package-properties p)))))))
 
@@ -1500,11 +1521,26 @@ (define* (package-mapping proc #:optional (cut? (const #f))
                  (location (package-location p))
                  (build-system (if deep?
                                    (build-system-with-package-mapping
-                                    (package-build-system p) rewrite)
+                                    (package-build-system p)
+                                    rewrite-input
+                                    rewrite-argument)
                                    (package-build-system p)))
-                 (inputs (map rewrite (package-inputs p)))
-                 (native-inputs (map rewrite (package-native-inputs p)))
-                 (propagated-inputs (map rewrite (package-propagated-inputs p)))
+                 (inputs (map rewrite-input (package-inputs p)))
+                 (native-inputs (map rewrite-input (package-native-inputs p)))
+                 (propagated-inputs
+                  (map rewrite-input (package-propagated-inputs p)))
+                 (arguments
+                  (match p
+                       (($ <package> _ _ _ _ args-proc)
+                        ;; If we let ARGS-PROC be passed its original package,
+                        ;; we somehow end up in an infinite (or maybe just
+                        ;; exponential? Never seen it end...) loop.  Should
+                        ;; probably figure out what's causing that at some
+                        ;; point.
+                        (let ((args (args-proc this-package)))
+                          (if deep?
+                              (map rewrite-argument args)
+                              args)))))
                  (replacement (and=> (package-replacement p) replace))
                  (properties `((,mapping-property . #t)
                                ,@(package-properties p)))))))))

base-commit: bfb480e76f7968f8e39e37e64681b0fd062edb1e
prerequisite-patch-id: b512735cd31c9f7564894ed3a5c1c3b921eeaed3
prerequisite-patch-id: d782bad3845786f3ef367822aeb146a1e5e994d7
prerequisite-patch-id: c277154bb5fbcb1e6a2af576d6f7eebde308b010
prerequisite-patch-id: 088174854de84cd796d4fe7f39386b1539a3df51
prerequisite-patch-id: 083848588d3bae9d392fb1270b64990f13209dbe
prerequisite-patch-id: 36801b82c0a0365ab18a3a6ad3814e8fbe1b0630
prerequisite-patch-id: de0adff180c2ea6e9d1c34f8f0b1d62ec7863ccf
prerequisite-patch-id: 7054626c27a5208550912b11e92bb16dab15fb34
prerequisite-patch-id: 5736a5673877a8185a80d0c9767f288bddc239d3
prerequisite-patch-id: 4e23b3ba151bebb40d56816915f9d0503fe1566b
prerequisite-patch-id: 4edcd21bef307dbe07a9605314aaa446f45a943f
prerequisite-patch-id: 0a98f8e01ac1df033a86b5f42d01dd9baece0807
prerequisite-patch-id: e55e0c751b9772a31656decb1aec8bcc193685b0
prerequisite-patch-id: 837b6cf8db48bdb22c7573ce0fb63a1a6255640b
prerequisite-patch-id: 0c07d4138fc33f6d976b7c7ff2d25b93145dc417
prerequisite-patch-id: 1875c8e646ce329f8a72da90367c3725c953b5c2
prerequisite-patch-id: 8c429132b33f94d9f910413f56e9b3ca18d0db43
prerequisite-patch-id: 121cf7bd1b560e8db138132990840a20c20c6636
prerequisite-patch-id: e9662377bc432936ffbfffaa10dff3a285eacd26
prerequisite-patch-id: cfd757e3df23f22fbd88441ecabfe21f37b4d140
prerequisite-patch-id: a563c6b6f53532a7a6fb7fe8ebbb11d237947b7f
prerequisite-patch-id: da271d8023063a789328959f5dc6389675d5d46a
prerequisite-patch-id: 271b2952dc050715c90848953e3586b35e21d184
prerequisite-patch-id: 92caaf95030c644dec30fc139a63e25b1dc8d48c
prerequisite-patch-id: e03d9290c61f083c96b084403e6dc69394ee2faa
prerequisite-patch-id: 3ca7c6fd53e9cd1c07bfb2e16763ecaf6d0cc4eb
prerequisite-patch-id: 018b82c741ee4e1370df059b22cc86aa4735644b
prerequisite-patch-id: a26834894fcd1380dfd5a979088114d50d0df392
prerequisite-patch-id: 8916b1ce832d695ecb86e4f36b3fe1a5529552dc
prerequisite-patch-id: 2230d379e61787c3327f89ef02c8de3ab879090d
prerequisite-patch-id: fb4536c142e85bb0a6610203ae25a74f7342351d
prerequisite-patch-id: dc0a3e2e36977cf203ad0c74650844758446c115
prerequisite-patch-id: f9e2903e96a7e6e08f9a9ce10e8f35650a2bc9d0
prerequisite-patch-id: 52609b8f7999fe1bfd2ad90aba421042b1e39a50
prerequisite-patch-id: 4b6138782ae74502be87966344f7bb5d88e8734c
prerequisite-patch-id: 411c9c605a4e89efe01841517486a3d6015be917
prerequisite-patch-id: e07e206a39a0b173786207d335740f08d0baecb2
prerequisite-patch-id: 424af6d825a003e67545f8f23fc292407a029a4e
prerequisite-patch-id: cd9480f3fbb837834ef9294aec9d25e797927456
prerequisite-patch-id: 2f401351ac266c92a77cbcf54549ce5bee78e93e
prerequisite-patch-id: aff161c12c59578d3d1e4569ad3bea0ab7fa231d
prerequisite-patch-id: 156e04e25c5f214fd5e9ba3a4548b960bf8d5142
prerequisite-patch-id: 61869ccfd561784d16df3d62dae522790b182ea0
prerequisite-patch-id: a19bb63b9c373c4f153545de121024c2f0008e03
prerequisite-patch-id: 92eb3cfcdb4791daed167477aa19d34400455f2b
prerequisite-patch-id: 7e00825d11982a64a671116fc30ebe34ff562974
prerequisite-patch-id: a920acf76ea0ed8484888c28f5803def46b496e8
prerequisite-patch-id: a2f4feda897c80d54fefac2979b34dc8755d2562
prerequisite-patch-id: 66bd73e2012a407a0ae8c07ead463bb87ac7ceb1
prerequisite-patch-id: c7703e99c566323d908bfdd31896401c61d9c6e9
prerequisite-patch-id: b05dec5daf49254938536568b1f0e259f85a5f27
prerequisite-patch-id: 2ec62060c8d777a316cb35a5956fca2d6340c238
prerequisite-patch-id: 5e47032571af5476c2a4d9bbbe9c98ac62736acf
prerequisite-patch-id: f3f2d80dc4d970ec7e27221b1713303a752602db
prerequisite-patch-id: cf272874f837a1089867a3c578ba773b9722e4bc
prerequisite-patch-id: 26b133febfaa8e56cacf9695fec9e47ac7752437
prerequisite-patch-id: 2370164c61289dc27dacd1a3fce404b42a5cd306
prerequisite-patch-id: 8e151f495e68d05d7ae3a58b75965ed6ad402cb3
prerequisite-patch-id: 1e1d8a1a5c3d2e7c012c3800b2f162bbfb11830e
prerequisite-patch-id: 20b2ba87fb4a1d22b2e5d189868953deb1b8432d
prerequisite-patch-id: 4b7a45d0216169dddf32b0556847edcf1fe83c77
prerequisite-patch-id: a7caa886acb871c8fae58942ea33c4830c1bf50a
prerequisite-patch-id: 4cb809d1af72bfb4160541432f84e7f7a2ec377c
prerequisite-patch-id: b8bba3077b9e27a14b7a4500145a546e2551920b
prerequisite-patch-id: 42371e75be346f69a66f1af370f10e19118d3666
prerequisite-patch-id: fbcbda683c60fc49fb0acb35e8fcba3632e33c1d
prerequisite-patch-id: 5a7497e62af0532f2262e825ecfffdc87b46a4cd
prerequisite-patch-id: 39515c3e9d305eca348d158422e1db32d02a2f6f
prerequisite-patch-id: cb139244b5614b18feeb19793713a1836e637e23
prerequisite-patch-id: 095b7088b6d2e2738d07a2c5409f9116640f1e8c
prerequisite-patch-id: 36e9e48ae432da7f9e0438ff3bd2476fb4ee17ef
prerequisite-patch-id: a0be866c6a75021f6d9ae024a5ebeb94f14ef039
prerequisite-patch-id: 0d424f7822bad63211e0f5f2e8432053fcc2280d
prerequisite-patch-id: a59b7626f41bf5570f2119e4b148c7da4370c604
prerequisite-patch-id: 3d4f86e81bda469eb2cac04b6781847f32ba2d4b
prerequisite-patch-id: d364cccdb604ed9d3d9b98d821ef1bcba2f93dd4
prerequisite-patch-id: ad4bbb2ffa1a81c85e6f7a3da474648c57abeb08
prerequisite-patch-id: b2ccfb33f49dcee45d0eae151d63c20619eba269
prerequisite-patch-id: 370503f330a01247f61b6f8da90cc1874addca9d
prerequisite-patch-id: bf97596682da5aa565d63e58806e64c57501bfbf
prerequisite-patch-id: ff1ce6c53974f6458a24f5d68d656514a49b496a
prerequisite-patch-id: abec97caff0781ddf8bac457259e336956d31f56
prerequisite-patch-id: 10b5231fdd5214c7ce994d13e9bc4accd9c3e98b
prerequisite-patch-id: 6c3ff15435a372b3c176d0ec839507093e7f75d5
prerequisite-patch-id: d874c3ae8cc9643fe65c0def0ab9f62a30ef265e
prerequisite-patch-id: 301b58dab98c976159b086b6d9b215f6cfc32560
prerequisite-patch-id: d946ee345019733d07c28073643c11d6a0265887
prerequisite-patch-id: eb86ebc23516ee5a1c69fad149fbf5a82fbf44e2
prerequisite-patch-id: f3aae14f0dc6bd6c07b5405db4efb8677eb109db
prerequisite-patch-id: a596041f0af7a7fb2ff8fc39e61c75d1add0b21a
prerequisite-patch-id: 6dc272118cfeb1aea0819a796beace8fa8305be7
prerequisite-patch-id: 8dea513488503b59c1971a20b6e5af36fab30f16
prerequisite-patch-id: 489930e028059725a437833f8144cba5b5f88275
prerequisite-patch-id: 101a681e226bba3d782559f9966ed75f6cfac4d0
prerequisite-patch-id: 02d84b8de56dcf379619cb73975e08541258a744
prerequisite-patch-id: 22eb2f65315c0eec851686f01a43772184be67c2
prerequisite-patch-id: f4013eaef497b4e39d5680ae87c388f5e90d962c
prerequisite-patch-id: e774f3f01024e9b0522c62d7f0e2e745d1eec9d6
prerequisite-patch-id: 6fea198a4035448351e7ab3c859f5ba7a9974e3e
prerequisite-patch-id: 9f9ee707bc7da130f29d23398775b7648345fddd
prerequisite-patch-id: fef59953278e9b5c86db36ff047117203aac756c
prerequisite-patch-id: 076981cbfd6fdf83498b0abbfab4aa41b17bf32f
prerequisite-patch-id: 63746b98da1e924ec78b707e0cab29e1913793e6
prerequisite-patch-id: 4c8b859607b829c54ea2bc94d8fd1807054e347f
prerequisite-patch-id: ca54f1fae5954706f3f4b46427b39f3096193e20
prerequisite-patch-id: 8d1176310f67c10d84f7d409152c45584637a5e1
prerequisite-patch-id: d973cfefc6c2621052370ef917c5a30b4b4c6153
prerequisite-patch-id: a16615ac67d4cfb2d7f991d41d7b88e536b8d1e6
prerequisite-patch-id: c99f1ac1c8f31966ab5eace82966b38d7683c7b6
prerequisite-patch-id: ea8cbbe7d266c8e01f92cf47c67a2b77ba2e2f2a
prerequisite-patch-id: 87f853bef8078737d6ee37152f9540dc318577b8
prerequisite-patch-id: 624ebedc4b5efd852396af22dfee278e81e18607
prerequisite-patch-id: b0386c11c46382a027d6feb7f8cee077fd1ce7f0
prerequisite-patch-id: f30932e3c494a7e2e758c71a15600f7d02e5fe3c
prerequisite-patch-id: c6e5542e49b9e990abfd941b82e6c8f47cce82eb
prerequisite-patch-id: 8ed51ac5bb592e2b9a3726d009b390eaf3d02a22
prerequisite-patch-id: 3eb38c477f4039d6dad8ea7657461d5b69582cea
prerequisite-patch-id: 604ec349a2100c97da1a9e86443e5fe670fc9aff
prerequisite-patch-id: 0ec9b5ad92a820364e736176265cbf38a6aa9865
prerequisite-patch-id: 9f9f6f4f5e6f3f38d57c8fc51dd6d1d1b13614aa
prerequisite-patch-id: 3084be13b8e6449d0739a66199d78fd83b273dc9
prerequisite-patch-id: 38129e693708c4068b779fe561befa0789da4e68
prerequisite-patch-id: e599d0af678fca48957ba931713ba46acf57cd26
prerequisite-patch-id: 82676aa787f2d5896dbcc966014c85933ee203bd
prerequisite-patch-id: 4e1a39929ca7eb97be4a265ab2961ebb00ac2494
prerequisite-patch-id: 928b20a27997c43597c625e6e431e9963b8a6cdc
prerequisite-patch-id: eea41f1a51b1062b9f7fe17ba9b0827bce4f7f8d
prerequisite-patch-id: 94d48d21b6e420f0d9bf99d9488136b667d047b4
prerequisite-patch-id: c06f0d333b33836de8800323e814d6dcf214fd78
prerequisite-patch-id: 44515b47a0e5f194b1e782bbbdf4597418c46f77
prerequisite-patch-id: 94eeb31189a81ccbf18dda42a72db715bec3a279
prerequisite-patch-id: d02e7863404940800b63dca3f328547df5cac24f
prerequisite-patch-id: c47b08cb4e7ab0a024a2be4b250c4b60ab0bab65
prerequisite-patch-id: fb2396bde2637b96c4412df6ef6a09e9c38e3365
prerequisite-patch-id: 7068eef2aa4f77ef304869b3661c25238f7497e5
prerequisite-patch-id: a2f06d63b11dce495cddad29f5f507a380ff23c2
prerequisite-patch-id: b21a55b8bf2bd23485e0d7d6433ec1f29acd6226
prerequisite-patch-id: 7fd6c9378b4c96bbc7e109f759fd4e7ff6bacba2
prerequisite-patch-id: b109590bb6082361a59547bf252f576a574b75e8
prerequisite-patch-id: f5aa2b7352ffec54c23277d9d4715bbd95c1eb79
prerequisite-patch-id: 2a9907079587beb938680221ededa8f5e0e7d4b2
prerequisite-patch-id: 90f4e54d0b451db6166dbd1d2067e07696e092bf
prerequisite-patch-id: 999ec11aaddd785d065911dcb1fc7385ccf053d6
prerequisite-patch-id: cc250a0b2267760feea1427573482db1bb8328e6
prerequisite-patch-id: b593f9fd55bbd9e855baba4b1037d844d5773916
prerequisite-patch-id: 74e3c356cee5e56d4dc3f5bc4f5705cd2ce75a1d
prerequisite-patch-id: 7443872a7242e134d8f95398c53f47d4ae21a23b
prerequisite-patch-id: da89093d1a5bb1dd8bb6436f4daf70eb4025eae9
prerequisite-patch-id: 3be9735669c6510ef29e75588bbf907d57733834
prerequisite-patch-id: 976e476ba476fe3cd730ac29c825fad81c6331d1
prerequisite-patch-id: 889a29b57cea9cb18f4f4a9c22b04d151b216e1d
prerequisite-patch-id: 6b6690e68606f4359e22656a7c6aeae5c58ea017
prerequisite-patch-id: c46954eddc80453f6d7c045fa22ec99a694d9693
prerequisite-patch-id: bdccc141b570181273512c2089d95e4ebcdae453
prerequisite-patch-id: ee3338d64821748f9a7d8ed9cf5e9181c2027252
prerequisite-patch-id: 7f7da1ba32e01163b013d5c4ac96aa468f6e908e
prerequisite-patch-id: 83a09cce225aaaa626b3f5d2f3a092055f61a909
prerequisite-patch-id: 7f31991b2e91782e9dd1c1a6fda5f055fdff3234
prerequisite-patch-id: 831310b4d4842a08ad12fdf5c07ce55b57db049d
prerequisite-patch-id: 9588d67009d034f36ceef115b158556b8cacb680
prerequisite-patch-id: e0807504b7c5f14f0af8bdbbdd800754888dd8f8
prerequisite-patch-id: 6e3d6e24505bd188d776720913c18c4b874c896c
prerequisite-patch-id: e20a2cd4b5a85889b97a5733863175fb56420d01
-- 
2.40.1