(module stemmer

(available-stemmers make-stemmer stem)

(import scheme (chicken base) (chicken foreign))
(import srfi-4)
(import (chicken blob) (chicken memory) (chicken locative) (chicken gc))

(foreign-declare "#include <libstemmer.h>")

(define-record stemmer pointer)
(define %make-stemmer make-stemmer)

(define (available-stemmers)
  (map string->symbol ((foreign-lambda c-string-list sb_stemmer_list))))

(define (delete-stemmer stemmer)
  (and-let* ((stemmer* (stemmer-pointer stemmer)))
    ((foreign-lambda void sb_stemmer_delete
       (c-pointer (struct "sb_stemmer")))
     stemmer*)
    (stemmer-pointer-set! stemmer #f)))

(define (make-stemmer algorithm #!optional (encoding "UTF_8"))
  (and-let* ((stemmer* ((foreign-lambda (c-pointer (struct "sb_stemmer"))
                            sb_stemmer_new
                          c-string
                          c-string)
                        (symbol->string algorithm) encoding)))
    (set-finalizer! (%make-stemmer stemmer*) delete-stemmer))) 

(define (stem stemmer word)
  (let* ((stemmer* (stemmer-pointer stemmer))
         (word* (blob->u8vector/shared (string->blob word)))
         (stem* ((foreign-lambda (c-pointer "sb_symbol")
                     sb_stemmer_stem
                   (c-pointer (struct "sb_stemmer"))
                   (c-pointer "sb_symbol")
                   int)
                 stemmer*
                 (make-locative word*)
                 (string-length word)))
         (length ((foreign-lambda int
                      sb_stemmer_length
                    (c-pointer (struct "sb_stemmer")))
                  stemmer*))
         (result (make-u8vector length)))
    (move-memory! stem* result length)
    (blob->string (u8vector->blob/shared result))))

)