;COUNTING-COFFEE - An example of tabular programming with the goal of unstructured data summation.
;Copyright (C) 2023 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/>.

;I attempted to write a RESTART-REDUCE macro that would encapsulate the prime loop of this function.
;It was a foolish effort; writing Common Lisp that tries to do this well is usually a fool's errand.
;It's always easier to write the code out manually than write some macro only useful in one program.
(defun counting (list &optional trie &aux slot-value (count 0))
  (assert (and (listp list) (every (lambda (elt) (typep elt 'sequence)) list))
          (list) "The first argument to COUNTING must be a list with elements of type SEQUENCE.")
  (dolist (elt list (values count trie))
    (loop (setq slot-value (trivial-trie:trie-get elt trie :test 'string=))
          (cond ((integerp slot-value) (incf count slot-value) (return))
                (t (restart-case (error "No good value was found for the following record:~%~S" elt)
                     (store-value (use-value)
                       :report "Provide a count for the record."
                       :interactive (lambda ()
                                      (format *query-io* "~&~A~%" elt)
                                      (with-standard-io-syntax (let (*read-eval*)
                                                                 (list (read *query-io*)))))
                       (setq trie (trivial-trie:trie use-value elt trie :test 'string=)))))))))
.