; remove singleton

(define (remove-singleton c str)
  (define (none ins outs)
    (cond ((null? ins) outs)
          ((char=? (car ins) c) (one (cdr ins) outs))
          (else (none (cdr ins) (cons (car ins) outs)))))
  (define (one ins outs)
    (cond ((null? ins) outs)
          ((char=? (car ins) c) (many (cdr ins) (cons c (cons c outs))))
          (else (none (cdr ins) (cons (car ins) outs)))))
  (define (many ins outs)
    (cond ((null? ins) outs)
          ((char=? (car ins) c) (many (cdr ins) (cons c outs)))
          (else (none (cdr ins) (cons (car ins) outs)))))
  (list->string (reverse (none (string->list str) (list)))))

(define-syntax assert
  (syntax-rules ()
    ((assert expr result)
      (if (not (equal? expr result))
          (for-each display `(
            #\newline "failed assertion:" #\newline
            expr #\newline "expected: " ,result
            #\newline "returned: " ,expr #\newline))))))

(define (test-remove-singleton) ; no news is good news
  (assert (remove-singleton #\X "") "")
  (assert (remove-singleton #\X "X") "")
  (assert (remove-singleton #\X "XX") "XX")
  (assert (remove-singleton #\X "XXX") "XXX")
  (assert (remove-singleton #\X "abcd") "abcd")
  (assert (remove-singleton #\X "Xabcd") "abcd")
  (assert (remove-singleton #\X "XXabcd") "XXabcd")
  (assert (remove-singleton #\X "XXXabcd") "XXXabcd")
  (assert (remove-singleton #\X "abcdX") "abcd")
  (assert (remove-singleton #\X "abcdXX") "abcdXX")
  (assert (remove-singleton #\X "abcdXXX") "abcdXXX")
  (assert (remove-singleton #\X "abXcd") "abcd")
  (assert (remove-singleton #\X "abXXcd") "abXXcd")
  (assert (remove-singleton #\X "abXXXcd") "abXXXcd")
  (assert (remove-singleton #\X "XabXcdX") "abcd")
  (assert (remove-singleton #\X "XXabXXcdXX") "XXabXXcdXX")
  (assert (remove-singleton #\X "XXXabXXXcdXXX") "XXXabXXXcdXXX"))

(test-remove-singleton)