diff options
| -rw-r--r-- | monkey.asd | 4 | ||||
| -rw-r--r-- | src/ast.lisp | 207 | ||||
| -rw-r--r-- | src/package.lisp | 31 | ||||
| -rw-r--r-- | src/parser.lisp | 284 |
4 files changed, 523 insertions, 3 deletions
@@ -7,8 +7,8 @@ (:file "util") (:file "token") (:file "lexer") - ;; (:file "parser") - ) + (:file "ast") + (:file "parser")) :in-order-to ((test-op (test-op "monkey/test")))) (defsystem "monkey/test" diff --git a/src/ast.lisp b/src/ast.lisp new file mode 100644 index 0000000..c33de88 --- /dev/null +++ b/src/ast.lisp @@ -0,0 +1,207 @@ +(in-package :ast) + +(defclass node () + ((token :accessor token + :initarg :token + :type token))) + +(defgeneric stringify (node) + (:method ((node node)) + (with-output-to-string (out) + (emit node out)))) + +(defparameter *indent* 0) +(defun emit-new-line (stream) + (write-char #\Newline stream) + (loop :for i :from 0 :below *indent* + :do (write-char #\Space stream))) + +(defgeneric emit (node stream) + (:method ((node node) stream) + (write-string (token-literal node) stream))) + +(defgeneric token-literal (node) + (:method ((node node)) + (token:literal (token node)))) + +(defclass statement (node) + ()) + +(defclass expression (node) + ()) + +(defclass program (node) + ((statements :accessor statements + :initform (make-array 10 :adjustable t :fill-pointer 0)))) + +(defmethod token-literal ((node program)) + (if (> (length (statements node)) 0) + (token-literal (aref (statements node) 0)) + "")) + +(defmethod emit ((node program) stream) + (loop :for stmt :across (statements node) + :do (emit stmt stream))) + +(defclass identifier (expression) + ()) + +(defclass let-statement (statement) + ((name :accessor name + :initarg :name + :type identifier) + (value :accessor value + :initarg :value + :type expression))) + +(defmethod emit ((node let-statement) stream) + (write-string (token-literal node) stream) + (write-char #\Space stream) + (emit (name node) stream) + (write-string " = " stream) + (emit (value node) stream) + (write-char #\; stream) + (write-char #\Newline stream)) + +(defclass return-statement (statement) + ((return-value :accessor return-value + :initarg :return-value + :type expression))) + +(defmethod emit ((node return-statement) stream) + (write-string (token-literal node) stream) + (write-char #\Space stream) + (emit (return-value node) stream) + (write-char #\; stream) + (write-char #\Newline stream)) + +(defclass integer-literal (expression) + ((value :accessor value + :initarg :value + :type integer))) + +(defclass prefix-expression (expression) + ((operator :accessor operator + :initarg :operator + :type token-type) + (right :accessor right + :initarg :right + :type expression))) + +(defmethod emit ((node prefix-expression) stream) + (write-char #\( stream) + (write-string (token-literal node) stream) + (emit (right node) stream) + (write-char #\) stream)) + + +(defclass expression-statement (statement) + ((expression :accessor expression + :initarg :expression + :type expression))) + +(defmethod emit ((node expression-statement) stream) + (emit (expression node) stream) + (write-char #\; stream) + (write-char #\Newline stream)) + +(defclass boolean-expression (expression) + ((value :accessor value + :initarg :value + :type boolean))) + +(defclass infix-expression (expression) + ((left :accessor left + :initarg :left + :type expression) + (operator :accessor operator + :initarg :operator + :type token-type) + (right :accessor right + :initarg :right + :type expression))) + +(defmethod emit ((node infix-expression) stream) + (write-char #\( stream) + (emit (left node) stream) + (let ((tok (token:as-token (operator node)))) + (format stream " ~a " (token:literal tok))) + (emit (right node) stream) + (write-char #\) stream)) + +(defclass if-expression (expression) + ((con :accessor con + :initarg :condition + :type expression) + (consequence :accessor consequence + :initarg :consequence + :type block-statement) + (alternative :accessor alternative + :initform nil + :initarg :alternative + :type (or block-statement null)))) + +(defmethod emit ((node if-expression) stream) + (write-string "if (" stream) + (emit (con node) stream) + (write-string ") " stream) + (emit (consequence node) stream) + (unless (null (alternative node)) + (write-string "else " stream) + (emit (alternative node) stream))) + +(defclass block-statement (statement) + ((statements :accessor statements + :initarg statements + :initform (make-array 0 :element-type 'statement + :adjustable t :fill-pointer 0) + :type (vector statement)))) + +(defmethod emit ((node block-statement) stream) + (write-char #\{ stream) + (let ((*indent* (+ 4 *indent*))) + (emit-new-line stream) + (loop :for stmt :across (statements node) + :do (emit stmt stream))) + (format stream "}")) + +(defclass function-literal (expression) + ((parameters :accessor parameters + :initarg :parameters + :initform (make-array 0 :element-type 'identifier + :adjustable t :fill-pointer 0) + :type (vector identifier)) + (body :accessor body + :initarg :body + :type block-statement))) + +(defmethod emit ((node function-literal) stream) + (write-string (token-literal node) stream) + (write-char #\( stream) + (loop :for param :across (parameters node) + :for i :from 1 + :do (write-string (token-literal param) stream) + (when (< i (length (parameters node))) + (write-string ", " stream))) + (write-char #\) stream) + (emit (body node) stream)) + +(defclass call-expression (expression) + ((fn-expr :accessor fn-expr + :initarg :function + :type expression) + (args :accessor args + :initarg :args + :initform (make-array 0 :element-type 'expression + :adjustable t :fill-pointer 0) + :type (vector expression)))) + +(defmethod emit ((node call-expression) stream) + (emit (fn-expr node) stream) + (write-char #\( stream) + (loop :for arg :across (args node) + :for i :from 1 + :do (emit arg stream) + (when (< i (length (args node))) + (write-string ", " stream))) + (write-char #\) stream)) diff --git a/src/package.lisp b/src/package.lisp index 6f05abe..cf8ce51 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -11,6 +11,8 @@ (:use #:common-lisp #:utilities) (:shadow #:type) (:export #:token + #:literal + #:type #:type-is #:token= #:make @@ -24,7 +26,34 @@ (defpackage #:lexer (:use #:common-lisp #:utilities) - (:export #:make #:lex)) + (:export #:make #:lex #:next-token)) + +(defpackage #:ast + (:use #:common-lisp #:utilities) + (:export #:node + #:stringify + #:token-literal + #:emit + #:statement + #:expression + #:program + #:statements + #:identifier + #:integer-literal + #:prefix-expression #:right + #:expression-statement + #:boolean-expression + #:infix-expression + #:let-statement #:name #:value + #:return-statement #:return-value + #:if-expression + #:block-statement + #:function-literal + #:call-expression #:args)) + +(defpackage #:parser + (:use #:common-lisp #:utilities) + (:export #:make #:parse-program)) (defpackage #:monkey/test (:use #:common-lisp #:utilities)) 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)))) |