summaryrefslogtreecommitdiff
path: root/src/modules/lexer/lexer.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/modules/lexer/lexer.scm')
-rw-r--r--src/modules/lexer/lexer.scm78
1 files changed, 53 insertions, 25 deletions
diff --git a/src/modules/lexer/lexer.scm b/src/modules/lexer/lexer.scm
index 0661fa6..e07ab67 100644
--- a/src/modules/lexer/lexer.scm
+++ b/src/modules/lexer/lexer.scm
@@ -1,31 +1,59 @@
(define-module (modules lexer lexer)
- #:export (read-tokens-from-port))
+ #:export (read-tokens))
-(define (read-tokens-from-port port)
- ""
- (display (read-char port)))
+(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)
-
- (define (read-token-loop first-char)
+ (let ((chr (read-char)))
(cond
+ ((eof-object? chr) #f)
+ ((char-whitespace? chr)
+ (read-token))
+
+ ((eq? chr #\()
+ 'left-paren)
+ ((eq? chr #\))
+ 'right-paren)
+ ((eq? chr #\{)
+ 'open-brace)
+ ((eq? chr #\})
+ 'close-brace)
+ ((eq? chr #\;)
+ 'semi-colon)
+
+ ((char-alphabetic? chr)
+ (read-identifier chr))
+
+ ((char-numeric? chr)
+ (read-constant 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)))))
- ((or (char-whitespace? first-char))
- (read-token)
-
- ((eq? first-char #\()
- (cons 'left-paren #\())
- ((eq? first-char #\))
- (cons 'right-paren #\)))
- ((eq? first-char #\{)
- (cons 'right-bracket #\{))
- ((eq? first-char #\})
- (cons 'right-bracket #\}))
-
- (#t
- (error "illegal lexical syntax")))))
-
- (let ((first-char (read-char)))
- (if (eof-object? first-char)
- '()
- (cons (read-token-loop first-char) '()))))
+(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)
+ (eq? chr #\_)))
+ (read-identifier-helper (cons (read-char) chrs-so-far)))
+ (#t (reverse chrs-so-far)))))
+ (list->string (read-identifier-helper (list chr))))