utils: 'current-source-directory' is now purely an expansion-time thing.

* guix/utils.scm (extract-directory): Remove.
(current-source-directory): Rewrite as a 'syntax-case' macro.

1 files changed, 10 insertions, 12 deletions

diff --git a/guix/utils.scm b/guix/utils.scm
index 19fd0b0844..8aadfb0075 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -702,18 +702,16 @@ output port, and PROC's result is returned."
 ;;; Source location.
 ;;;
 
-(define (extract-directory properties)
-  "Extract the directory name from source location PROPERTIES."
-  (match (assq 'filename properties)
-    (('filename . (? string? file-name))
-     (dirname file-name))
-    (_
-     #f)))
-
-(define-syntax-rule (current-source-directory)
-  "Expand to the directory of the current source file or #f if it could not
-be determined."
-  (extract-directory (current-source-location)))
+(define-syntax current-source-directory
+  (lambda (s)
+    "Return the current directory name or #f if it could not be determined."
+    (syntax-case s ()
+      ((_)
+       (match (assq 'filename (syntax-source s))
+         (('filename . (? string? file-name))
+          (dirname file-name))
+         (_
+          #f))))))
 
 ;; A source location.
 (define-record-type <location>