;;; eval-expr.el --- Simple eval-expruation benchmark for byte-switch  -*- lexical-binding: t; -*-

;; Copyright (C) 2017  Clément Pit-Claudel

;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(require 'cl-lib)

(defun ~/eval-expr (expr context)
  "Eval EXPR in CONTEXT."
  (pcase expr
    (`(const ,c)
     c)
    (`(var ,x)
     (alist-get x context))
    (`(unop ,op ,expr)
     (let ((res (~/eval-expr expr context)))
       (pcase op
         (`+ res)
         (`- (- res))
         (`! (lognot res)))))
    (`(binop ,op ,l ,r)
     (let ((lres (~/eval-expr l context))
           (rres (~/eval-expr r context)))
       (pcase op
         (`+ (+ lres rres))
         (`- (- lres rres))
         (`* (* lres rres)))))))

(defun ~/size (expr)
  "Compute the size of EXPR."
  (pcase expr
    ((or `(const ,_) `(var ,_)) 1)
    (`(unop ,_ ,expr)
     (1+ (~/size expr)))
    (`(binop ,_ ,l ,r)
     (+ 1 (~/size l) (~/size r)))))

(defun ~/mkexpr-1 (const-t var-t unop-t binop-t vars max-depth)
  (cl-decf max-depth)
  (let ((rnd (random binop-t)))
    (cond
     ((or (< rnd const-t) (= max-depth 0))
      `(const ,(random 1000)))
     ((< rnd var-t)
      `(var ,(aref vars (random (length vars)))))
     ((< rnd unop-t)
      `(unop ,(aref [+ - !] (random 3))
             ,(~/mkexpr-1 const-t var-t unop-t binop-t vars max-depth)))
     ((< rnd binop-t)
      `(binop ,(aref [+ - *] (random 3))
              ,(~/mkexpr-1 const-t var-t unop-t binop-t vars max-depth)
              ,(~/mkexpr-1 const-t var-t unop-t binop-t vars max-depth))))))

(defun ~/mkexpr (const-p var-p unop-p binop-p vars max-depth)
  (let* ((const-t const-p)
         (var-t (+ const-t var-p))
         (unop-t (+ var-t unop-p))
         (binop-t (+ unop-t binop-p)))
    (~/mkexpr-1 const-t var-t unop-t binop-t vars max-depth)))

(defvar ~/exprs nil)

(defun ~/init-exprs ()
  (setq ~/exprs nil)
  (dotimes (_ 5000)
    (push (~/mkexpr 1 1 2 4 [a b c] 15) ~/exprs)))

(defun ~/benchmark ()
  (apply #'+ (mapcar #'~/size ~/exprs))
  (mapc (lambda (e) (~/eval-expr e '((a . 1) (b . 2) (c . 3)))) ~/exprs))

(provide 'eval-expr)
;;; eval-expr.el ends here