(in-package :token)

(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
            :type string)))

(defun type= (type1 type2)
  (eq type1 type2))

(defmethod type-is ((token token) type)
  (type= (type token) type))

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

(defun make (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)
    (format stream "\"~a\"" (literal token))))

(defun as-token (token-type)
  "Returns TOKEN from a TOKEN-TYPE"
  (multiple-value-bind (str ok) (token->string token-type)
    (make token-type (if (null ok) "" str))))

(define-compiler-macro as-token (&whole form token-type)
  "if TOKEN-TYPE is TOKEN-TYPE, lookup at compile time"
  (if (typep token-type 'token-type)
      (let ((token (as-token token-type)))
        `(make ,(type token) ,(literal token)))
      form))

(defun lookup-identifier (str)
  "Returns an identifier or keyword as TOKEN-TYPE from STR"
  (multiple-value-bind (val ok) (string->token str)
    (if (not (null ok))
        val
        :t/ident)))