;;; Nani Project website

;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>

;;;

;;; This file is part of the Nani Project website.

;;;

;;; The Nani Project website is free software; you can redistribute it and/or modify it

;;; under the terms of the GNU Affero General Public License as published by

;;; the Free Software Foundation; either version 3 of the License, or (at

;;; your option) any later version.

;;;

;;; The Nani Project website is distributed in the hope that it will be useful, but

;;; WITHOUT ANY WARRANTY; without even the implied warranty of

;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

;;; GNU Affero General Public License for more details.

;;;

;;; You should have received a copy of the GNU Affero General Public License

;;; along with the Nani Project website.  If not, see <http://www.gnu.org/licenses/>.

(define-module (nani trie)

  #:use-module (srfi srfi-9)

  #:export (make-trie

            trie?

            trie-position

            trie-position-set!

            trie-vals

            trie-vals-set!

            trie-transitions

            trie-transitions-set!

            make-empty-trie

            add-to-trie!

            compress-trie))

(define-record-type trie

  (make-trie position vals transitions)

  trie?

  (position trie-position trie-position-set!) ; integer

  (vals trie-vals trie-vals-set!) ; list

  (transitions trie-transitions trie-transitions-set!)) ; array or alist

(define (make-empty-trie)

  (make-trie 0 '() (make-array #f 16)))

(define (add-to-trie! trie key value)

  (if (null? key)

    (trie-vals-set! trie (cons value (trie-vals trie)))

    (let ((next-trie (array-ref (trie-transitions trie) (car key))))

      (if next-trie

          (add-to-trie! next-trie (cdr key) value)

          (let ((next-trie (make-empty-trie)))

            (array-set! (trie-transitions trie) next-trie (car key))

            (add-to-trie! next-trie (cdr key) value))))))

(define (convert-trie-transitions! trie)

  (define (get-new-transitions transitions)

    (let loop ((i 0) (tr '()))

      (if (= i 16)

        tr

        (let ((elem (array-ref transitions i)))

          (if elem

            (begin

              (convert-trie-transitions! elem)

              (loop (+ i 1) (cons (cons i elem) tr)))

            (loop (+ i 1) tr))))))

  (let* ((transitions (trie-transitions trie))

         (transitions (get-new-transitions transitions)))

    (trie-transitions-set! trie transitions)))

(define (compress-trie trie)

  (define (compress-aux trie)

    (make-trie

      (trie-position trie)

      (trie-vals trie)

      (apply append

        (map

          (lambda (tr)

            (let ((trie (cdr tr)))

              (map

                (lambda (tr2)

                  (cons (+ (car tr2) (* 16 (car tr)))

                        (compress-aux (cdr tr2))))

                (trie-transitions trie))))

          (trie-transitions trie)))))

  (convert-trie-transitions! trie)

  (compress-aux trie))