diff --git a/Makefile b/Makefile index 6cb10b72..c74b0186 100644 --- a/Makefile +++ b/Makefile @@ -47,11 +47,11 @@ BASE_INCLUDES = include/chibi/sexp.h include/chibi/features.h include/chibi/inst INCLUDES = $(BASE_INCLUDES) include/chibi/eval.h include/chibi/gc_heap.h MODULE_DOCS := app ast base64 bytevector config crypto/md5 crypto/rsa \ - crypto/sha2 diff disasm doc equiv filesystem generic heap-stats io \ - iset/base iset/constructors iset/iterators loop match math/prime \ - memoize mime modules net net/http-server net/servlet parse pathname \ - process repl scribble string stty sxml system temp-file test time \ - trace type-inference uri weak monad/environment crypto/sha2 + crypto/sha2 diff disasm doc edit-distance equiv filesystem generic \ + heap-stats io iset/base iset/constructors iset/iterators loop \ + match math/prime memoize mime modules net net/http-server net/servlet \ + parse pathname process repl scribble string stty sxml system temp-file \ + test time trace type-inference uri weak monad/environment crypto/sha2 IMAGE_FILES = lib/chibi.img lib/red.img lib/snow.img @@ -496,6 +496,7 @@ snowballs: $(SNOW_CHIBI) package lib/chibi/crypto/rsa.sld $(SNOW_CHIBI) package lib/chibi/crypto/sha2.sld $(SNOW_CHIBI) package lib/chibi/diff.sld + $(SNOW_CHIBI) package lib/chibi/edit-distance.sld $(SNOW_CHIBI) package lib/chibi/filesystem.sld $(SNOW_CHIBI) package lib/chibi/math/prime.sld $(SNOW_CHIBI) package lib/chibi/mime.sld diff --git a/doc/chibi.scrbl b/doc/chibi.scrbl index ba523269..f996c499 100755 --- a/doc/chibi.scrbl +++ b/doc/chibi.scrbl @@ -1303,6 +1303,8 @@ namespace. \item{\hyperlink["lib/chibi/doc.html"]{(chibi doc) - Chibi documentation utilities}} +\item{\hyperlink["lib/chibi/edit-distance.html"]{(chibi edit-distance) - A levenshtein distance implementation}} + \item{\hyperlink["lib/chibi/equiv.html"]{(chibi equiv) - A version of \scheme{equal?} which is guaranteed to terminate}} \item{\hyperlink["lib/chibi/filesystem.html"]{(chibi filesystem) - Interface to the filesystem and file descriptor objects}} diff --git a/lib/chibi/app.scm b/lib/chibi/app.scm index 178e31df..f88adcd7 100644 --- a/lib/chibi/app.scm +++ b/lib/chibi/app.scm @@ -339,11 +339,30 @@ (cond ((and (= 2 (length prefix))) '()) ((null? prefix) '()) (else (reverse (cdr (reverse prefix)))))) + (define (all-opt-names opt-spec) + ;; TODO: nested options + (let lp ((ls opt-spec) (res '())) + (if (null? ls) + (map (lambda (x) (if (symbol? x) (symbol->string x) x)) + (remove char? (reverse res))) + (let ((o (car ls))) + (lp (cdr ls) + (append (if (and (pair? (cddr o)) (pair? (third o))) + (third o) + '()) + (cons (car o) res))))))) (let ((fail (if (pair? o) (car o) (lambda (prefix spec opt args reason) - ;; TODO: search for closest option in "unknown" case - (error reason opt))))) + (cond + ((and (string=? reason "unknown option") + (find-nearest-edits opt (all-opt-names spec))) + => (lambda (similar) + (if (pair? similar) + (error reason opt "Did you mean: " similar) + (error reason opt)))) + (else + (error reason opt))))))) (cond ((null? spec) (error "no procedure in application spec")) diff --git a/lib/chibi/app.sld b/lib/chibi/app.sld index 7292ef95..dcc5cdb1 100644 --- a/lib/chibi/app.sld +++ b/lib/chibi/app.sld @@ -9,5 +9,6 @@ (scheme process-context) (srfi 1) (chibi config) + (chibi edit-distance) (chibi string)) (include "app.scm")) diff --git a/lib/chibi/edit-distance.sld b/lib/chibi/edit-distance.sld index 382fa346..c2826d9d 100644 --- a/lib/chibi/edit-distance.sld +++ b/lib/chibi/edit-distance.sld @@ -1,9 +1,15 @@ (define-library (chibi edit-distance) - (export edit-distance) + (export edit-distance find-nearest-edits) (import (scheme base) (srfi 130)) (begin - ;; levenshtein (quadratic time, linear memory) + ;;> Returns the levenshtein distance between s1 and s2 - a cost of + ;;> 1 per character insertion, deletion or update. Runs in + ;;> quadratic time and linear memory. + ;;> + ;;> \example{(edit-distance "same" "same")} + ;;> \example{(edit-distance "same" "sand")} + ;;> \example{(edit-distance "Saturday" "Sunday")} (define (edit-distance s1 s2) (let* ((len1 (string-length s1)) (len2 (string-length s2)) @@ -29,4 +35,18 @@ (if (eqv? ch1 ch2) 0 1)))) (lp (+ j 1) (string-cursor-next s1 sc1) - old-diag)))))))))) + old-diag)))))))) + ;;> Returns a list of strings in \var{str-ls} with the smallest + ;;> edit distance to \var{str}, preserving order. If + ;;> \var{max-distance} is provided and positive, only return if + ;;> the edits are less or equal to that distance. + (define (find-nearest-edits str str-ls . o) + (let ((max-distance (if (pair? o) (car o) 1e100))) + (let lp ((ls str-ls) (dist (+ max-distance 1)) (res '())) + (if (null? ls) + (reverse res) + (let ((ed (edit-distance str (car ls)))) + (cond + ((= ed dist) (lp (cdr ls) dist (cons (car ls) res))) + ((< ed dist) (lp (cdr ls) ed (list (car ls)))) + (else (lp (cdr ls) dist res))))))))))