Initial commit

This commit is contained in:
cælōrum spectātrīx 2025-12-04 12:00:40 +01:00
commit 1080c0e513
7 changed files with 124 additions and 0 deletions

5
.gitignore vendored Normal file
View file

@ -0,0 +1,5 @@
*.so
*.o
*.import.scm
*.link
*.sh

24
COPYING Normal file
View file

@ -0,0 +1,24 @@
# Open Works License
This is version 0.9.4 of the Open Works License
## Terms
Permission is hereby granted by the holder(s) of copyright or other legal
privileges, author(s) or assembler(s), and contributor(s) of this work, to any
person who obtains a copy of this work in any form, to reproduce, modify,
distribute, publish, sell, sublicense, use, and/or otherwise deal in the
licensed material without restriction, provided the following conditions are
met:
Redistributions, modified or unmodified, in whole or in part, must retain
applicable copyright and other legal privilege notices, the above license
notice, these conditions, and the following disclaimer.
NO WARRANTY OF ANY KIND IS IMPLIED BY, OR SHOULD BE INFERRED FROM, THIS LICENSE
OR THE ACT OF DISTRIBUTION UNDER THE TERMS OF THIS LICENSE, INCLUDING BUT NOT
LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE,
AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS, ASSEMBLERS, OR HOLDERS OF
COPYRIGHT OR OTHER LEGAL PRIVILEGE BE LIABLE FOR ANY CLAIM, DAMAGES, OR OTHER
LIABILITY, WHETHER IN ACTION OF CONTRACT, TORT, OR OTHERWISE ARISING FROM, OUT
OF, OR IN CONNECTION WITH THE WORK OR THE USE OF OR OTHER DEALINGS IN THE WORK.

8
abbrev.egg Normal file
View file

@ -0,0 +1,8 @@
;; -*- lisp-data -*-
((synopsis "Create unique abbreviations for a list of strings")
(license "LicenseRef-OWL-0.9.4")
(category misc)
(test-dependencies test)
(maintainer "Lilianna Smólska")
(author "Peter Lane, Lilianna Smólska")
(components (extension abbrev (source "abbrev.sld"))))

4
abbrev.release-info Normal file
View file

@ -0,0 +1,4 @@
;; -*- lisp-data -*-
(repo git "git://git.linuxposting.xyz/afiw/chicken-abbrev.git")
(uri targz "https://git.linuxposting.xyz/afiw/chicken-abbrev/archive/{egg-release}.tar.gz")
(release "1.0")

36
abbrev.scm Normal file
View 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))))))))

14
abbrev.sld Normal file
View file

@ -0,0 +1,14 @@
;;; 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: (c) 2017 Peter Lane
;;; SPDX-FileCopyrightText: (c) 2025 afiw <afiw@linuxposting.xyz>
(define-library (abbrev)
(import (scheme base)
(only (srfi-1) remove)
(only (srfi-13) string-prefix?))
(export abbrev)
(include "abbrev.scm"))

33
tests/run.scm Normal file
View file

@ -0,0 +1,33 @@
;;; Abbrev library for R7RS Scheme.
;;; SPDX-License-Identifier: LicenseRef-OWL-0.9.4
;;; SPDX-FileCopyrightText: 2025 afiw <afiw@linuxposting.xyz>
(import (abbrev)
(test))
(test "original example"
'(("lisp" . "lisp")
("lis" . "lisp")
("li" . "lisp")
("l" . "lisp")
("scala" . "scala")
("scal" . "scala")
("sca" . "scala")
("scheme" . "scheme")
("schem" . "scheme")
("sche" . "scheme")
("sch" . "scheme"))
(abbrev '("scheme" "scala" "lisp")))
(test "original example with prefix"
'(("scala" . "scala")
("scal" . "scala")
("sca" . "scala")
("scheme" . "scheme")
("schem" . "scheme")
("sche" . "scheme")
("sch" . "scheme"))
(abbrev '("scheme" "scala" "lisp") "s"))
(test-assert "empty list" (null? (abbrev '())))
(test "single-element list" '(("c" . "c")) (abbrev '("c")))
(test-assert "identical elements" (null? (abbrev '("c" "c"))))
(test-error "non-list argument" (abbrev ""))
(test-error "non-string element" (abbrev '(())))
(test-exit)