続・compact-number-list他

畳み込みを使ったコードが出てきてたのを見て、CLで書いてみた。

(defun compact-number-list (x)
  (reduce
   #'(lambda(n r)
       (let ((c (car r)))
         (if (eql (1+ n) (or (safe-car c) c))
             `((,n .,(or (safe-cdr c) c)) ,@(cdr r))
             `(,n ,@r))))
   `(,@x nil) :from-end t))

ほぼirieさんのコードのコピペ。

もう1つ、scinfaxiさんの回答のfold2が気になったので調べてみる。
→ Gauche ユーザリファレンス: 8.2 ライブラリの命名規則
へーへーへー。面白い。
CLで書くとこんな感じ?

(defun fold2 (proc knil1 knil2 &rest lists)
  (if (some #'null lists)
      (values knil1 knil2)
      (multiple-value-bind (n1 n2)
          (apply proc `(,@(mapcar #'car lists) ,knil1 ,knil2))
        (apply #'fold2 proc n1 n2 (mapcar #'cdr lists)))))

(defun compact-number-list (r)
  (reverse
   (fold2
    (lambda (c r p)
      (values
       (if (= c (+ p 1))
           r
           (list* c (if (= #0=(car r) p) p (cons #0# p)) #1=(cdr r)))
       c))
    `(,#0#) #0# #1#)))

(compact-number-list '(1 3 4 5 7 8 9 12 13))
; => (1 (3 . 5) (7 . 9) 12)

ちゃんと動いた。

ついでに、#?=も気になったので調べてみる。
→ Gauche ユーザリファレンス: 3.4 デバッグ
便利そう。簡単なものを書いてみよう。

(defmacro debug-print (form)
  (let ((v (gensym)))
    `(progn
       (format t "~&#?= ~S~%" ',form)
       (let ((,v ,form))
         (format t "~&#?-     ~A" ,v)
         ,v))))

(set-dispatch-macro-character #\# #\?
  #'(lambda (s c1 c2)
      (declare (ignore c1 c2))
      (read-char s)
      `(debug-print ,(read s))))

実行

CL-USER> (defun fact (n)
  (if (= n 0) 1
      (* n #?=(fact (1- n)))))
FACT
CL-USER> (fact 5)
#?= (FACT (1- N))
#?= (FACT (1- N))
#?= (FACT (1- N))
#?= (FACT (1- N))
#?= (FACT (1- N))
#?-     1
#?-     1
#?-     2
#?-     6
#?-     24
120

とりあえずこれは動いたけど、リーダーの書き方がダメらしく

(list (debug-print (list #1=1 2 3)) #1#)

は大丈夫だけど

(list #?=(list #1=1 2 3) #1#)

はラベルが無い、と怒られる。

改善策が分からないのでまた今度。