gexp: 'load-path-expression' produces an expression that deletes duplicates.

Fixes <https://bugs.gnu.org/37531>.

"herd eval root '(length %load-path)'" on a freshly-booted bare-bones
system now returns 8 instead of 119 before.

* guix/gexp.scm (load-path-expression): Rewrite expression to that it
deletes duplicates.
This commit is contained in:
Ludovic Courtès 2019-10-03 22:54:28 +02:00
parent 5a02f8e384
commit cdf9811d24
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 31 additions and 18 deletions

View File

@ -1527,23 +1527,36 @@ are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty."
#:module-path path #:module-path path
#:system system #:system system
#:target target))) #:target target)))
(return (gexp (eval-when (expand load eval) (return
(gexp (eval-when (expand load eval)
;; Augment the load paths and delete duplicates. Do that
;; without loading (srfi srfi-1) or anything.
(let ((extensions '((ungexp-native-splicing extensions)))
(prepend (lambda (items lst)
;; This is O(N²) but N is typically small.
(let loop ((items items)
(lst lst))
(if (null? items)
lst
(loop (cdr items)
(cons (car items)
(delete (car items) lst))))))))
(set! %load-path (set! %load-path
(cons (ungexp modules) (prepend (cons (ungexp modules)
(append (map (lambda (extension) (map (lambda (extension)
(string-append extension (string-append extension
"/share/guile/site/" "/share/guile/site/"
(effective-version))) (effective-version)))
'((ungexp-native-splicing extensions))) extensions))
%load-path))) %load-path))
(set! %load-compiled-path (set! %load-compiled-path
(cons (ungexp compiled) (prepend (cons (ungexp compiled)
(append (map (lambda (extension) (map (lambda (extension)
(string-append extension (string-append extension
"/lib/guile/" "/lib/guile/"
(effective-version) (effective-version)
"/site-ccache")) "/site-ccache"))
'((ungexp-native-splicing extensions))) extensions))
%load-compiled-path))))))))) %load-compiled-path)))))))))
(define* (gexp->script name exp (define* (gexp->script name exp