codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; 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"))
Private
[
?
]
Run code
Submit