fork download
  1. ; string prefixes
  2.  
  3. (define (fold-left op base xs)
  4. (if (null? xs)
  5. base
  6. (fold-left op (op base (car xs)) (cdr xs))))
  7.  
  8. (define (prefix-two eql? x1 x2)
  9. (let loop ((x1 x1) (x2 x2) (zs (list)))
  10. (cond ((or (null? x1) (null? x2))
  11. (reverse zs))
  12. ((eql? (car x1) (car x2))
  13. (loop (cdr x1) (cdr x2)
  14. (cons (car x1) zs)))
  15. (else (reverse zs)))))
  16.  
  17. (define (prefix eql? xss)
  18. (if (null? xss)
  19. (error 'prefix "no input")
  20. (fold-left (lambda (x1 x2)
  21. (prefix-two eql? x1 x2))
  22. (car xss) (cdr xss))))
  23.  
  24. (define (string-prefix xs)
  25. (list->string
  26. (prefix char=?
  27. (map string->list xs))))
  28.  
  29. (display (string-prefix '(
  30. "I love cats"
  31. "I love dogs"
  32. "I love my daughters")))
Success #stdin #stdout 0.03s 8656KB
stdin
Standard input is empty
stdout
I love