フラットなリストをネストしたリストに

こういうリストを

(1 2 3 4 :hoge 5 6 7 8 9 10 :end 11 12 13 :foo 14 15 16 :bar 17 18 :baz 19 20 :end :end 21 22 :end 23 24)

こういう風に

(1 2 3 4 (:hoge 5 6 7 8 9 10 :end) 11 12 13 (:foo 14 15 16 (:bar 17 18 (:baz 19 20 :end) :end) 21 22 :end) 23 24)

あまり良い感じのコードも思い浮かばなかったので、素直に（愚直に？）書きました。(gauche)

(define (flat->nest start-pred end-pred ls
                    :optional (filter-func identity))
  (let rec ((ls ls)(acc '()))
    (if (null? ls)
        (values (reverse acc) '())
        (cond ((start-pred (car ls))
               (receive (nested rest)
                   (flat->nest start-pred end-pred (cdr ls) filter-func)
                 (rec rest (cons (filter-func (cons (car ls) nested)) acc))))
              ((end-pred (car ls))
               (values (reverse (cons (car ls) acc))
                       (cdr ls)))
              (else (rec (cdr ls)(cons (car ls) acc)))))))

実行

(define data
  '(1 2 3 4
      :hoge 5 6 7 8 9 10 :end
      11 12 13
      :foo 14 15 16 :bar 17 18 :baz 19 20 :end :end
      21 22 :end 23 24))

(flat->nest (^x (and (keyword? x)
                     (not (eq? :end x))))
            (^x (eq? :end x))
            data)

;; (1 2 3 4
;;    (:hoge 5 6 7 8 9 10 :end)
;;    11 12 13
;;    (:foo 14 15 16 (:bar 17 18 (:baz 19 20 :end) :end)
;;          21 22 :end)
;;    23 24)

いろいろとアレなので、どなたか良い感じにカッチョイイのがあったら教えてください。

追記

コメント欄より。

(define (flat->nest s e ls)
  (let loop ((a (pop! ls)))
    (cond ((null? ls) (cons a '()))
          ((s a)
           (let1 b (cons a (loop (pop! ls)))
             (cons b (loop (pop! ls)))))
          ((e a) (cons a '()))
          (else (cons a (loop (pop! ls)))))))

破壊的な操作も無条件に避けるのではなく、上手に取り入れないといけませんね。