CLでSRFI-86 — #:g1

Posted 2011-05-19 11:51:00 GMT

ボツになったSRFIを眺めていて、SRFI-92 alambdaという変なものをみつけ、これはボツになりそうだなーとか思っていたら、LAMBDAの形式ではなくLETの形式であるSRFI-86はボツになってなかったので、面白そうだということでCLに移植してみることにしました。
- srfi-86.
- (http://srfi.schemers.org/srfi-86/srfi-86.html)
このSRFI-86ですが、これまでのLISP系に登場した束縛系の構文の全部盛りのような感じです。

多値 & 分配束縛

muとかnuとか謎ですが、VALUES-LISTみたいな感じでしょうか
(alet (a (mu 1 2)
        ((b c) (mu 3 4)))
  (list a b c))
;=> ((1 2) 3 4)

(alet (((a . b) (nu '(1 2 3 4)))) (list a b)) ;=> (1 (2 3 4))

(alet (((values a b) (floor 3 4))) (list a b)) ;=> (0 3)

名前付きLET

名前付きLETもサポートしています。名前付きLETは構文の形から一つしか名前を持てないことが残念だったのか、束縛部の後ろに名前を持ってくるという方法で複数の関数が定義できるようです。そして入れ子にもできたりします。
(alet* tag ((a 1)
            (a b b c (mu (+ a 2) 4 5 6))
            ((d e e) b 5 (+ a b c)))
  (if (< a 10)
      (funcall tag a 10 b c c d e d)
      (list a b c d e)))
;=> (10 6 6 5 5)

(alet fact ((n 10) (a 1)) (if (zerop n) a (funcall fact (1- n) (* a n)))) ;=> 3628800

;; 名前が後ろにある形式の名前付きLET (alet (((n 10) (a 1) . fact)) (if (zerop n) a (funcall fact (1- n) (* a n)))) ;=> 3628800

;; intagとtagで入れ子 (alet* ((a 1) ((b 2) (b c c (mu 3 4 5)) ((d e d (mu a b c)) . intag) . tag) (f 6)) (if (< d 10) (funcall intag d e 10) (if (< c 10) (funcall tag b 11 c 12 a b d intag) (list a b c d e f)))) ;=> (1 11 12 10 3 6)

継続関係

call/ccの糖衣構文で、let/ccなどがありますが、そういうのも取り込んだようです。
CLでは残念ながら脱出しかできないので、blockに変換することにしました。
SRFI-86の例をみると、継続を利用してリスタート的な機構も実現しようとしている様子…。
; 脱出(継続)
(alet lp ((win)
          (list '(1 2 3 4 5 6 7)))
  (cond ((= 3 (car list))
         (win (car list)))
        ('T (print (car list))
            (funcall lp (cdr list)))))
;->
;   1
;   2
;=> 3

制御構文関係

たまに欲しくなるSRFI-2のand-let*ですが、そういう制御構文系のもの取り込んでいるようです。
;; and-let*
(alet* ((alist '((a . 1) (b . 2) (c . 3)))
        (and (a (assoc 'b alist))))
  (cdr a))
;=> 2

lambda-list系

CLでいう&rest、&optional、&key関係ですが、その辺もサポート。CLのものより強力なのかもしれません。
;; キーワードで分配
(alet ((key '(b 20 a 10 c 30)
            (a :init)
            (b :init)
            (c :init)
            (d :init)))
  (list a b c d))
;=> (10 20 30 :INIT)

;; 比較/destructuring-bind (destructuring-bind (&key ((a a) :init) ((b b) :init) ((c c) :init) ((d d) :init)) '(b 20 a 10 c 30) (list a b c d)) ;=> (10 20 30 :INIT)

;; もっとエグい (alet ((key '(a 10 cc 30 40 b 20) (a 1) (b 2) ((c 'cc) 3) . d)) (list a b c d)) ;=> (10 2 30 (40 B 20))

(alet ((key '(:a 10 :cc 30 40 b 20) ((a :a) 1) ((b :b) 2) ((c :cc) 3) . d)) (list a b c d)) ;=> (10 2 30 (40 B 20))

;; 文字もキーにできる (alet ((key '("a" 10 "cc" 30 40 b 20) ((a "a") 1) ((b "b") 2) ((c "cc") 3) . d)) (list a b c d)) ;=> (10 2 30 (40 B 20))

letrec系

名前付きLETが複数の名前を持てるように拡張されているのに、letrecに相当するものもサポート
(alet ((rec (fact (lambda (n)
                    (if (zerop n)
                        1
                        (* n (funcall fact (1- n))))))))
  (funcall fact 10))
;=> 3628800

その他

その他、使いたくなるのかどうか良く分からないもの
(let (a b)
  (alet ((a :a)
         (b :b)
         (() (setq a 100 b 200)))
    (list a b)))
;=> (:A :B)

≡ (let (a b) (setq a 100 b 200) (alet ((a :a) (b :b)) (list a b))) ;=> (:A :B)

(let (a b)
  (alet* ((a :a)
          (b :b)
          (() (setq a 100 b 200)))
    (list a b)))
;=> (100 200)

≡ (let (a b) (alet* ((a :a) (b :b)) (setq a 100 b 200) (list a b))) ;=> (100 200)

(alet ((cat '(1 -2 3)
            (a 0 (plusp a))
            (b 0 (plusp b))
            (c 0 (plusp c))
            . d))
  (list a b c d))
;=> (1 3 0 (-2))

色々複合した例

(let (m n)
  (alet* ((a (progn (princ "1st") 1))
          ((b c) 2 (progn (princ "2nd") 3))
          (() (setq m nil) (setq n (list 8)))
          ((d (progn (princ "3rd") 4))
           (key '(e 5 tmp 6) (e 0) ((f 'tmp) 55)) . p)
          g (nu (progn (princ "4th") 7) n)
          ((values . h) (apply #'values 7 (progn (princ "5th") n)))
          ((m 11) (n n) . q)
          (rec (i (lambda () (- (funcall j) 1)))
               (j (lambda ()  10)))
          (and (k (progn (princ "6th") m))
               (l (progn (princ "end") (terpri) 12)))
          (o))
    (if (< d 10)
        (funcall p 40 50 60)
        (if (< m 100)
            (funcall q 111 n)
            (progn (princ (list a b c d e f g h
                                (funcall i)
                                (funcall j)
                                k l m n))
                   (terpri))))
    (o (list 'o p q))
    (princ "This is not displayed")))
;-> 1st2nd3rd4th5th6thend
;   4th5th6thend
;   6thend
;   (1 2 3 40 50 60 (7 8) (7 8) 9 10 111 12 111 (8))
;
;=> (O # #)

移植について

移植は、define-syntaxがあるのでmbeを利用。
200行近い大きさのマクロが果して正しく動いてるかどうかは謎です。
テストのセットがあると良いのですが…。
オリジナルと違うところとしては、内部のletrec系の動作は、最初ローカル関数のlabelsでの定義に置き換えようとしていましたが、letrec+funcallにしてしまいました。
継続系は、脱出継続としてblockをあてはめました。リスタート的なものもできなくはないですが、もうちょっと構成が掴めてから挑戦してみたいと思っています。

どうもSRFI-86をサポートしているScheme処理系は少ないようですが、なんとなく分かる気もしました…。

comments powered by Disqus