a lexer for fun

lexer.scm

(define sm '((0 ("A" 1)) (1 ("A" 3) ("B" 2)) (2 (end 2) ("C" 7)) (3 ("B" 4)) 
             (4 ("B" 6) (end 4)) (6 (end 6)) (7 ("C" 8)) (8 ("D" 9)) (9 (end 9))))
(define ll '((2 . "AB") (4 . "AAB") (6 . "AABBB") (9 . "ABCCD")))
(define (my-lexer str)
  (call-with-input-string 
   str
   (lambda (port)
     (let lp((stat 0) (c (read-char port)) (ret '()))
       (if (eof-object? c) 
           (let* ((now (assoc-ref sm stat)) (w (assoc-ref now 'end)))
             (reverse (if w (cons (assoc-ref ll (car w)) ret) ret)))
           (let ((now (assoc-ref sm stat)))
             (cond
              ((null? now)
               (unread-char c port)
               (lp 0 (read-char port) (cons (assoc-ref ll stat) ret))) ; ended node
              ((not now) (lp 0 (read-char port) ret)) ; invalid char
              ((assoc-ref now (string c)) => (lambda (s) (lp (car s) (read-char port) ret)))
              (else ; force ended
               (let ((x (assoc-ref ll stat)))
                 (and x (unread-char c port))
                 (lp 0 (read-char port) (if x (cons x ret) ret)))))))))))

(my-lexer "ABABCCDAABAABBBAAB")
==> ("AB" "ABCCD" "AAB" "AABBB" "AAB")