(in-package :monkey)

(eval-always
  (defun process-line (def prefix)
    (labels ((make-token-symbol (prefix def)
               (nth-value 0 (intern (format nil "~a~a" prefix def) "KEYWORD"))))
      (cond ((symbolp def)
             (make-token-symbol prefix def))
            ((consp def)
             (let* ((token-sym (make-token-symbol prefix (car def)))
                    (hash (cadr def))
                    (keyword (and (keywordp (caddr def))
                                  (equal :kw (caddr def)))))
               (values token-sym
                       (list (cons token-sym hash))
                       (if (null keyword)
                           nil
                           (list (cons hash token-sym)))))))))

  (defun make-token-defs (defs prefix)
    (labels ((helper (defs members hashes keywords)
               (cond ((null defs)
                      (values members hashes keywords))
                     ((consp defs)
                      (multiple-value-bind (token hash keyword)
                          (process-line (car defs) prefix)
                        (helper (cdr defs)
                                (cons token members)
                                (append hash hashes)
                                (append keyword keywords)))))))
      (helper defs (list) (list) (list))))

  (defun def-tokens* (name prefix literal-getter keyword-getter defs)
    (let ((hash-sym (gensym "LITERALS"))
          (token-type-sym (gensym))
          (keyword-sym (gensym "KEYWORDS"))
          (str-sym (gensym)))
      (multiple-value-bind (members hashes keywords) (make-token-defs defs prefix)
        `(progn (deftype ,name () (quote (member ,@members)))
                (defparameter ,hash-sym (make-hash-table))
                (defparameter ,keyword-sym (make-hash-table :test 'equal))
                (defun ,literal-getter (,token-type-sym)
                  (gethash ,token-type-sym ,hash-sym))
                (defun ,keyword-getter (,str-sym)
                  (gethash ,str-sym ,keyword-sym))
                ,@(mapcar (lambda (hash)
                            `(setf (gethash ,(car hash) ,hash-sym) ,(cdr hash)))
                          hashes)
                ,@(mapcar (lambda (kw)
                            `(Setf (gethash ,(car kw) ,keyword-sym) ,(cdr kw)))
                          keywords)))))

  (defmacro def-tokens ((&key name prefix literal-getter keyword-getter)
                        &body defs)
    (def-tokens* name prefix literal-getter keyword-getter defs)))

(def-tokens (:name token-type
             :prefix t/
             :literal-getter token->string
             :keyword-getter string->token)
  illegal
  eof
  ident
  int
  (= "=")
  (+ "+")
  (- "-")
  (! "!")
  (* "*")
  (/ "/")
  (== "==")
  (!= "!=")
  (< "<")
  (> ">")
  (comma ",")
  (semicolon ";")
  (lparen "(")
  (rparen ")")
  (lbrace "{")
  (rbrace "}")
  (function "fn" :kw)
  (let "let" :kw)
  (true "true" :kw)
  (false "false" :kw)
  (if "if" :kw)
  (else "else" :kw)
  (return "return" :kw))


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

(defmethod token= ((t1 token) (t2 token))
  (and (eq (_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)))

(defun as-token (token-type)
  (multiple-value-bind (str ok) (token->string token-type)
    (make-token token-type (if (null ok) "" str))))

(defun lookup-identifier (str)
  (multiple-value-bind (val ok) (string->token str)
    (if (not (null ok))
        val
        :t/ident)))