1 files changed, 86 insertions, 0 deletions
diff --git a/src/modules/lexer/driver.scm b/src/modules/lexer/driver.scm
new file mode 100644
index 0000000..e1a4f6e
--- /dev/null
+++ b/src/modules/lexer/driver.scm
@@ -0,0 +1,86 @@
+(define-module (modules lexer driver)
+  #:export (read-tokens))
+
+(define (read-tokens)
+  "Returns a stream of tokens from the
+current input port."
+  (define (read-tokens-loop tokens-so-far)
+    (let ((token (read-token)))
+      (if token
+          (read-tokens-loop (cons token tokens-so-far))
+          (reverse tokens-so-far))))
+  (read-tokens-loop '()))
+
+(define (read-token)
+  (let ((chr (read-char)))
+    (cond
+     ((eof-object? chr) #f)
+     ((char-whitespace? chr)
+      (read-token))
+
+      ((eqv? chr #\()
+       'left-paren)
+      ((eqv? chr #\))
+       'right-paren)
+      ((eqv? chr #\{)
+       'open-brace)
+      ((eqv? chr #\})
+       'close-brace)
+      ((eqv? chr #\;)
+       'semi-colon)
+      ((eqv? chr #\~)
+       'not)
+
+      ((eqv? chr #\+)
+       (if (take-double? chr)
+           '++
+           '+))
+
+      ((eqv? chr #\-)
+       (if (take-double? chr)
+           '--
+           'neg))
+
+      ((char-numeric? chr)
+       (read-constant chr))
+
+      ((char-alphabetic? chr)
+       (lookup-keyword (read-identifier chr)))
+
+      (#t (error "illegal lexical syntax")))))
+
+(define (read-constant chr)
+  (define (read-constant-helper chrs-so-far)
+    (let ((chr (peek-char)))
+      (cond ((and (not (eof-object? chr)) (char-numeric? chr))
+             (read-constant-helper (cons (read-char) chrs-so-far)))
+            ((and (not (eof-object? chr)) (char-alphabetic? chr))
+             (error "identifier starting with digit"))
+            (#t (reverse chrs-so-far)))))
+  (string->number (list->string (read-constant-helper (list chr)))))
+
+(define (read-identifier chr)
+  (define (read-identifier-helper chrs-so-far)
+    (let ((chr (peek-char)))
+      (cond ((and (not (eof-object? chr))
+              (or (char-alphabetic? chr)
+                  (char-numeric? chr)
+                  (eqv? chr #\_)))
+             (read-identifier-helper (cons (read-char) chrs-so-far)))
+            (#t (reverse chrs-so-far)))))
+  (list->string (read-identifier-helper (list chr))))
+
+(define (take-double? chr)
+  (if (eqv? chr (peek-char))
+      (read-char)
+      #f))
+
+(define (lookup-keyword id)
+  "Given identifier ID, converts it to a keyword
+if one is known."
+  (let ((found (assoc
+                id
+                '(("int" . int)
+                  ("void" . void)
+                  ("return" . return)))))
+    (if found (cdr found) id)))