[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/MDR7xq81    [ raw code | fork ]

programmingpraxis - Scheme, pasted on Oct 8:
; two word games

(define (sorted? lt? xs)
  (if (null? xs) #t
    (if (null? (cdr xs)) #t
      (and (lt? (car xs) (cadr xs))
           (sorted? lt? (cdr xs))))))

(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 (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 (game filter)
  (for-each-input (filter-input read-line filter)
    (lambda (word) (display word) (newline))
    "Desktop/moby.words"))

(define vowels '(#\a #\e #\i #\o #\u))

(define (vowel? c) (member c vowels))

(define (five-vowels-in-order? str)
  (equal? vowels (filter vowel? (string->list str))))

(define (sorted-and-six? str)
  (and (<= 6 (string-length str))
    (sorted? char<? (string->list str))))


Create a new paste based on this one


Comments: