(defun Benchmark

    ;;=================================================================
    ;;
    ;;  Benchmark.lsp | © 2005 Michael Puckett | All Rights Reserved
    ;;
    ;;=================================================================
    ;;
    ;;  Purpose:
    ;;
    ;;      Compare the performance of various statements.
    ;;
    ;;  Notes:
    ;;
    ;;      I make no claims that this is definitive benchmarking. I
    ;;      wrote this utility for my own purposes and thought I'd
    ;;      share it. Many considerations go into evaluating the
    ;;      performance or suitability of an algorythm for a given
    ;;      task. Raw performance as profiled herein is just one.
    ;;
    ;;      Please note that background dramatically affect results.
    ;;
    ;;  Disclaimer:
    ;;
    ;;      This program is flawed in one or more ways and is not fit
    ;;      for any particular purpose, stated or implied. Use at your
    ;;      own risk.
    ;;
    ;;=================================================================
    ;;
    ;;  Syntax:
    ;;
    ;;      (Benchmark statements)
    ;;
    ;;          Where statements is a quoted list of statements.
    ;;
    ;;=================================================================
    ;;
    ;;  Example:
    ;;
    ;;      (BenchMark
    ;;         '(
    ;;              (1+ 1)
    ;;              (+ 1 1)
    ;;              (+ 1 1.0)
    ;;              (+ 1.0 1.0)
    ;;          )
    ;;      )
    ;;
    ;;=================================================================
    ;;
    ;;  Output:
    ;;
    ;;      Elapsed milliseconds / relative speed for 32768 iteration(s):
    ;;
    ;;          (1+ 1)..........1969 / 1.09 <fastest>
    ;;          (+ 1 1).........2078 / 1.03
    ;;          (+ 1 1.0).......2125 / 1.01
    ;;          (+ 1.0 1.0).....2140 / 1.00 <slowest>    
    ;;
    ;;=================================================================

    (
        statements
        /
        _LSet
        _RSet
        _ToString
        _Eval
        _Princ
        _Main
    )

    ;;=================================================================
    ;;
    ;;  (_LSet text len fillChar)
    ;;
    ;;=================================================================

    (defun _LSet ( text len fillChar / padding result )

        (setq
            padding (list (ascii fillChar))
            result  (vl-string->list text)
        )

        (while
            (<  (length
                    (setq padding
                        (append padding padding)
                    )
                )
                len
            )
        )

        (while
            (<  (length
                    (setq result
                        (append result padding)
                    )
                )
                len
            )
        )

        (substr (vl-list->string result) 1 len)

    )

    ;;=================================================================
    ;;
    ;;  (_RSet text len fillChar)
    ;;
    ;;=================================================================

    (defun _RSet ( text len fillChar / padding result )

        (setq
            padding (list (ascii fillChar))
            result  (vl-string->list text)
        )

        (while
            (<  (length
                    (setq padding
                        (append padding padding)
                    )
                )
                len
            )
        )

        (while
            (<  (length
                    (setq result
                        (append padding result)
                    )
                )
                len
            )
        )

        (substr
            (vl-list->string result)
            (1+ (- (length result) len))
        )

    )

    ;;=================================================================
    ;;
    ;;  (_ToString x)
    ;;
    ;;=================================================================

    (defun _ToString ( x / result )
        (if
            (<  (strlen
                    (setq result
                        (vl-prin1-to-string x)
                    )
                )
                40
            )
            result
            (strcat (substr result 1 36) "..." (chr 41))
        )
    )

    ;;=================================================================
    ;;
    ;;  (_Eval statement iterations)
    ;;
    ;;=================================================================

    (defun _Eval ( statement iterations / start )

        (gc)
        (setq start (getvar "millisecs"))
        (repeat iterations (eval statement))
        (- (getvar "millisecs") start)

    )

    ;;=================================================================
    ;;
    ;;  (_Princ x)
    ;;
    ;;=================================================================

    (defun _Princ ( x )
        (princ x)
        (princ) ;; forces screen update
    )

    ;;=================================================================
    ;;
    ;;  (_Main statements)
    ;;
    ;;=================================================================

    (defun _Main

        (   statements
            /
            boundary
            iterations
            timings
            slowest
            fastest
            lsetLen
            rsetLen
            index
            count
        )

        (setq
            boundary   1000
            iterations 1
        )

        (_Princ "Benchmarking ...")

        (while
            (or
                (<  (apply 'max
                        (setq timings
                            (mapcar
                               '(lambda (statement)
                                    (_Eval statement iterations)
                                )
                                statements
                            )
                        )
                    )
                    boundary
                )
                (<  (apply 'min timings)
                    boundary
                )
            )
            (setq iterations
                (* 2 iterations)
            )
            (_Princ ".")
        )

        (_Princ
            (strcat
                "\rElapsed milliseconds / relative speed for "
                (itoa iterations)
                " iteration(s):\n\n"
            )
        )

        (setq
            slowest (float (apply 'max timings))
            fastest (apply 'min timings)
        )

        (setq lsetLen
            (+ 5
                (apply 'max
                    (mapcar 'strlen
                        (setq statements
                            (mapcar '_ToString
                                statements
                            )
                        )
                    )
                )
            )
        )

        (setq rsetLen
            (apply 'max
                (mapcar
                   '(lambda (ms) (strlen (itoa ms)))
                    timings
                )
            )
        )

        (setq
            index 0
            count (length statements)
        )

        (foreach pair

            (vl-sort
                (mapcar 'cons statements timings)
               '(lambda (a b) (< (cdr a) (cdr b)))
            )

            (   (lambda ( pair / ms )
                    (_Princ
                        (strcat
                            "    "
                            (_LSet (car pair) lsetLen ".")
                            (_RSet
                                (itoa (setq ms (cdr pair)))
                                rsetLen
                                "."
                            )
                            " / "
                            (rtos (/ slowest ms) 2 2)
                            (cond
                                ((eq 1 (setq index (1+ index))) " <fastest>")
                                ((eq index count) " <slowest>")
                                ("")
                            )
                            "\n"
                        )
                    )
                )
                pair
            )
        )

        (princ)

    )

    ;;=================================================================
    ;;
    ;;  Program is defined, let's rock and roll ...
    ;;
    ;;=================================================================

    (_Main statements)

)