Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-10-13

TAOの!をCLで再現したい

| 10:09 | TAOの!をCLで再現したい - わだばLisperになる を含むブックマーク はてなブックマーク - TAOの!をCLで再現したい - わだばLisperになる

ELISは国産Lispマシンで、その処理系である、TAO/ELISは、PrologとSmalltalkとZetalispを足したような感じになっています。

このTAO/ELIS以外にも、その後続のTAO/SILENT等バリエーションはあるようなのですが、TAO/ELISはマニュアルが公開されているので、マニュアルから動作を推測してCLで関数/マクロを作ってみるのも一興です。

ということで、自分は、昨年あたりに毎日TAOのマニュアルを眺めながら、関数を作成していた訳なのですが、CLで真似するには一筋縄では行かないようなものが沢山あります。

その中の一つが今回のテーマである!の解釈なのですが、TAOでは、!を色々に解釈します。

  1. (!x 3) → (setf x 3)のような代入の構文として
  2. (! nil ! t) → バックトラックするor
  3. (! nil ! t) → 同じくバックトラックする構文でのカット記号
  4. cdr!、cons! → 普通の関数名/マクロ名に現われる
  5. (!!cons !x y) → 自己代入式の!!
  6. (!!cons !x y) → 同じく、自己代入式での代入される変数の目印としての!

という風に様々です。

単体の!等はリーダーマクロにしても良いのですが、そうすると他の!が上手く動かず、普通のマクロにしては、!xや、!!consという風に表記することもできません。

ということで、色々悩んで、アスキー文字以外のものを使ってみることも考えたりしました(TAOの!! - わだばLisperになる - cadr group)が、今回他の方法として、!!と、!は、妥協してディスパッチマクロにしてしまうことにしました。

とりあえず、!は、setfに置き換えてしまえば解決しますが、それだけだと!!が動かなくなってしまうので、

(set-dispatch-macro-character #\# #\!
                              (lambda (stream char arg)
                                (declare (ignore char arg))
                                (if (char= #\! (peek-char nil stream))
                                    (progn
                                      (read-char stream nil nil)
                                      'selfass)
                                    'setf)))

としてみました。

それで、!!はselfassという名前をつけて#!!から展開するようにします。

(defmacro selfass (fn &rest args)
  (let (var nargs)
    (dolist (item args)
      (if (and (symbolp item)
               (string-equal "!" (subseq (string item) 0 1)))
          (LET ((sym (intern (subseq (string item) 1))))
            (push sym var)
            (push sym nargs))
          (PUSH item nargs)))
    `(setq ,(car var) (,fn ,@(nreverse nargs)))))
(let ((foo 0))
  (#!foo 3)
 
  (#!!cons !foo ())
  foo)
;=> (3)

(let ((x 40))
  (#!!list 10 20 30 !x 50)
  x)

;=> (10 20 30 40 50)

#が気になりますが、とりあえず、良しとします。

それで他のリーダーマクロではないものですが、

cdr!は、(setq foo (cdr foo))のような動きをするもので、cons!も似た感じで、(cons! x y) → (setq x (cons x y))という物です。

cdr!はpopと副作用は同じですが返り値がcdrって感じなのでしょうか。

あとは、バックトラックするorの!ですが、これは、Prolog系の節で使うらしく、マニュアルからだけでは、詳細が不明なのですが、とりあえず無理に作ってみました。

こんな感じに動作します。

(let ((foo 0)
      result)
  (! result
     (= foo 100)
     (progn (#!!1+ !foo) 
            (#!!append !result (list foo)))))

(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
 100)

動作の解説ですが、

1. resultはnilなので先に進む(ORなので…)

2. (= foo 100)はnilなので先に進む

3. (progn (#!!1+ !foo) (#!!append !result (list foo)))/CL風だと(progn (incf foo) (push foo result))/は、非nilなので前に戻る

4. (= foo 100)はnilなので先に進む

... 繰り返し...

5. (= foo 100)はtなので前に戻る

6. resultは非nilなので戻りたいが、入口なので結果となる

という感じかなと思っています。

ちなみに、補助変数が取れるので、

(! (&aux (foo 0) result)
   result
   (= foo 100)
   (progn (#!!1+ !foo) 
          (#!!append !result (list foo))))

とも書けます。

また、多分、

(! nil ! nil nil)

みたいな場合は、カットを入れないと無限ループじゃないかなあと推測しています。

以下が、作成してみたコードですが、GOTOしまくりで、かなり無理矢理ですので、良かったらマクロ展開してみて下さい(笑)

もっと良い書き方あるよ!、TAOじゃそんな動きはしないよ!等々のアドバイスお待ちしております!

(defmacro ! (&body forms)
  (let ((aux-vars (and (consp (car forms))
                       (string-equal '&aux (string (caar forms)))
                       (prog1 (cdar forms) (pop forms))))
        (exit (gensym "EXIT-")))
    (cl:loop 
       :with cuts 
       :and tags := (list exit)
       :and body 
       :and ans := (gensym "ANS-")

       :for x :in forms
       :if (and (symbolp x) (string-equal '! x))
       :do (progn
             (push (gensym "CUT-") cuts)
             (push `(if ,(car cuts) (go ,exit) (setq ,(car cuts) t))
                   (cdr body)))
       :else 
       :do (progn
             (push (gensym "TAG-") tags)
             (push (car tags) body)
             (push `(and (setq ,ans ,x) (go ,(cadr tags))) body))
       :finally (return `(prog* (,ans ,@aux-vars ,@cuts)
                            ,@(nreverse body)
                            ,exit
                            (return ,ans))))))

ClojureでL-99 (P22 指定した範囲の数列のリスト)

| 06:26 | ClojureでL-99 (P22 指定した範囲の数列のリスト) - わだばLisperになる を含むブックマーク はてなブックマーク - ClojureでL-99 (P22 指定した範囲の数列のリスト) - わだばLisperになる

fromの反対のdownfromとか定義してみましたが、もう一工夫という感じです。

ちなみに、標準で、Clojureには、rangeがありますが、このお題と同じ動きではありません。

(defn downfrom 
  ([start]
     (downfrom start 1))
  ([start step]
     (iterate #(- % step) start)))

(defn
  #^{:doc "P22 (*) Create a list containing all integers within a given range."
     :test (do (test= (my-range 4 9)
                      '(4 5 6 7 8 9))
               (test= (my-range 9 4)
                      '(9 8 7 6 5 4))
               (test= (my-range 3 3)
                      '(3)))}
; --------
  my-range
; --------
  ([start end]
     (cond (< start end) 
           (take (+ 1 (- start) end) (from start))
           (> start end) 
           (take (+ 1 start (- end)) (downfrom start))
           :else
           (list start))))