;TRIVIAL-TRIE - Provide a trivial trie for what needs to create but not to destroy them.
;Copyright (C) 2022 Prince Trippy <programmer@verisimilitudes.net>.

;This program is free software: you can redistribute it and/or modify it under the terms of the
;GNU Affero General Public License version 3 as published by the Free Software Foundation.

;This program 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 this program.
;If not, see <http://www.gnu.org/licenses/>.

(cl:defpackage #:trivial-trie (:use #:common-lisp) (:export #:trie #:trie-get #:trie-delete)
  (:documentation "Provide a trivial trie out of CONS, primarily for read-only access."))

(cl:in-package #:trivial-trie)

(defun trie (slot-value sequence &optional (trie nil)
             &key ((:test funcall) 'eql) ((:key function) 'identity)
             &aux (trie (or trie #0=(cons nil nil))) (cons trie))
  "Create a trie or add to another, returning the trie."
  (map nil (lambda (elt &aux (assoc (cdr (assoc elt (cdr cons) :key function :test funcall))))
             (setq cons (or assoc (cdar (push (cons elt #0#) (cdr cons))))))
       sequence)
  (prog1 trie (setf (car cons) (list slot-value))))

(defun trie-get (sequence trie &key ((:test funcall) 'eql) ((:key function) 'identity))
  "Return the stored value from a trie; a secondary value indicates whether it were present or not."
  (map nil (lambda (elt &aux (assoc (cdr (assoc elt (cdr trie) :key function :test funcall))))
             (if assoc (setq trie assoc) (return-from trie-get (values nil nil))))
       sequence)
  (if (car trie) (values (caar trie) t) (values nil nil)))

;This function which culls nodes in constant space was absurdly difficult for me to write correctly.
;I've not proven it correct, so the only reasonable option is perhaps to look at it, but not use it.
;(defun trie-delete (sequence trie &key ((:test funcall) 'eql) ((:key function) 'identity)
;                    &aux (head trie) (last trie) (cons trie))
;  "Remove the stored value from a trie, returning the trie."
;  (cond ((zerop (length sequence)) (setf (car trie) nil) (return-from trie-delete trie)))
;  (map nil (lambda (elt &aux (assoc (cdr (assoc elt (cdr cons) :key function :test funcall))))
;             (setq last (or last cons))
;             (and (cddr cons) (setq last nil head cons))
;             (and (cadadr cons) (cddadr cons) (setq last nil head cons))
;             (setq cons assoc))
;       sequence)
;  (and cons (not (car cons)) (return-from trie-delete trie))
;  (if cons (setf (car cons) nil))
;  (and last cons (setf (cdr last) nil))
;  (and head cons (setf (cdr head)
;                       (delete-if (lambda (elt) (equal elt '(nil . nil))) (cdr head) :key 'cdr)))
;  trie)

;This is an approach combining the nice trie-delete with its basic form, but for now isn't finished.
;(defun trie-delete (sequence trie &key ((:test funcall) 'eql) ((:key function) 'identity)
;                    &aux (head trie) (last trie) (cons trie))
;  "Remove the stored value from a trie, returning the trie."
;  (cond ((zerop (length sequence)) (setf (car trie) nil) (return-from trie-delete trie)))
;
;  (map nil (lambda (elt &aux (assoc (cdr (assoc elt (cdr cons) :key function :test funcall))))
;             (setq cons assoc))
;       sequence)
;  (if cons (setf (car cons) nil))
;
;  (map nil (lambda (elt &aux (assoc (cdr (assoc elt (cdr cons) :key function :test funcall))))
;             (if (or (cddr cons) (car cons)) (setq last nil head cons))
;             (setq last (or last cons) cons assoc))
;       sequence)
;
;  (and cons (not (car cons)) (return-from trie-delete trie))
;  (and last cons (setf (cdr last) nil))
;  (and head cons (setf (cdr head)
;                       (delete-if (lambda (elt) (equal elt '(nil . nil))) (cdr head) :key 'cdr)))
;
;  trie)

(defun trie-delete (sequence trie &key ((:test funcall) 'eql) ((:key function) 'identity)
                    &aux (cons trie))
  "Remove the stored value from a trie, returning the trie."
  (map nil (lambda (elt &aux (assoc (cdr (assoc elt (cdr cons) :key function :test funcall))))
             (setq cons assoc))
       sequence)
  (if cons (setf (car cons) nil))
  trie)
.