1 files changed, 83 insertions, 0 deletions
diff --git a/src/token.lisp b/src/token.lisp
new file mode 100644
index 0000000..7b4f372
--- /dev/null
+++ b/src/token.lisp
@@ -0,0 +1,83 @@
+(in-package :monkey)
+
+(eval-always
+  (defmacro def-tokens (prefix &body tok-def)
+    (let ((i 0)
+          (hash-sym (gensym))
+          (body (list)))
+      (loop :for def :in tok-def
+            :if (consp def)
+              :do (let ((sym (concat-symbols prefix (car def))))
+                    (push `(defparameter ,sym ,i) body)
+                    (push `(setf (gethash ,sym ,hash-sym) ,(cadr def)) body))
+            :else
+              :do (push `(defparameter ,(concat-symbols prefix def) ,i) body)
+            :do (incf i)
+            :finally (setf body (reverse body)))
+      `(progn (defparameter ,hash-sym (make-hash-table))
+              ,@body
+              (defparameter ,(concat-symbols prefix 'count) ,i)
+              (defun as-token (token-type)
+                (make-token token-type (or (gethash token-type ,hash-sym) "")))))))
+
+(def-tokens token
+  illegal
+  eof
+  ident
+  int
+  (= "=")
+  (+ "+")
+  (- "-")
+  (! "!")
+  (* "*")
+  (/ "/")
+  (== "==")
+  (!= "!=")
+  (< "<")
+  (> ">")
+  (comma ",")
+  (semicolon ";")
+  (lparen "(")
+  (rparen ")")
+  (lbrace "{")
+  (rbrace "}")
+  (function "fn")
+  (let "let")
+  (true "true")
+  (false "false")
+  (if "if")
+  (else "else")
+  (return "return"))
+
+
+(defclass token ()
+  ((_type :reader _type :initarg :type)
+   (literal :reader literal :initarg :literal)))
+
+(defmethod token= ((t1 token) (t2 token))
+  (and (= (_type t1) (_type t2))
+       (string= (literal t1) (literal t2))))
+
+(defun make-token (type literal)
+  (make-instance 'token :type type :literal (string literal)))
+
+(defmethod print-object ((token token) stream)
+  (print-unreadable-object (token stream :type t :identity t)
+    (princ (literal token) stream)))
+
+(defparameter *keywords*
+  (let ((kw (make-hash-table)))
+    (setf (gethash "fn" kw) token-function)
+    (setf (gethash "let" kw) token-let)
+    (setf (gethash "true" kw) token-true)
+    (setf (gethash "false" kw) token-false)
+    (setf (gethash "if" kw) token-if)
+    (setf (gethash "else" kw) token-else)
+    (setf (gethash "return" kw) token-return)
+    kw))
+
+(defun lookup-identifier (str)
+  (multiple-value-bind (val ok) (gethash str *keywords*)
+    (if (not (null ok))
+        val
+        token-ident)))