1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768 |
- ;;;
- ;;; Procedures to allow the manipulation of suffixes
- ;;;
- ;;; Copyright 2016 Jason K. MacDuffie
- ;;; License: GPLv3+
- ;;;
- (import (scheme base)
- (scheme write)
- (srfi 1))
- (define-record-type <suffix>
- (suffix id prefix-list suffix-list)
- suffix?
- ;; id is a symbol
- (id suffix-id)
- ;; prefix-list is a list of prefixes
- (prefix-list suffix-pre)
- ;; suffix-list is a list of alternative suffixes
- (suffix-list suffix-suf))
- (define (list->suffix l)
- (apply suffix l))
- (define (suffix->list s)
- (list (suffix-id s)
- (suffix-pre s)
- (suffix-suf s)))
- (define (select-suffix sym)
- ;; From a list of suffixes, select by id
- (let loop ((in suffixes))
- (if (null? in)
- #f
- (if (eq? sym (suffix-id (car in)))
- (car in)
- (loop (cdr in))))))
- (define (print-suffix s)
- ;; Display all combinations of prefix and suffixes
- (for-each (lambda (b)
- (for-each (lambda (a)
- (display (string-append a b " ")))
- (suffix-pre s)))
- (suffix-suf s)))
- (define (suffix-length s)
- ;; Find the number of prefixes of a suffix
- (length (suffix-pre s)))
- (define (filter-large-suffix n)
- ;; Returns a list with large suffixes
- (filter (lambda (s)
- (> (suffix-length s) n))
- suffixes))
- (define (suffix-valid-prefixes? s)
- ;; Check if all the prefixes for s are in prefixes
- (let loop ((in (suffix-pre s)))
- (if (null? in)
- #t
- (if (member (car in) prefixes)
- (loop (cdr in))
- #f))))
- (define suffixes '())
|