diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-06 21:15:00 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-07 20:11:00 +0100 |
| commit | 2096b972976b68750dadbed9c159c62fc3ac1678 (patch) | |
| tree | 1590325e7a8fc9bbe2f2151c90f76655daa04aa5 /module/hnh | |
| parent | Rewrote tests for path operations. (diff) | |
| download | calp-2096b972976b68750dadbed9c159c62fc3ac1678.tar.gz calp-2096b972976b68750dadbed9c159c62fc3ac1678.tar.xz | |
Cleanup in (hnh util path).
Diffstat (limited to 'module/hnh')
| -rw-r--r-- | module/hnh/util/path.scm | 31 |
1 files changed, 19 insertions, 12 deletions
diff --git a/module/hnh/util/path.scm b/module/hnh/util/path.scm index 7e40259a..28a026bc 100644 --- a/module/hnh/util/path.scm +++ b/module/hnh/util/path.scm @@ -2,31 +2,38 @@ :use-module (srfi srfi-1) :use-module (hnh util)) +(define // file-name-separator-string) +(define /? file-name-separator?) + (define-public (path-append . strings) (fold (lambda (s done) - (string-append - done - (if (string-null? s) - (string-append s file-name-separator-string) - (if (file-name-separator? (string-last done)) - (if (file-name-separator? (string-first s)) - (string-drop s 1) s) - (if (file-name-separator? (string-first s)) - s (string-append file-name-separator-string s)))))) + (string-append + done + (cond ((string-null? s) //) + ((and (/? (string-first s)) + (/? (string-last done))) + (string-drop s 1)) + ((or (/? (string-first s)) + (/? (string-last done))) + s) + (else (string-append // s))))) ;; If first component is empty, add a leading slash to make ;; the path absolute. This isn't exactly correct if we have ;; drive letters, but on those system the user should make ;; sure that the first component of the path is non-empty. (let ((s (car strings))) (if (string-null? s) - file-name-separator-string s)) - (cdr strings))) + // s)) + (cdr strings) + )) (define-public (path-join lst) (apply path-append lst)) ;; @example ;; (path-split "usr/lib/test") ;; ⇒ ("usr" "lib" "test") +;; (path-split "usr/lib/test/") +;; ⇒ ("usr" "lib" "test") ;; (path-split "/usr/lib/test") ;; ⇒ ("" "usr" "lib" "test") ;; (path-split "//usr////lib/test") @@ -38,7 +45,7 @@ (reverse (map reverse-list->string (fold (lambda (c done) - (if (file-name-separator? c) + (if (/? c) (cons '() done) (cons (cons c (car done)) (cdr done)))) '(()) |