Initial commit
This commit is contained in:
commit
1080c0e513
7 changed files with 124 additions and 0 deletions
36
abbrev.scm
Normal file
36
abbrev.scm
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
;;; Abbrev library for R7RS Scheme.
|
||||
;;; Calculate the set of unique abbreviations for a given set of
|
||||
;;; words. (Borrowed from Ruby's Abbrev.)
|
||||
|
||||
;;; SPDX-License-Identifier: LicenseRef-OWL-0.9.4
|
||||
;;; SPDX-FileCopyrightText: 2017 Peter Lane
|
||||
;;; SPDX-FileCopyrightText: 2025 afiw <afiw@linuxposting.xyz>
|
||||
|
||||
;; input: a list of strings
|
||||
;; and an optional string prefix
|
||||
;; output: list of (abbrev . string) dotted pairs
|
||||
|
||||
(define (abbrev strings #!optional prefix)
|
||||
(let loop ((abbrevs '())
|
||||
(seen '())
|
||||
(words strings)
|
||||
(idx 1))
|
||||
(cond ((null? words) ; done
|
||||
abbrevs)
|
||||
((or (and prefix (not (string-prefix? prefix (car words)))) ; does not match prefix
|
||||
(> idx (string-length (car words)))) ; or at end of word, so go to next word
|
||||
(loop abbrevs
|
||||
seen
|
||||
(cdr words)
|
||||
1))
|
||||
(else
|
||||
(let ((new-abbrev (substring (car words) 0 idx)))
|
||||
(if (member new-abbrev seen string=?) ; if seen abbrev before
|
||||
(loop (remove (lambda (w) (string=? new-abbrev (car w))) abbrevs) ; delete from abbrevs
|
||||
seen ; but keep in seen
|
||||
words
|
||||
(+ 1 idx))
|
||||
(loop (cons (cons new-abbrev (car words)) abbrevs) ; not seen before, so add to abbrevs
|
||||
(cons new-abbrev seen) ; and store in seen
|
||||
words
|
||||
(+ 1 idx))))))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue