diff options
| -rw-r--r-- | gnu/build/linux-modules.scm | 4 | ||||
| -rw-r--r-- | guix/glob.scm | 51 | ||||
| -rw-r--r-- | tests/glob.scm | 12 |
3 files changed, 41 insertions, 26 deletions
diff --git a/gnu/build/linux-modules.scm b/gnu/build/linux-modules.scm index e97c9c95f1..87d2e98edf 100644 --- a/gnu/build/linux-modules.scm +++ b/gnu/build/linux-modules.scm @@ -329,7 +329,7 @@ The modules corresponding to these aliases can then be found using list of alias/module pairs where each alias is a glob pattern as like the result of: - (compile-glob-pattern \"scsi:t-0x01*\") + (string->compiled-sglob \"scsi:t-0x01*\") and each module is a module name like \"snd_hda_intel\"." (define (comment? str) @@ -354,7 +354,7 @@ and each module is a module name like \"snd_hda_intel\"." (line (match (tokenize line) (("alias" alias module) - (loop (alist-cons (compile-glob-pattern alias) module + (loop (alist-cons (string->compiled-sglob alias) module aliases))) (() ;empty line (loop aliases))))))) diff --git a/guix/glob.scm b/guix/glob.scm index 29c335ca1d..a9fc744802 100644 --- a/guix/glob.scm +++ b/guix/glob.scm @@ -18,7 +18,9 @@ (define-module (guix glob) #:use-module (ice-9 match) - #:export (compile-glob-pattern + #:export (string->sglob + compile-sglob + string->compiled-sglob glob-match?)) ;;; Commentary: @@ -37,9 +39,9 @@ (lst `(set ,@lst)))) -(define (compile-glob-pattern str) - "Return an sexp that represents the compiled form of STR, a glob pattern -such as \"foo*\" or \"foo??bar\"." +(define (string->sglob str) + "Return an sexp, called an \"sglob\", that represents the compiled form of +STR, a glob pattern such as \"foo*\" or \"foo??bar\"." (define flatten (match-lambda (((? string? str)) str) @@ -83,9 +85,33 @@ such as \"foo*\" or \"foo??bar\"." ((chr . rest) (loop rest (cons chr pending) brackets result))))) +(define (compile-sglob sglob) + "Compile SGLOB into a more efficient representation." + (if (string? sglob) + sglob + (let loop ((sglob sglob) + (result '())) + (match sglob + (() + (reverse result)) + (('? . rest) + (loop rest (cons char-set:full result))) + ((('range start end) . rest) + (loop rest (cons (ucs-range->char-set + (char->integer start) + (+ 1 (char->integer end))) + result))) + ((('set . chars) . rest) + (loop rest (cons (list->char-set chars) result))) + ((head . rest) + (loop rest (cons head result))))))) + +(define string->compiled-sglob + (compose compile-sglob string->sglob)) + (define (glob-match? pattern str) "Return true if STR matches PATTERN, a compiled glob pattern as returned by -'compile-glob-pattern'." +'compile-sglob'." (let loop ((pattern pattern) (str str)) (match pattern @@ -101,21 +127,10 @@ such as \"foo*\" or \"foo??bar\"." (index (loop rest (string-drop str (+ index (string-length suffix))))))) - (('? . rest) - (and (>= (string-length str) 1) - (loop rest (string-drop str 1)))) - ((('range start end) . rest) - (and (>= (string-length str) 1) - (let ((chr (string-ref str 0))) - (and (char-set-contains? (ucs-range->char-set - (char->integer start) - (+ 1 (char->integer end))) - chr) - (loop rest (string-drop str 1)))))) - ((('set . chars) . rest) + (((? char-set? cs) . rest) (and (>= (string-length str) 1) (let ((chr (string-ref str 0))) - (and (char-set-contains? (list->char-set chars) chr) + (and (char-set-contains? cs chr) (loop rest (string-drop str 1)))))) ((prefix . rest) (and (string-prefix? prefix str) diff --git a/tests/glob.scm b/tests/glob.scm index 71e2d3fce0..3134069789 100644 --- a/tests/glob.scm +++ b/tests/glob.scm @@ -23,14 +23,14 @@ (test-begin "glob") -(define-syntax test-compile-glob-pattern +(define-syntax test-string->sglob (syntax-rules (=>) ((_ pattern => result rest ...) (begin - (test-equal (format #f "compile-glob-pattern, ~s" pattern) + (test-equal (format #f "string->sglob, ~s" pattern) result - (compile-glob-pattern pattern)) - (test-compile-glob-pattern rest ...))) + (string->sglob pattern)) + (test-string->sglob rest ...))) ((_) #t))) @@ -39,14 +39,14 @@ ((_ (pattern-string matches strings ... (and not others ...)) rest ...) (begin (test-assert (format #f "glob-match? ~s" pattern-string) - (let ((pattern (compile-glob-pattern pattern-string))) + (let ((pattern (string->compiled-sglob pattern-string))) (and (glob-match? pattern strings) ... (not (glob-match? pattern others)) ...))) (test-glob-match rest ...))) ((_) #t))) -(test-compile-glob-pattern +(test-string->sglob "foo" => "foo" "?foo*" => '(? "foo" *) "foo[1-5]" => '("foo" (range #\1 #\5)) |