1 files changed, 124 insertions, 0 deletions
diff --git a/src/lexer.lisp b/src/lexer.lisp
new file mode 100644
index 0000000..cd47881
--- /dev/null
+++ b/src/lexer.lisp
@@ -0,0 +1,124 @@
+(in-package :monkey)
+
+(defparameter *eof* (code-char 0))
+
+(defun eof? (char)
+  (char= char *eof*))
+
+(defun digit? (char)
+  (char<= #\0 char #\9))
+
+(defun letter? (char)
+  (or (char<= #\a char #\z)
+      (char<= #\A char #\Z)))
+
+(defun whitespace? (char)
+  (or (char= char #\Space)
+      (char= char #\Tab)
+      (char= char #\Newline)
+      (char= char #\Linefeed)
+      (char= char #\_)))
+
+
+(defparameter *lexer-start-pos* -1)
+
+(defclass lexer ()
+  ((input :reader input :initarg :input)
+   (len :reader len :initarg :length)
+   (pos :accessor pos :initform *lexer-start-pos*)
+   (ch :accessor ch)
+   (peek-ch :accessor peek-ch)))
+
+(defun make-lexer (input-string &optional len)
+  (let ((l (make-instance 'lexer :input input-string
+                                 :length (if (not (null len))
+                                             len
+                                             (length input-string)))))
+    (lexer-peek* l)
+    (lexer-read l)
+    l))
+
+(defmethod lexer-reset ((l lexer))
+  (setf (pos l) *lexer-start-pos*)
+  (lexer-peek* l)
+  (lexer-read l))
+
+(defmethod lexer-read ((l lexer))
+  (prog1 (setf (ch l) (peek-ch l))
+    (incf (pos l))
+    (lexer-peek* l)))
+
+(defmethod lexer-peek* ((l lexer))
+  (setf (peek-ch l)
+        (if (< (+ 1 (pos l)) (len l))
+            (char (input l) (+ 1 (pos l)))
+            *eof*)))
+
+(defmethod lexer-peek ((l lexer))
+  (peek-ch l))
+
+(defmethod skip-ws ((l lexer))
+  (loop :while (whitespace? (ch l))
+        :do (lexer-read l)))
+
+(defmethod next-token ((l lexer))
+  (skip-ws l)
+  (block nil
+    (prog1 (case (ch l)
+             (#\= (cond ((char= #\= (lexer-peek l))
+                         (lexer-read l)
+                         (make-token token-== "=="))
+                        (t ;;(whitespace? (lexer-peek l))
+                         (make-token token-= (ch l)))))
+             (#\+ (make-token token-+ (ch l)))
+             (#\- (make-token token-- (ch l)))
+             (#\! (cond ((char= #\= (lexer-peek l))
+                         (lexer-read l)
+                         (make-token token-!= "!="))
+                        (t ;; (whitespace? (lexer-peek l))
+                         (make-token token-! (ch l)))))
+             (#\/ (make-token token-/ (ch l)))
+             (#\* (make-token token-* (ch l)))
+             (#\< (make-token token-< (ch l)))
+             (#\> (make-token token-> (ch l)))
+             (#\; (make-token token-semicolon (ch l)))
+             (#\, (make-token token-comma (ch l)))
+             (#\( (make-token token-lparen (ch l)))
+             (#\) (make-token token-rparen (ch l)))
+             (#\{ (make-token token-lbrace (ch l)))
+             (#\} (make-token token-rbrace (ch l)))
+             (otherwise (cond ((eof? (ch l))
+                               (make-token token-eof ""))
+                              ((letter? (ch l))
+                               (let ((literal (read-identifier l)))
+                                 (return (make-token (lookup-identifier literal)
+                                                     literal))))
+                              ((digit? (ch l))
+                               (return (make-token token-int (read-number l))))
+                              (t (make-token token-illegal "ILLEGAL")))))
+      (lexer-read l))))
+
+(defmethod read-number ((l lexer))
+  (let ((start (pos l)))
+    (lexer-read l)
+    (loop :while (digit? (ch l))
+          :do (lexer-read l))
+    (make-array (- (pos l) start) :element-type 'character
+                                    :displaced-to (input l)
+                                    :displaced-index-offset start)))
+
+(defmethod read-identifier ((l lexer))
+  (let ((start (pos l)))
+    (lexer-read l)
+    (loop :while (letter? (ch l))
+          :do (lexer-read l))
+    (make-array (- (pos l) start) :element-type 'character
+                                    :displaced-to (input l)
+                                    :displaced-index-offset start)))
+
+
+(defmethod lexer-tokens ((l lexer))
+  (loop :for token := (next-token l)
+        :collect token
+        :until (= token-eof (_type token))))
+