; chopping words

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(define (mappend f . xss) (apply append (apply map f xss)))

(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 (read-words file-name)
  (with-input-from-file file-name
    (lambda ()
      (let loop ((word (read-line)) (words (list)))
        (if (eof-object? word) words
          (loop (read-line) (cons word words)))))))

(define words (read-words "moby.common"))

(define (word? str) (member str words))

(define (chops str)
  (let ((len (string-length str)))
    (define (chop n)
      (string-append
        (substring str 0 n)
        (substring str (+ n 1) len)))
    (filter word? (map chop (range len)))))

(define (chop str)
  (let loop ((wss (list (list str))))
    (if (= (string-length (caar wss)) 1)
        (map reverse wss)
        (loop (mappend
                (lambda (ws)
                  (map
                    (lambda (w) (cons w ws))
                    (chops (car ws))))
                wss)))))

(display (chop "planet"))