syntax-caseでどう書く？的

"Scheme どう書く？的 - ひげぽん OSとか作っちゃうかMona-のトラックバックを見ていたら・・・Scheme どう書く？的をScalaで書いてみた - 玲瓏庵にあるScalaのコードが羨ましかったので、ひげぽんさんの所のコメント欄に入れたコードを少しおしゃれに書き直してみる。む〜、これ以上は何かマクロを作らないと無理かな〜

;; datum definition from Chez Scheme User's Guide
(define-syntax datum (syntax-rules () [(_ t) (syntax->datum (syntax t))]))

(define (compact-number-list x)
  (let loop ((x (cons '[] x)))
    (syntax-case x ()
      (([(lo . hi) r ...] new more ...)
       (if (= (datum new) (+ (datum hi) 1))
           (loop (datum ([(lo . new) r ...] more ...)))
           (loop (datum ([(new . new) (lo . hi) r ...] more ...)))))
      (([] new more ...) (loop (datum ([(new . new)] more ... ))))
      ((ans) (reverse (map (lambda (e) (if (= (car e) (cdr e)) (car e) e)) 
                           (datum ans)))))))

(compact-number-list '(1 3 4 5 6 12 13 15))
=> (1 (3 . 6) (12 . 13) 15)

ちなみに元のコードはこれです。

(define (compact-number-list x)
  (define (test e1 e2)
    (= (syntax->datum e1) (+ (syntax->datum e2) 1)))
  (let loop ((x (cons '[] x)))
    (syntax-case x ()
      (([(lo . hi) r ...] new more ...)
       (if (test #'new #'hi)
           (loop (syntax->datum #'([(lo . new) r ...] more ...)))
           (loop (syntax->datum #'([new (lo . hi) r ...] more ...)))))
      (([lo r ...] new more ... )
       (if (test #'new #'lo)
           (loop (syntax->datum #'([(lo . new) r ...] more ... )))
           (loop (syntax->datum #'([new lo r ...] more ... )))))
      (([] new more ...)
       (loop (syntax->datum #'([new] more ... ))))
      ((ans)
       (reverse #'ans)))))

注意：ここに書いたコードは実行時にマクロ展開を行うので速度は期待できません。