; spell checking
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
(char=? (peek-char p) c))
(read-char p)))
(let ((p (if (null? port) (current-input-port) (car port))))
(let loop ((c (read-char p)) (line '()))
(cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
(else (loop (read-char p) (cons c line)))))))
(define a-null '())
(define (a-look c a)
(cond ((null? a) #f)
((char-ci<? c (caar a)) #f)
((char-ci<? (caar a) c) (a-look c (cdr a)))
(else (car a))))
(define (a-bind c x a)
(cond ((null? a) (list (cons c x)))
((char-ci<? c (caar a)) (cons (cons c x) a))
((char-ci<? (caar a) c) (cons (car a) (a-bind c x (cdr a))))
(else (cons (cons c x) (cdr a)))))
(define t-null (cons '() a-null))
(define (t-look ks t)
(if (null? ks)
(if (pair? (car t)) (caar t) #f)
(let ((x (a-look (car ks) (cdr t))))
(if x (t-look (cdr ks) (cdr x))#f))))
(define (t-bind ks x t)
(if (null? ks) (cons (list x) (cdr t))
(let* ((a1 (a-look (car ks) (cdr t)))
(t2 (t-bind (cdr ks) x (if (pair? a1) (cdr a1) t-null))))
(cons (car t) (a-bind (car ks) t2 (cdr t))))))
(define (make-dict filename)
(with-input-from-file filename
(lambda ()
(let loop ((word (read-line)) (dict t-null))
(if (eof-object? word) dict
(loop (read-line) (t-bind (string->list word) #t dict)))))))
(define dict (make-dict "/usr/dict/words"))
(define (spell word)
(t-look (string->list word) dict))