fudge-chez/fudge-chez.ss

(import (rnrs))

(define get-word
  (lambda (file)
    (let ([c (lookahead-char file)])
      (cond
        [(eof-object? c) ""]
        [(char-alphabetic? c)
         (get-char file)
         (string-append (string c) (get-word file))]
        [else ""]))))

(define char->digit
  (lambda (c)
    (- (char->integer c) (char->integer #\0))))

; get-number supports only nonnegative integers.
(define get-number
  (lambda (file)
    (let f ([total 0])
      (let ([c (lookahead-char file)])
        (if (char-numeric? c)
          (begin
            (get-char file)
            (f (+ (* total 10) (char->digit c))))
          total)))))

(define get-token
  (lambda (file)
    (let ([c (lookahead-char file)])
      (cond
        [(eof-object? c) 'end-of-file]
        [(char-whitespace? c)
         (get-char file)
         (get-token file)]
        [(char-alphabetic? c)
         (get-word file)]
        [(char-numeric? c)
         (get-number file)]
        [(eq? c #\+) (get-char file) '+]
        [(eq? c #\-) (get-char file) '-]
        [(eq? c #\*) (get-char file) '*]
        [(eq? c #\/) (get-char file) '/]
        [(eq? c #\=) (get-char file) #\=]
        [else (error 'get-token "Bad character" c)]))))

(define get-tokens
  (lambda (file)
    (let ([token (get-token file)])
      (if (eq? token 'end-of-file)
          '()
          (cons token (get-tokens file))))))
    
(define tokenize
  (lambda (filename)
    (let ([file (open-input-file filename)])
      (get-tokens file))))

(define test-lexer-fail
  (lambda (input want got)
    (display "text-lexer-fail: input=")
    (write input)
    (display "; want: ")
    (write want)
    (display "; got: ")
    (write got)
    (display ".")
    (newline)))

(define test-lexer-success
  (lambda (input got)
    (display "text-lexer-success: input=")
    (write input)
    (display "; got: ")
    (write got)
    (display ".")
    (newline)))

(define test-lexer
  (lambda (input want)
    (let ([port (open-string-input-port input)])
      (call/cc
        (lambda (i-got-exception)
          (with-exception-handler
            (lambda (x)
              (display "test-lexer-fail: input ")
              (write input)
              (display " throws ")
              (write x)
              (display ".")
              (newline)
              (i-got-exception x))
            (lambda ()
              (let ([got (get-tokens port)])
                (if (equal? got want)
                (test-lexer-success input got)
                (test-lexer-fail input want got))))))))))

(test-lexer "hello world" '("hello" "world"))
(test-lexer "+ * / -" '(+ * / -))
(test-lexer "identifier = 14" '("identifier" = 14))