diff options
| -rw-r--r-- | monkey.asd | 10 | ||||
| -rw-r--r-- | src/lexer-test.lisp | 120 | ||||
| -rw-r--r-- | src/lexer.lisp | 48 | ||||
| -rw-r--r-- | src/package.lisp | 32 | ||||
| -rw-r--r-- | src/token.lisp | 28 | ||||
| -rw-r--r-- | src/util.lisp | 2 | ||||
| -rw-r--r-- | test/lexer-test.lisp | 53 | ||||
| -rw-r--r-- | test/tester.lisp | 68 |
8 files changed, 207 insertions, 154 deletions
@@ -8,4 +8,12 @@ (:file "token") (:file "lexer") ;; (:file "parser") - )) + ) + :in-order-to ((test-op (test-op "monkey/test")))) + +(defsystem "monkey/test" + :depends-on ("monkey") + :pathname "test/" + :components ((:file "tester") + (:file "lexer-test")) + :perform (test-op (o c) (symbol-call :monkey/test :run-tests))) diff --git a/src/lexer-test.lisp b/src/lexer-test.lisp deleted file mode 100644 index c6f131a..0000000 --- a/src/lexer-test.lisp +++ /dev/null @@ -1,120 +0,0 @@ -(in-package :monkey) - -(defparameter *tests* (make-hash-table)) -(defparameter *test-name* nil) - -(eval-always - (defun make-tokens (&rest tokens) - (loop :for token :in tokens - :if (consp token) - :collect (make-token (car token) (cadr token)) - :if (typep token 'token-type) - :collect (as-token token))) - - (defun test-lexer (str expected-tokens) - (labels ((expected-next () - (prog1 (car expected-tokens) - (setf expected-tokens (cdr expected-tokens))))) - (format t "Testing ~s..." *test-name*) - (let* ((lexer (make-lexer str)) - (tokens (lexer-tokens lexer)) - (expected-token (expected-next)) - (ok t)) - (loop :for token :in tokens - :for i :from 1 - :if (not (token= token expected-token)) - :do (format t "~&token ~d: expected ~a but got ~a~%" i expected-token token) - (setf ok nil) - :else :do (setf expected-token (expected-next))) - (unless (null ok) - (format t " ok~%"))))) - - (defun tokenize (designator) - (cond ((typep designator 'token-type) - (as-token designator)) - ((stringp designator) - (make-token :t/ident designator)) - ((integerp designator) - (make-token :t/int (princ-to-string designator))) - ((characterp designator) - (case designator - (#\( (as-token :t/lparen)) - (#\) (as-token :t/rparen)) - (#\; (as-token :t/semicolon)) - (#\{ (as-token :t/lbrace)) - (#\} (as-token :t/rbrace)))) - ((consp designator) - (apply #'make-token designator)))) - - (defun define-lexer-test (name string tokens) - `(progn - (setf (gethash ',name *tests*) t) - (defun ,name () - (let ((*test-name* ',name)) - (test-lexer ,string (list ,@(mapcar (lambda (tok) `(tokenize ',tok)) - tokens))))))) - - (defmacro deftest ((type &optional name) &body args) - (case type - (:lexer (apply #'define-lexer-test - (or name (gensym "LEXER-TEST")) - args))))) - -(defun run-tests () - (let ((ok t) key val) - (with-hash-table-iterator (it *tests*) - (loop :do (multiple-value-setq (ok key val) (it)) - :while ok - :do (funcall (symbol-function key)))))) - -(deftest (:lexer test-1) - "=+(){},;" - (:t/= :t/+ :t/lparen :t/rparen - :t/lbrace :t/rbrace :t/comma :t/semicolon :t/eof)) - -(deftest (:lexer test-2) - "let five = 5; -let ten = 10; - -let add = fn(x, y) { - x + y; -}; - -let result = add(five, ten); -!-/*; -5 < 10 > 5; - -if (5 < 10) { - return true; -} else { - return false; -} -10 == 10; -10 != 9; -" - (:t/let "five" :t/= 5 #\; - :t/let "ten" :t/= 10 #\; - :t/let "add" :t/= :t/function #\( "x" :t/comma "y" #\) #\{ - "x" :t/+ "y" #\; - #\} #\; - :t/let "result" :t/= "add" #\( "five" :t/comma "ten" #\) #\; - :t/! :t/- :t// :t/* #\; - 5 :t/< 10 :t/> 5 #\; - :t/if #\( 5 :t/< 10 #\) #\{ - :t/return :t/true #\; - #\} :t/else #\{ - :t/return :t/false #\; - #\} - 10 :t/== 10 #\; - 10 :t/!= 9 #\; - :t/eof)) - - -(deftest (:lexer test-fail) - "abc gf 5 fn =+(){},;" - (:t/= :t/+ :t/lparen :t/rparen - :t/lbrace :t/rbrace :t/comma :t/semicolon :t/eof)) - -(deftest (:lexer test-fail-2) - "let abc x + 5;" - (:t/let "abc" :t/= "x" :t/+ 5 :t/eof)) diff --git a/src/lexer.lisp b/src/lexer.lisp index 8694aa1..3dffc7c 100644 --- a/src/lexer.lisp +++ b/src/lexer.lisp @@ -1,4 +1,4 @@ -(in-package :monkey) +(in-package :lexer) (defparameter *eof* (code-char 0)) @@ -29,7 +29,7 @@ (ch :accessor ch) (peek-ch :accessor peek-ch))) -(defun make-lexer (input-string &optional len) +(defun make (input-string &optional len) (let ((l (make-instance 'lexer :input input-string :length (if (not (null len)) len @@ -67,35 +67,35 @@ (prog1 (case (ch l) (#\= (cond ((char= #\= (lexer-peek l)) (lexer-read l) - (make-token :t/== "==")) + (token:as-token :t/==)) (t ;;(whitespace? (lexer-peek l)) - (make-token :t/= (ch l))))) - (#\+ (make-token :t/+ (ch l))) - (#\- (make-token :t/- (ch l))) + (token:as-token :t/=)))) + (#\+ (token:as-token :t/+)) + (#\- (token:as-token :t/-)) (#\! (cond ((char= #\= (lexer-peek l)) (lexer-read l) - (make-token :t/!= "!=")) + (token:as-token :t/!=)) (t ;; (whitespace? (lexer-peek l)) - (make-token :t/! (ch l))))) - (#\/ (make-token :t// (ch l))) - (#\* (make-token :t/* (ch l))) - (#\< (make-token :t/< (ch l))) - (#\> (make-token :t/> (ch l))) - (#\; (make-token :t/semicolon (ch l))) - (#\, (make-token :t/comma (ch l))) - (#\( (make-token :t/lparen (ch l))) - (#\) (make-token :t/rparen (ch l))) - (#\{ (make-token :t/lbrace (ch l))) - (#\} (make-token :t/rbrace (ch l))) + (token:as-token :t/!)))) + (#\/ (token:as-token :t//)) + (#\* (token:as-token :t/*)) + (#\< (token:as-token :t/<)) + (#\> (token:as-token :t/>)) + (#\; (token:as-token :t/semicolon)) + (#\, (token:as-token :t/comma)) + (#\( (token:as-token :t/lparen)) + (#\) (token:as-token :t/rparen)) + (#\{ (token:as-token :t/lbrace)) + (#\} (token:as-token :t/rbrace)) (otherwise (cond ((eof? (ch l)) - (make-token :t/eof "")) + (token:as-token :t/eof)) ((letter? (ch l)) (let ((literal (read-identifier l))) - (return (make-token (lookup-identifier literal) + (return (token:make (token:lookup-identifier literal) literal)))) ((digit? (ch l)) - (return (make-token :t/int (read-number l)))) - (t (make-token :t/illegal "ILLEGAL"))))) + (return (token:make :t/int (read-number l)))) + (t (token:make :t/illegal "ILLEGAL"))))) (lexer-read l)))) (defmethod read-number ((l lexer)) @@ -113,8 +113,8 @@ (make-string-view (input l) start (pos l)))) -(defmethod lexer-tokens ((l lexer)) +(defmethod lex ((l lexer)) (loop :for token := (next-token l) :collect token - :until (eq :t/eof (_type token)))) + :until (token:type-is token :t/eof))) diff --git a/src/package.lisp b/src/package.lisp index aa399d9..6f05abe 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,2 +1,30 @@ -(defpackage :monkey - (:use :common-lisp)) +(defpackage #:utilities + (:use #:common-lisp) + (:export #:eval-always + #:make-string-view + #:read-file-contents)) + +(defpackage #:monkey + (:use #:common-lisp #:utilities)) + +(defpackage #:token + (:use #:common-lisp #:utilities) + (:shadow #:type) + (:export #:token + #:type-is + #:token= + #:make + #:as-token + #:lookup-identifier + ;; the following depend on macro arguments + #:token-type + ;;#:string->token + ;;#:token->string + )) + +(defpackage #:lexer + (:use #:common-lisp #:utilities) + (:export #:make #:lex)) + +(defpackage #:monkey/test + (:use #:common-lisp #:utilities)) diff --git a/src/token.lisp b/src/token.lisp index 8d37734..0e82cc7 100644 --- a/src/token.lisp +++ b/src/token.lisp @@ -1,4 +1,4 @@ -(in-package :monkey) +(in-package :token) (eval-always (defun process-line (def prefix) @@ -88,17 +88,24 @@ (defclass token () - ((_type :reader _type + ((type :reader type :initarg :type :type token-type) (literal :reader literal - :initarg :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 (eq (_type t1) (_type t2)) + (and (type= (type t1) (type t2)) (string= (literal t1) (literal t2)))) -(defun make-token (type literal) +(defun make (type literal) (make-instance 'token :type type :literal (string literal))) (defmethod print-object ((token token) stream) @@ -106,10 +113,19 @@ (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 token-type (if (null ok) "" str)))) + (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 diff --git a/src/util.lisp b/src/util.lisp index 5cf28fa..72dcf50 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -1,4 +1,4 @@ -(in-package :monkey) +(in-package :utilities) (eval-when (:compile-toplevel :load-toplevel :execute) (defmacro eval-always (&body body) diff --git a/test/lexer-test.lisp b/test/lexer-test.lisp new file mode 100644 index 0000000..bb7a1bd --- /dev/null +++ b/test/lexer-test.lisp @@ -0,0 +1,53 @@ +(in-package :monkey/test) + +(deftest (:lexer test-1) + "=+(){},;" + (:t/= :t/+ :t/lparen :t/rparen + :t/lbrace :t/rbrace :t/comma :t/semicolon :t/eof)) + +(deftest (:lexer test-2) + "let five = 5; +let ten = 10; + +let add = fn(x, y) { + x + y; +}; + +let result = add(five, ten); +!-/*; +5 < 10 > 5; + +if (5 < 10) { + return true; +} else { + return false; +} +10 == 10; +10 != 9; +" + (:t/let "five" :t/= 5 #\; + :t/let "ten" :t/= 10 #\; + :t/let "add" :t/= :t/function #\( "x" :t/comma "y" #\) #\{ + "x" :t/+ "y" #\; + #\} #\; + :t/let "result" :t/= "add" #\( "five" :t/comma "ten" #\) #\; + :t/! :t/- :t// :t/* #\; + 5 :t/< 10 :t/> 5 #\; + :t/if #\( 5 :t/< 10 #\) #\{ + :t/return :t/true #\; + #\} :t/else #\{ + :t/return :t/false #\; + #\} + 10 :t/== 10 #\; + 10 :t/!= 9 #\; + :t/eof)) + +(eval-when () + (deftest (:lexer test-fail) + "abc gf 5 fn =+(){},;" + (:t/= :t/+ :t/lparen :t/rparen + :t/lbrace :t/rbrace :t/comma :t/semicolon :t/eof)) + + (deftest (:lexer test-fail-2) + "let abc x + 5;" + (:t/let "abc" :t/= "x" :t/+ 5 :t/eof))) diff --git a/test/tester.lisp b/test/tester.lisp new file mode 100644 index 0000000..2def1e0 --- /dev/null +++ b/test/tester.lisp @@ -0,0 +1,68 @@ +(in-package :monkey/test) + +(defparameter *tests* (make-hash-table)) +(defparameter *test-name* nil) + +(eval-always + (defun make-tokens (&rest tokens) + (loop :for token :in tokens + :if (consp token) + :collect (token:make (car token) (cadr token)) + :if (typep token 'token:token-type) + :collect (token:as-token token))) + + (defun test-lexer (str expected-tokens) + (labels ((expected-next () + (prog1 (car expected-tokens) + (setf expected-tokens (cdr expected-tokens))))) + (format t "Testing ~s..." *test-name*) + (let* ((lexer (lexer:make str)) + (tokens (lexer:lex lexer)) + (expected-token (expected-next)) + (ok t)) + (loop :for token :in tokens + :for i :from 1 + :if (not (token:token= token expected-token)) + :do (format t "~&token ~d: expected ~a but got ~a~%" i expected-token token) + (setf ok nil) + :else :do (setf expected-token (expected-next))) + (unless (null ok) + (format t " ok~%"))))) + + (defun tokenize (designator) + (cond ((typep designator 'token:token-type) + (token:as-token designator)) + ((stringp designator) + (token:make :t/ident designator)) + ((integerp designator) + (token:make :t/int (princ-to-string designator))) + ((characterp designator) + (case designator + (#\( (token:as-token :t/lparen)) + (#\) (token:as-token :t/rparen)) + (#\; (token:as-token :t/semicolon)) + (#\{ (token:as-token :t/lbrace)) + (#\} (token:as-token :t/rbrace)))) + ((consp designator) + (apply #'token:make designator)))) + + (defun define-lexer-test (name string tokens) + `(progn + (setf (gethash ',name *tests*) t) + (defun ,name () + (let ((*test-name* ',name)) + (test-lexer ,string (list ,@(mapcar (lambda (tok) `(tokenize ',tok)) + tokens))))))) + + (defmacro deftest ((type &optional name) &body args) + (case type + (:lexer (apply #'define-lexer-test + (or name (gensym "LEXER-TEST")) + args))))) + +(defun run-tests () + (let ((ok t) key val) + (with-hash-table-iterator (it *tests*) + (loop :do (multiple-value-setq (ok key val) (it)) + :while ok + :do (funcall (symbol-function key)))))) |