fork download
  1. ;; (import (chicken string))
  2. ;; (import (chicken format))
  3. (define (drop-while pred clist)
  4. (if (or (null? clist) (not (pred (car clist))))
  5. clist
  6. (drop-while pred (cdr clist))))
  7. (define cons*
  8. (case-lambda
  9. (() (cons))
  10. ((a) (cons a))
  11. ((a b) (cons a b))
  12. ((a b c) (cons a (cons b c)))
  13. ((a b c d) (cons a (cons b (cons c d))))
  14. ((a b c d e) (cons a (cons b (cons c (cons d e)))))
  15. (xs (let ((xs (reverse xs))) (foldl (flip cons) (car xs) (cdr xs))))))
  16. (define (f s)
  17. (define (aux acc cs)
  18. (if (null? cs)
  19. acc
  20. (let ((c (car cs)) (cs (cdr cs)))
  21. (if (eq? c #\ )
  22. (aux (cons* c c c c acc) (drop-while (cut eq? c <>) cs))
  23. (aux (cons c acc) cs)))))
  24. (reverse-list->string (aux '() (string->list s))))
  25. (define (g s)
  26. (format #t "\"~A\" -> \"~A\"~%" s (f s)))
  27. (g "a b c")
  28. (g " a ")
  29. (g " a")
  30. (g "a ")
  31. (g " ")
  32. (g "")
  33.  
Success #stdin #stdout 0.02s 8020KB
stdin
Standard input is empty
stdout
"a b     c" -> "a    b    c"
" a " -> "    a    "
"  a" -> "    a"
"a  " -> "a    "
" " -> "    "
"" -> ""