1 files changed, 284 insertions, 0 deletions
diff --git a/src/parser.lisp b/src/parser.lisp
new file mode 100644
index 0000000..c3e09a9
--- /dev/null
+++ b/src/parser.lisp
@@ -0,0 +1,284 @@
+(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))))