libsuffix.scm 1.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. ;;;
  2. ;;; Procedures to allow the manipulation of suffixes
  3. ;;;
  4. ;;; Copyright 2016 Jason K. MacDuffie
  5. ;;; License: GPLv3+
  6. ;;;
  7. (import (scheme base)
  8. (scheme write)
  9. (srfi 1))
  10. (define-record-type <suffix>
  11. (suffix id prefix-list suffix-list)
  12. suffix?
  13. ;; id is a symbol
  14. (id suffix-id)
  15. ;; prefix-list is a list of prefixes
  16. (prefix-list suffix-pre)
  17. ;; suffix-list is a list of alternative suffixes
  18. (suffix-list suffix-suf))
  19. (define (list->suffix l)
  20. (apply suffix l))
  21. (define (suffix->list s)
  22. (list (suffix-id s)
  23. (suffix-pre s)
  24. (suffix-suf s)))
  25. (define (select-suffix sym)
  26. ;; From a list of suffixes, select by id
  27. (let loop ((in suffixes))
  28. (if (null? in)
  29. #f
  30. (if (eq? sym (suffix-id (car in)))
  31. (car in)
  32. (loop (cdr in))))))
  33. (define (print-suffix s)
  34. ;; Display all combinations of prefix and suffixes
  35. (for-each (lambda (b)
  36. (for-each (lambda (a)
  37. (display (string-append a b " ")))
  38. (suffix-pre s)))
  39. (suffix-suf s)))
  40. (define (suffix-length s)
  41. ;; Find the number of prefixes of a suffix
  42. (length (suffix-pre s)))
  43. (define (filter-large-suffix n)
  44. ;; Returns a list with large suffixes
  45. (filter (lambda (s)
  46. (> (suffix-length s) n))
  47. suffixes))
  48. (define (suffix-valid-prefixes? s)
  49. ;; Check if all the prefixes for s are in prefixes
  50. (let loop ((in (suffix-pre s)))
  51. (if (null? in)
  52. #t
  53. (if (member (car in) prefixes)
  54. (loop (cdr in))
  55. #f))))
  56. (define suffixes '())