diff options
author | Danny Milosavljevic <dannym@scratchpost.org> | 2021-02-11 19:12:36 +0100 |
---|---|---|
committer | Danny Milosavljevic <dannym@scratchpost.org> | 2021-02-11 19:12:36 +0100 |
commit | abd318ff4b741eac11227778bf2e569ee7b186ff (patch) | |
tree | 6abc09a3e01914d891124e9d0dda0f4e0979c485 /guix/utils.scm | |
parent | 71cb6dfe10540718eb337e7e2248fc809394894b (diff) | |
parent | c5dc87fee840ad620b01637dc4f9ffa5efc9270c (diff) | |
download | guix-patches-abd318ff4b741eac11227778bf2e569ee7b186ff.tar guix-patches-abd318ff4b741eac11227778bf2e569ee7b186ff.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/utils.scm')
-rw-r--r-- | guix/utils.scm | 47 |
1 files changed, 46 insertions, 1 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index edc3503c10..96cd8c791e 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,6 +41,7 @@ #:select (dump-port mkdir-p delete-file-recursively call-with-temporary-output-file %xz-parallel-args)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) + #:use-module ((guix combinators) #:select (fold2)) #:use-module (guix diagnostics) ;<location>, &error-location, etc. #:use-module (ice-9 format) #:use-module (ice-9 regex) @@ -119,7 +121,10 @@ call-with-decompressed-port compressed-output-port call-with-compressed-output-port - canonical-newline-port)) + canonical-newline-port + + string-distance + string-closest)) ;;; @@ -881,6 +886,46 @@ be determined." ;; raising an error would upset Geiser users #f)))))) + +;;; +;;; String comparison. +;;; + +(define (string-distance s1 s2) + "Compute the Levenshtein distance between two strings." + ;; Naive implemenation + (define loop + (mlambda (as bt) + (match as + (() (length bt)) + ((a s ...) + (match bt + (() (length as)) + ((b t ...) + (if (char=? a b) + (loop s t) + (1+ (min + (loop as t) + (loop s bt) + (loop s t)))))))))) + + (let ((c1 (string->list s1)) + (c2 (string->list s2))) + (loop c1 c2))) + +(define* (string-closest trial tests #:key (threshold 3)) + "Return the string from TESTS that is the closest from the TRIAL, +according to 'string-distance'. If the TESTS are too far from TRIAL, +according to THRESHOLD, then #f is returned." + (identity ;discard second return value + (fold2 (lambda (test closest minimal) + (let ((dist (string-distance trial test))) + (if (and (< dist minimal) (< dist threshold)) + (values test dist) + (values closest minimal)))) + #f +inf.0 + tests))) + ;;; Local Variables: ;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1) ;;; End: |