

common lisp初心者なのですが、誰か教えていただけないでしょうか。

CLISPで、Ocamlのように再帰関数を同一の関数名でラップしたい場合、どのようにするべきでしょうか。 たとえば、以下のreverseのような例です。

[code]

    let rec reverse xs ys =
        match xs with
        | [] -> ys
        | x::xs -> reverse xs (x::ys);;
    let reverse xs = reverse xs [];;
    
[/code]

この問題を解決しようと思い、自分でマクロを書いてみました。

[code]

    (defconstant else t)
    
    (defmacro defun* (sym bindings &body body)
      (let ((temp (gensym))
            (rest (gensym)))
        `(setf (symbol-function ',sym)
               (function
                (lambda ,bindings
                 (let ((,temp (symbol-function ',sym)))
                   (flet ((,sym (&rest ,rest)
                            (apply ,temp ,rest)))
                     ,@body)))))))
    
    (defun my-reverse (xs ys)
      (cond ((null xs) ys)
            (else
             (my-reverse (cdr xs) (cons (car xs) ys)))))
    
    
    (defun* my-reverse (xs)
      (my-reverse xs (list)))
    
[/code]

しかし、これをSBCLで評価しようとするとエラーが出てしまいます。

[code]

    * (my-reverse '(1 2 3))
    
    debugger invoked on a SB-INT:SIMPLE-PROGRAM-ERROR:
      invalid number of arguments: 2
    
[/code]

解決策を教えていただけませんでしょうか。


CC BY-SA 3.0
2014-12-21T22:15:55.097
2342
2014-12-23T06:05:37.820
2014-12-22T00:52:02.720
939
5453
question
common-lisp
common lisp で OCaml 風の書き方をしたい。


Common Lispには、let recに相当するものとして、labelsがありますので、それを使えば、
ほぼそのまま書けるので、定義用のマクロを書く必要はないと思います。

下記では、パターンマッチにoptimaを使用しています。

[code]

    (ql:quickload :optima)
    
    
    ;;; a
    (defun rev (xs)
      (labels ((rev (xs ys)
                 (optima:match xs
                   ('() ys)
                   ((cons x xs) (rev xs (cons x ys))))))
        (rev xs '() )))
    
    
    ;;; b
    (labels ((rev (xs ys)
               (optima:match xs
                 ('() ys)
                 ((cons x xs) (rev xs (cons x ys))))))
      (defun rev (xs)
        (rev xs '() )))
    
    
    (rev '(0 1 2 3 4 5 6 7 8 9))
    ;=>  (9 8 7 6 5 4 3 2 1 0)
    
[/code]

bの方が元のプログラムに形は似ていますが、aの方がCommon Lisp的には最適化面で都合が良いです。

元のプログラムが動かない理由ですが、大域のmy-reverse関数は一つしか引数を取らないところに2つ引数を与えているからです。

定義されているdefun*については、何が悪いのか、Common
Lispの基本的な仕組みと使っている関数の仕様をもう一度確認してみると良いのではないでしょうか。

また、スタイル的な問題ですが、

[code]

    (defconstant else t)
    
[/code]

はelseが(同一パッケージ内で)束縛変数名として使えなくなってしまうので、良くありません。

[code]

    (Defmacro myif (pred then &Optional else)
      ...)
    
[/code]

のようなマクロを書いて謎のエラーに悩んだりする羽目になります。

[code]

    (cond ((...))
          (:else ...));or 'else
    
[/code]

位で妥協するのが良いかなと思います。


CC BY-SA 3.0
2014-12-22T00:52:25.917
2344
2014-12-22T00:52:25.917
3510
2342
answer


そうですね、、、再帰関数を同一の関数名でラップするのではなくて、optional argument を使ってみてはいかがでしょうか。

[code]

    (defun my-reverse (xs &optional ys)
      (cond ((null xs) ys)
            (t (my-reverse (cdr xs) (cons (car xs) ys)))))
    
    (my-reverse '(1 2 3))
    => (3 2 1)
    
[/code]


CC BY-SA 3.0
2014-12-22T02:49:21.620
2347
2014-12-22T02:49:21.620
2342
answer


`defun*` マクロですが、以下の様に書いてみました。

[code]

    (defmacro defun* (sym bindings &body body)
      (let ((my_pkg "MY-FUNCTIONS"))
        `(progn
           (or (find-package ,my_pkg)
               (make-package ,my_pkg :use '(common-lisp)))
           (setf (symbol-function
                  (intern (string ',sym) ,my_pkg))
                 (symbol-function ',sym))
           (unintern ',sym)
           (setf (symbol-function (intern (string ',sym)))
                 (lambda ,bindings
                   (let ((*package* (find-package ,my_pkg)))
                     ,@body))))))
    
[/code]

別パッケージ(MY-FUNCTIONS)を作成して、そちらに元の関数と同名のシンボルを作成して関数バインディングを退避させています。

[code]

    (defun my-reverse (xs ys)
      (cond ((null xs) ys)
            (t (my-reverse (cdr xs) (cons (car xs) ys)))))
    
    (defun* my-reverse (xs) (my-reverse xs '()))
    
    (my-reverse '(1 2 3 4 5))
    => (5 4 3 2 1)
    
[/code]

この `defun*` マクロは SBCL 1.0.50 では動作しますが、他の Common Lisp 処理系では動かないかもしれません。


CC BY-SA 3.0
2014-12-22T18:11:18.237
2397
2014-12-23T06:05:37.820
2014-12-23T06:05:37.820
2342
answer


defun*を書き直してみました。

無理矢理感が拭えないですが、一応、動いてくれています。

[code]

    (defmacro defun+ (funsym bindings &body body)
      `(defun ,funsym ,bindings
         (labels ((,funsym ,bindings ,@body))
           ,(cons funsym bindings))))
    
    (defmacro defun* (funsym bindings &body body)
      (let ((temp (gensym))
            (fexist (fboundp funsym)))
        `(progn
           (when ,fexist
             (setf (symbol-function ',temp)
                   (symbol-function ',funsym)))
           (defun ,funsym ,bindings
             (if ,fexist
                 (flet ((,funsym (&rest rest)
                          (apply #',temp rest)))
                   (progn ,@body))
                 (progn ,@body))))))
    
    
    (defun+ my-reverse (xs ys)
      (cond ((null xs) ys)
            (:else
             (my-reverse (cdr xs) (cons (car xs) ys)))))
    
    (defun* my-reverse (xs)
        (my-reverse xs (list)))
    
[/code]


CC BY-SA 3.0
2014-12-23T00:35:49.727
2404
2014-12-23T00:35:49.727
5543
2342
answer