;;; benchmark.el ---                                 -*- lexical-binding: t; -*-

;; Copyright (C) 2021  Arthur Miller

;; Author: Arthur Miller <arthur.miller@live.com>
;; Keywords: 

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; 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 General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; 

;;; Code:
(defun ff-print (map)
  (maphash (lambda (k v) (print (format "%s: %s" k v))) map))

(defvar ff-srcs nil
  "Cash list of source files.")
(defvar ff-lmap nil
  "Load paths")
(defvar ff-pmap nil
  "Provided features")
(defvar ff-vmap nil
  "Variables")
(defvar ff-fmap nil
  "Functions and macros")

(defun ff-save-db (db-file)
  (with-temp-file db-file
    (prin1 ff-lmap (current-buffer))
    (prin1 ff-pmap (current-buffer))
    (prin1 ff-vmap (current-buffer))
    (prin1 ff-fmap (current-buffer))))

(defun ff-read-db (db-file)
  (with-temp-buffer
    (insert-file-contents db-file)
    (goto-char (point-min))
    (setq ff-lmap (read (current-buffer))
          ff-pmap (read (current-buffer))
          ff-vmap (read (current-buffer))
          ff-fmap (read (current-buffer)))))

(defun ff-collect-features (src index)
  (let (sxp)
    (with-current-buffer (get-buffer-create "*ff-buffer*")
      (erase-buffer)
      (insert-file-contents src)
      (goto-char (point-min))
      (while (setq sxp (ignore-errors (read (current-buffer))))
        (when (listp sxp)
          (cond ((or (equal (car sxp) 'defun)
                     (equal (car sxp) 'defmacro))
                 (puthash (cadr sxp) index ff-fmap))
                ((or (equal (car sxp) 'defvar)
                     (equal (car sxp) 'defcustom))
                 (puthash (cadr sxp) index ff-vmap))
                ((equal (car sxp) 'provide)
                 (puthash (cadr sxp) index ff-pmap))))))))

(defun ff-build-db (dir-tree)
  ;;(when (or (not ff-srcs) (equal (car ff-srcs) dir-tree))
      (setq ff-srcs (cons dir-tree (directory-files-recursively dir-tree "\\.el$"))
            ff-lmap (make-hash-table :test 'equal)
            ff-vmap (make-hash-table :test 'equal)
            ff-fmap (make-hash-table :test 'equal)
            ff-pmap (make-hash-table :test 'equal))
      ;; )
  (let ((index 0))
    (dolist (src (cdr ff-srcs))
      (puthash index src ff-lmap)
      (ff-collect-features src index)
      (setq index (1+ index)))))

(defun ff-build-emacs-db ()
  (ff-build-db (expand-file-name "lisp/" source-directory))
  (ff-save-db (expand-file-name "ff-db-emacs" user-emacs-directory)))

(defun ff-build-package-db ()
  (ff-build-db (expand-file-name "elpa/" user-emacs-directory))
  (ff-save-db (expand-file-name "ff-db-packages" user-emacs-directory)))



(defun find-dialogues()
  (let (beg end dialogues)
    (with-temp-buffer
      (insert-file-contents-literally "Plato.org")
      (goto-char (point-min))
      (while (re-search-forward "^[ t]*\\*\\* Dialogue" nil t)
        (setq beg (point))
        (re-search-forward "-THE END-" nil t)
        (goto-char (line-beginning-position))
        (setq end (point))
        (push (cons beg end) dialogues)))
    (nreverse dialogues)))

(defun count-words-in-dialogues ()
  (let ((words 0))
    (with-temp-buffer
      (insert-file-contents-literally "Plato.org")
      (save-excursion
        (dolist (dlg (find-dialogues))
          (goto-char (car dlg))
          (while (re-search-forward "\\sw+" (cdr dlg) t)
            (setq words (1+ words))))
        words))))

(defun count-names-freq ()
  (let ((names (make-hash-table :test 'equal)))
    (with-temp-buffer
      (insert-file-contents-literally "Plato.org")
      (save-excursion
        (dolist (dlg (find-dialogues))
          (goto-char (car dlg))
          (while (re-search-forward "^[A-Za-z]*:" (cdr dlg) t)
            (let ((count (or (cdr (gethash (match-string 0) names)) 0)))
              (puthash (match-string 0)
                       (cons (match-string-no-properties 0) (1+ count))
                       names)))))
      names)))

(defun count-socrates ()
  (let ((words 0))
    (with-temp-buffer
      (insert-file-contents-literally "Plato.org")
      (save-excursion
        (dolist (dlg (find-dialogues))
          (goto-char (car dlg))
          (while (re-search-forward "[Ss]ocrates" (cdr dlg) t)
            (setq words (1+ words))))
        words))))

(benchmark-run 10 (count-words-in-dialogues))
(benchmark-run 10 (count-names-freq))
(benchmark-run 10 (count-socrates))
(benchmark-run (ff-build-emacs-db))
(benchmark-run (ff-build-package-db))

(provide 'benchmark)
;;; benchmark.el ends here