(in-package :monkey)

(defparameter *tests* (make-hash-table))
(defparameter *test-name* nil)

(eval-always
  (defun make-tokens (&rest tokens)
    (loop :for token :in tokens
          :if (consp token)
            :collect (make-token (car token) (cadr token))
          :if (typep token 'token-type)
            :collect (as-token token)))

  (defun test-lexer (str expected-tokens)
    (labels ((expected-next ()
               (prog1 (car expected-tokens)
                 (setf expected-tokens (cdr expected-tokens)))))
      (format t "Testing ~s..." *test-name*)
      (let* ((lexer (make-lexer str))
             (tokens (lexer-tokens lexer))
             (expected-token (expected-next))
             (ok t))
        (loop :for token :in tokens
              :for i :from 1
              :if (not (token= token expected-token))
                :do (format t "~&token ~d: expected ~a but got ~a~%" i expected-token token)
                    (setf ok nil)
              :else :do (setf expected-token (expected-next)))
        (unless (null ok)
          (format t " ok~%")))))

  (defun tokenize (designator)
    (cond ((typep designator 'token-type)
           (as-token designator))
          ((stringp designator)
           (make-token :t/ident designator))
          ((integerp designator)
           (make-token :t/int (princ-to-string designator)))
          ((characterp designator)
           (case designator
             (#\( (as-token :t/lparen))
             (#\) (as-token :t/rparen))
             (#\; (as-token :t/semicolon))
             (#\{ (as-token :t/lbrace))
             (#\} (as-token :t/rbrace))))
          ((consp designator)
           (apply #'make-token designator))))

  (defun define-lexer-test (name string tokens)
    `(progn
       (setf (gethash ',name *tests*) t)
       (defun ,name ()
         (let ((*test-name* ',name))
           (test-lexer ,string (list ,@(mapcar (lambda (tok) `(tokenize ',tok))
                                               tokens)))))))

  (defmacro deftest ((type &optional name) &body args)
    (case type
      (:lexer (apply #'define-lexer-test
                     (or name (gensym "LEXER-TEST"))
                     args)))))

(defun run-tests ()
  (let ((ok t) key val)
    (with-hash-table-iterator (it *tests*)
      (loop :do (multiple-value-setq (ok key val) (it))
            :while ok
            :do (funcall (symbol-function key))))))

(deftest (:lexer test-1)
  "=+(){},;"
  (:t/= :t/+ :t/lparen :t/rparen
   :t/lbrace :t/rbrace :t/comma :t/semicolon :t/eof))

(deftest (:lexer test-2)
  "let five = 5;
let ten = 10;

let add = fn(x, y) {
  x + y;
};

let result = add(five, ten);
!-/*;
5 < 10 > 5;

if (5 < 10) {
    return true;
} else {
    return false;
}
10 == 10;
10 != 9;
"
  (:t/let "five" :t/= 5 #\;
          :t/let "ten" :t/= 10 #\;
          :t/let "add" :t/= :t/function #\( "x" :t/comma "y" #\) #\{
          "x" :t/+ "y" #\;
          #\} #\;
          :t/let "result" :t/= "add" #\( "five" :t/comma "ten" #\) #\;
          :t/! :t/- :t// :t/* #\;
          5 :t/< 10 :t/> 5 #\;
          :t/if #\( 5 :t/< 10 #\) #\{
          :t/return :t/true #\;
          #\} :t/else #\{
          :t/return :t/false #\;
          #\}
          10 :t/== 10 #\;
          10 :t/!= 9 #\;
          :t/eof))


(deftest (:lexer test-fail)
  "abc gf 5 fn =+(){},;"
  (:t/= :t/+ :t/lparen :t/rparen
   :t/lbrace :t/rbrace :t/comma :t/semicolon :t/eof))

(deftest (:lexer test-fail-2)
  "let abc x + 5;"
  (:t/let "abc" :t/= "x" :t/+ 5 :t/eof))