73 lines
		
	
	
		
			1.9 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
			
		
		
	
	
			73 lines
		
	
	
		
			1.9 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
| (define-library (lexer)
 | |
|   (export tokenize)
 | |
|   (import (scheme base)
 | |
|           (scheme write)
 | |
|           (scheme char))
 | |
|   (begin
 | |
|     (define-record-type lexer
 | |
|       (make-lexer-with-index input index)
 | |
|       lexer?
 | |
|       (input lexer-input lexer-input-set!)
 | |
|       (index lexer-index lexer-index-set!))
 | |
| 
 | |
|     (define-record-type lexer-error
 | |
|       (make-lexer-error type message)
 | |
|       lexer-error?
 | |
|       (type lexer-error-type)
 | |
|       (message lexer-error-message)
 | |
|     ))
 | |
| 
 | |
|     (define make-lexer
 | |
|       (lambda (input)
 | |
|         (make-lexer-with-index input 0)))
 | |
| 
 | |
|     (define lexer-end?
 | |
|       (lambda (lexer)
 | |
|         (>= (lexer-index lexer)
 | |
|             (string-length (lexer-input lexer)))))
 | |
| 
 | |
|     (define lexer-peek
 | |
|       (lambda (lexer)
 | |
|         (if (lexer-end? lexer)
 | |
|           (eof-object)
 | |
|           (string-ref (lexer-input lexer)
 | |
|                       (lexer-index lexer)))))
 | |
| 
 | |
|     (define lexer-eat!
 | |
|       (lambda (lexer)
 | |
|         (if (lexer-end? lexer)
 | |
|           (eof-object)
 | |
|           (let ((index (lexer-index lexer)))
 | |
|             (lexer-index-set! lexer (+ index 1))
 | |
|             (string-ref (lexer-input lexer) index)))))
 | |
| 
 | |
|     (define get-token
 | |
|       (lambda (lexer)
 | |
|         (let ((c (lexer-peek lexer)))
 | |
|           (cond
 | |
|             ((eof-object? c) "")
 | |
|             ((char-alphabetic? c)
 | |
|              (lexer-eat! lexer)
 | |
|              (string-append (string c) (get-token lexer)))
 | |
|             (else "")))))
 | |
| 
 | |
|     (define get-tokens
 | |
|       (lambda (lexer)
 | |
|         (let loop ((tokens #()))
 | |
|           (let ((c (lexer-peek lexer)))
 | |
|             (cond
 | |
|               ((eof-object? c) tokens)
 | |
|               ((char-whitespace? c)
 | |
|                (lexer-eat! lexer)
 | |
|                (loop tokens))
 | |
|               ((char-alphabetic? c)
 | |
|                (let ((token (get-token lexer)))
 | |
|                  (if (lexer-error? token)
 | |
|                      token
 | |
|                      (loop )))))))
 | |
|                
 | |
|             
 | |
|     (define tokenize
 | |
|       (lambda (input)
 | |
|         (get-tokens (make-lexer input))))))
 |