(in-package :monkey)

(eval-always
  (defmacro def-tokens (prefix &body tok-def)
    (let ((i 0)
          (hash-sym (gensym))
          (body (list)))
      (loop :for def :in tok-def
            :if (consp def)
              :do (let ((sym (concat-symbols prefix (car def))))
                    (push `(defparameter ,sym ,i) body)
                    (push `(setf (gethash ,sym ,hash-sym) ,(cadr def)) body))
            :else
              :do (push `(defparameter ,(concat-symbols prefix def) ,i) body)
            :do (incf i)
            :finally (setf body (reverse body)))
      `(progn (defparameter ,hash-sym (make-hash-table))
              ,@body
              (defparameter ,(concat-symbols prefix 'count) ,i)
              (defun as-token (token-type)
                (make-token token-type (or (gethash token-type ,hash-sym) "")))))))

(def-tokens token
  illegal
  eof
  ident
  int
  (= "=")
  (+ "+")
  (- "-")
  (! "!")
  (* "*")
  (/ "/")
  (== "==")
  (!= "!=")
  (< "<")
  (> ">")
  (comma ",")
  (semicolon ";")
  (lparen "(")
  (rparen ")")
  (lbrace "{")
  (rbrace "}")
  (function "fn")
  (let "let")
  (true "true")
  (false "false")
  (if "if")
  (else "else")
  (return "return"))


(defclass token ()
  ((_type :reader _type :initarg :type)
   (literal :reader literal :initarg :literal)))

(defmethod token= ((t1 token) (t2 token))
  (and (= (_type t1) (_type t2))
       (string= (literal t1) (literal t2))))

(defun make-token (type literal)
  (make-instance 'token :type type :literal (string literal)))

(defmethod print-object ((token token) stream)
  (print-unreadable-object (token stream :type t :identity t)
    (princ (literal token) stream)))

(defparameter *keywords*
  (let ((kw (make-hash-table)))
    (setf (gethash "fn" kw) token-function)
    (setf (gethash "let" kw) token-let)
    (setf (gethash "true" kw) token-true)
    (setf (gethash "false" kw) token-false)
    (setf (gethash "if" kw) token-if)
    (setf (gethash "else" kw) token-else)
    (setf (gethash "return" kw) token-return)
    kw))

(defun lookup-identifier (str)
  (multiple-value-bind (val ok) (gethash str *keywords*)
    (if (not (null ok))
        val
        token-ident)))