; ordered vowels

(define (vowel? c)
  (member c '(#\a #\e #\i #\o #\u #\A #\E #\I #\O #\U)))

(define (ordered-vowels? str)
  (let loop ((cs (string->list str)) (prev #\space))
    (cond ((null? cs) #t)
          ((not (vowel? (car cs))) (loop (cdr cs) prev))
          ((char<=? prev (car cs)) (loop (cdr cs) (car cs)))
          (else #f))))

(define (ordered-vowel-words filename)
  (with-input-from-file filename
    (lambda ()
      (let loop ((word (read-line)))
        (unless (eof-object? word)
          (when (ordered-vowels? word)
            (display word) (newline))
          (loop (read-line)))))))

(display (ordered-vowels? "afoot")) (newline)

(define (for-each-input reader proc . pof)
  (let* ((f? (and (pair? pof) (string? (car pof))))
         (p (cond (f? (open-input-file (car pof)))
                  ((pair? pof) (car pof))
                  (else (current-input-port)))))
    (do ((item (reader p) (reader p)))
        ((eof-object? item)
          (if f? (close-input-port p)))
      (proc item))))

(define (filter-input reader pred?)
  (lambda args
    (let loop ((item (apply reader args)))
      (if (or (eof-object? item) (pred? item)) item
        (loop (apply reader args))))))

(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 (sorted? lt? xs)
  (cond ((null? xs) #t)
        ((null? (cdr xs)) #t)
        ((lt? (cadr xs) (car xs)) #f)
        (else (sorted? lt? (cdr xs)))))

(define (ordered-vowels? str)
  (sorted? char<? (filter vowel? (string->list str))))

(define (ordered-vowel-words filename)
  (for-each-input
    (filter-input read-line ordered-vowels?)
    (lambda (word) (display word) (newline))
    filename))

(display (ordered-vowels? "afoot")) (newline)