(in-package :parser)

(defclass parser ()
  ((lexer :accessor lexer
          :initarg :lexer
          :type lexer)
   (token :accessor token
          :type token)
   (peek-token :accessor peek-token
               :type token
               :initform nil)))

(defmethod next-token ((parser parser))
  (setf (token parser) (peek-token parser))
  (setf (peek-token parser) (lexer:next-token (lexer parser))))

(defun make (lexer)
  (let ((parser (make-instance 'parser :lexer lexer)))
    (next-token parser)
    (next-token parser)
    parser))

(defun make-from-string (string &optional length)
  (make (lexer:make string length)))

(define-compiler-macro make (&whole form lexer? &optional length)
  (if (stringp lexer?)
      `(make-from-string ,lexer? ,length)
      form))

(defmethod token-is ((parser parser) token-type)
  (token:type-is (token parser) token-type))

(defmethod peek-is ((parser parser) token-type)
  (token:type-is (peek-token parser) token-type))

(defmethod expect-peek ((parser parser) token-type)
  (let ((expect? (peek-is parser token-type)))
    (if (not expect?)
        (error "(expect-peek) error: expect: ~a, got: ~a"
               token-type
               (peek-token parser))
        (next-token parser))
    expect?))


(defmethod parse-program ((parser parser))
  (let ((program (make-instance 'ast:program)))
    (loop :until (token-is parser :t/eof)
          :for stmt := (parse-statement parser)
          :unless (null stmt)
            :do (vector-push-extend stmt (ast:statements program))
          :do (next-token parser))
    program))

(defmethod parse-statement ((parser parser))
  (case (token:type (token parser))
    (:t/let (parse-let-statement parser))
    (:t/return (parse-return-statement parser))
    (otherwise (parse-expression-statement parser))))

(defmethod parse-let-statement ((parser parser))
  (let ((stmt (make-instance 'ast:let-statement :token (token parser))))
    (expect-peek parser :t/ident)
    (setf (ast:name stmt) (make-instance 'ast:identifier :token (token parser)))
    (expect-peek parser :t/=)
    (next-token parser)
    (setf (ast:value stmt) (parse-expression parser +lowest+))
    (when (peek-is parser :t/semicolon)
      (next-token parser))
    stmt))

(defmethod parse-return-statement ((parser parser))
  (let ((stmt (make-instance 'ast:return-statement
                             :token (token parser))))
    (next-token parser)
    (setf (ast:return-value stmt) (parse-expression parser +lowest+))
    (when (peek-is parser :t/semicolon)
      (next-token parser))
    stmt))


;;;; Expression parsing and precedences
(defparameter +lowest+ 0)
(defparameter +equals+ 1)
(defparameter +lessgreater+ 2)
(defparameter +sum+ 3)
(defparameter +product+ 4)
(defparameter +prefix+ 5)
(defparameter +call+ 6)

(let ((precedences (make-hash-table)))
  (setf (gethash :t/= precedences) +equals+)
  (setf (gethash :t/!= precedences) +equals+)
  (setf (gethash :t/< precedences) +lessgreater+)
  (setf (gethash :t/> precedences) +lessgreater+)
  (setf (gethash :t/+ precedences) +sum+)
  (setf (gethash :t/- precedences) +sum+)
  (setf (gethash :t// precedences) +product+)
  (setf (gethash :t/* precedences) +product+)
  (setf (gethash :t/lparen precedences) +call+)

  (defmethod peek-precedence ((parser parser))
    (multiple-value-bind (prec ok) (gethash (token:type (peek-token parser)) precedences)
      (if (not ok)
          +lowest+
          prec)))

  (defmethod cur-precedence ((parser parser))
    (multiple-value-bind (prec ok) (gethash (token:type (token parser)) precedences)
      (if (not ok)
          +lowest+
          prec))))

(defun get-prefix-fn (token-type)
  (case token-type
    (:t/ident #'parse-identifier)
    (:t/int #'parse-integer-literal)
    ((:t/! :t/-) #'parse-prefix-expression)
    ((:t/true :t/false) #'parse-boolean)
    (:t/lparen #'parse-grouped-expression)
    (:t/if #'parse-if-expression)
    (:t/function #'parse-function-literal)
    (otherwise nil)))

(defun get-infix-fn (token-type)
  (case token-type
    ((:t/= :t/!= :t/== :t/< :t/> :t/+ :t/- :t// :t/*) #'parse-infix-expression)
    (:t/lparen #'parse-call-expression)
    (otherwise nil)))

(defmethod parse-expression-statement ((parser parser))
  (let ((expr (parse-expression parser +lowest+)))
    (when (peek-is parser :t/semicolon)
      (next-token parser))
    (make-instance 'ast:expression-statement
                   :token (token parser)
                   :expression expr)))

(defmethod parse-expression ((parser parser) precedence)
  (let ((prefix (get-prefix-fn (token:type (token parser)))))
    (when (null prefix)
      (error "token ~a does not have a prefix parse" (token:literal (token parser))))
    (let ((left-expr (funcall prefix parser)))
      (loop :while (and (not (peek-is parser :t/semicolon))
                        (< precedence (peek-precedence parser)))
            :do (let ((infix (get-infix-fn (token:type (peek-token parser)))))
                  (cond ((null infix)
                         (return-from parse-expression left-expr))
                        (t
                         (next-token parser)
                         (setf left-expr (funcall infix parser left-expr))))))
      left-expr)))

(defmethod parse-integer-literal ((parser parser))
  (let ((int (parse-integer (token:literal (token parser)))))
    (make-instance 'ast:integer-literal
                   :token (token parser)
                   :value int)))

(defmethod parse-identifier ((parser parser))
  (make-instance 'ast:identifier :token (token parser)))

(defmethod parse-prefix-expression ((parser parser))
  (let* ((token (token parser))
         (expr (make-instance 'ast:prefix-expression
                              :token token
                              :operator (token:type token))))
    (next-token parser)
    (setf (ast:right expr) (parse-expression parser +prefix+))
    expr))

(defmethod parse-boolean ((parser parser))
  (make-instance 'ast:boolean-expression
                 :token (token parser)
                 :value (token:type-is (token parser) :t/true)))

(defmethod parse-infix-expression ((parser parser) left-expr)
  (let ((expr (make-instance 'ast:infix-expression
                             :token (token parser)
                             :operator (token:type (token parser))
                             :left left-expr))
        (prec (cur-precedence parser)))
    (next-token parser)
    (setf (ast:right expr) (parse-expression parser prec))
    expr))

(defmethod parse-grouped-expression ((parser parser))
  (next-token parser)
  (let ((expr (parse-expression parser +lowest+)))
    (if (not (expect-peek parser :t/rparen))
        (error "(parse-grouped-expression): expected a right parenthesis token")
        expr)))

(defmethod parse-block-statement ((parser parser))
  (let ((block-stmt (make-instance 'ast:block-statement :token (token parser))))
    (next-token parser)
    (loop :until (or (token-is parser :t/rbrace)
                     (token-is parser :t/eof))
          :do (let ((stmt (parse-statement parser)))
                (unless (null stmt)
                  (vector-push-extend stmt (ast:statements block-stmt)))
                (next-token parser)))
    block-stmt))

(defmethod parse-if-expression ((parser parser))
  (let ((tok (token parser)) con conseq alter)
    (expect-peek parser :t/lparen)
    (next-token parser)
    (setf con (parse-expression parser +lowest+))
    (expect-peek parser :t/rparen)
    (expect-peek parser :t/lbrace)
    (setf conseq (parse-block-statement parser))
    (when (peek-is parser :t/else)
      (next-token parser)
      (expect-peek parser :t/lbrace)
      (setf alter (parse-block-statement parser)))
    (make-instance 'ast:if-expression
                   :token tok
                   :condition con
                   :consequence conseq
                   :alternative alter)))

(defmethod parse-function-literal ((parser parser))
  (let ((tok (token parser)) params body)
    (expect-peek parser :t/lparen)
    (setf params (parse-function-parameters parser))
    (expect-peek parser :t/lbrace)
    (setf body (parse-block-statement parser))
    (make-instance 'ast:function-literal
                   :token tok
                   :parameters params
                   :body body)))

(defmethod parse-function-parameters ((parser parser))
  (block nil
    (let ((idents (make-array 0 :element-type 'ast:identifier
                                :adjustable t :fill-pointer 0)))
      (when (peek-is parser :t/rparen)
        (next-token parser)
        (return idents))
      (next-token parser)
      (unless (token-is parser :t/ident)
        (error "(parse-function-parameters): expected identifier, got ~a"
               (token:literal (token parser))))
      (vector-push-extend (make-instance 'ast:identifier
                                         :token (token parser))
                          idents)
      (loop :while (peek-is parser :t/comma)
            :do (next-token parser)
                (next-token parser)
                (unless (token-is parser :t/ident)
                  (error "(parse-function-parameters): expected identifier, got ~a"
                         (token:literal (token parser))))
                (vector-push-extend (make-instance 'ast:identifier
                                                   :token (token parser))
                                    idents))
      (expect-peek parser :t/rparen)
      idents)))

(defmethod parse-call-expression ((parser parser) func)
  (let ((expr (make-instance 'ast:call-expression :token (token parser) :function func)))
    (parse-call-arguments parser expr)
    expr))

(defmethod parse-call-arguments ((parser parser) expr)
  (block nil
    (when (peek-is parser :t/rparen)
      (next-token parser)
      (return))
    (next-token parser)
    (vector-push-extend (parse-expression parser +lowest+)
                        (ast:args expr))
    (loop :while (peek-is parser :t/comma)
          :do (next-token parser)
              (next-token parser)
              (vector-push-extend (parse-expression parser +lowest+)
                                  (ast:args expr)))
    (expect-peek parser :t/rparen)
    expr))

(defun parse-and-stringify (str)
  (let ((parser (make-from-string str)))
    (ast:stringify (parse-program parser))))