summaryrefslogtreecommitdiff
path: root/src/modules/lexer/lexer.scm
blob: e6d96dfa73e5ad00391c2ee59787c5cb3243e210 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
(define-module (modules lexer lexer)
  #: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)

      ((char-alphabetic? chr)
       (lookup-keyword (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)))))

(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 (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)))