Сократить список

Задача из олимпиады для детей.

Получив на входе "1,3,4,5,6,7,8,10,12,16,17,20,21,22,23,24" надо отдать на выходе "1,3-8,10,12,16-17,20-24"

Вот моё решение:

(define (pack-2 n n1)
  (if (= (- (int n1) (int ((parse (-7 n) "[-,]" 0) -1))) 1)
    (append n "-" n1)
    (append n "," n1)))

(define (compact in)
  (replace "(-([^,]+-)+)" (apply pack-2 (parse in ",") 2) "-" 0))

Всё бы ничего, только скорость не радует. На последовательности в 100 000 символов программа думает аж четыре минуты. А надо миллион, да...

Оптимизировал немного код и свёл его в одну функцию, убрал медленный apply/reduce:

(define (compact in)
  (replace "(-([^,]+-)+)"
    (replace "([0-9]+),(?=([0-9]+))" in
      (if (= (- (int $2) (int $1)) 1) (append $1 "-") $it)
      0) "-" 0))

Время обсчёта 100 000 — 0,7 секунды. Время на 1М — 7 секунд. Время на 10М — 66 секунд. Задача выполнена, не?