replace-store-files bien plus utilisable, et probablement un peu plus rapide

diff --git a/amyx/home.scm b/amyx/home.scm
index f4eec347d59c6d26cbe5fb551f2d139bbe41a341..1e0d6c764392be6418c4d928c915b1cc9e59e8a2 100644 (file)
--- a/amyx/home.scm
+++ b/amyx/home.scm
@@ -18,31 +18,22 @@
   #:use-module (srfi srfi-1)
   #:export (replace-store-files))
 
-(define (find-file-in-packages f packages)
-  (let ((l (filter-map (lambda (p)
-                         (and (stat (string-append p "/" f) #f)
-                              (string-append p "/" f))) packages)))
-    (cond
-      ((= (length l) 0)
-       (raise-exception (make-exception (make-error)
-                                        (make-exception-with-message (string-append
-                                                                      "File found in no packages: "
-                                                                      f)))))
-      ((= (length l) 1)
-       (car l))
-      (else (raise-exception (make-exception (make-error)
-                                             (make-exception-with-message (string-append
-                                                                           "File found in multiple packages: "
-                                                                           f))))))))
+(define store-path-regexp
+  (make-regexp "#\\$([^/]*)/"))
 
-(define (replace-store-files file packages)
-  (regexp-substitute/global #f
-                            "#\\$([^ \n\t]*)"
-                            (call-with-input-file file
-                              get-string-all)
-                            'pre
-                            (lambda (m)
-                              (find-file-in-packages (match:substring m 1)
-                                                     packages))
-                            'post))
+(define (regexp-map-list regexp str f)
+  (let ((m (regexp-exec regexp str)))
+    (if m
+        `(,(match:prefix m) ,@(f m)
+          ,@(regexp-map-list regexp
+                             (match:suffix m) f))
+        `(,str))))
 
+(define-macro (replace-store-files file)
+              `(list ,@(regexp-map-list store-path-regexp
+                                          (call-with-input-file file
+                                            get-string-all)
+                                          (lambda (m)
+                                            `(,(string->symbol (match:substring
+                                                                  m 1))
+                                              "/")))))