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 |

2009-06-28

40年前のlisp 1.5のプログラムをCLで

| 04:46 | 40年前のlisp 1.5のプログラムをCLで - わだばLisperになる を含むブックマーク はてなブックマーク - 40年前のlisp 1.5のプログラムをCLで - わだばLisperになる

CiNiiを漁っていたところ40年前(1969年)の和田英一先生の『プログラムのページ』という記事をみつけました。

こちらの記事はLISP 1.5で書いてあり、M式での定義も載っていたりするのですが、LISP 1.5のプログラムはCLに簡単に直訳できるのでCLに訳してみました。

ちなみに記事の中の「プログラムフィーチャー」というのはPROGのことです。

(defun *abs (x)
  (cond ((< x 0) (- x))
        (T x)))

(defun poly (x coef)
  (cond ((null coef) 0)
        (T (+ (car coef)
              (* x (poly x (cdr coef)))))))

(defun deriv (coef)
  (prog (u v w)
        (setq u 1.0)
        (setq w (cdr coef))
      A (cond ((null w) (return v)))
        (setq v (append v (list (* u (car w)))))
        (setq w (cdr w))
        (setq u (1+ u))
        (go A)))

(defun newton (initi coef eps)
  (prog (delta max)
        (print '(value of function argument))
        (setq max 20)
      A (cond ((zerop max) (return 'NG)))
        (setq delta (- (/ (car (print (list (poly initi coef)
                                            initi)))
                          (poly initi (deriv coef)))))
        (setq initi (+ initi delta))
        (cond ((< (*abs delta) eps) (return initi)))
        (setq max (1- max))
        (go A)))

これでも良いのですが、折角なのでLISP 1.5のプログラムに見えるようにユーティリティを準備してみます。

;; LISP 1.5っぽくdefineを定義
(defun define (defs)
  (mapc (lambda (def)
          (destructuring-bind (name body) def
            (setf (symbol-function name) (coerce body 'function))))
        defs))

;; LISP 1.5っぽくエイリアスを定義
(setf (symbol-function 'minus) #'-
      (symbol-function 'plus) #'+
      (symbol-function 'times) #'*
      (symbol-function 'quotient) #'/
      (symbol-function 'add1) #'1+
      (symbol-function 'sub1) #'1-
      (symbol-function 'lessp) #'< )
;; LISP 1.5風に書き直してみる
(define (quote (
  (*abs (lambda (x)
          (cond ((minusp x) (minus x))
                (T x))))
  (poly (lambda (x coef)
          (cond ((null coef) 0)
                (T (plus (car coef)
                         (times x (poly x (cdr coef))))))))
  (deriv (lambda (coef)
           (prog (u v w)
                 (setq u 1.0)
                 (setq w (cdr coef))
               A (cond ((null w) (return v)))
                 (setq v (append v (list (times u (car w)))))
                 (setq w (cdr w))
                 (setq u (add1 u))
                 (go A))))
  (newton (lambda (initi coef eps)
            (prog (delta max)
                  (print (quote (value of function argument)))
                  (setq max 20)
                A (cond ((zerop max) (return (quote NG))))
                  (setq delta (minus (quotient (car (print (list (poly initi coef)
                                                           initi)))
                                               (poly initi (deriv coef)))))
                  (setq initi (plus initi delta))
                  (cond ((lessp (*abs delta) eps) (return initi)))
                  (setq max (sub1 max))
                  (go A)))))))

実行してみる

(newton -.4999999 '(.3000000e+01 -.26000000e+02 0 .1260000e+03) .1000000e-04)

(VALUE OF FUNCTION ARGUMENT) 
(0.2500062 -0.4999999) 
(-0.0025248528 -0.50364965) 
(-2.3841858e-7 -0.50361353)
;=> -0.50361353
(newton .4000000 '(.3000000e+01 -.26000000e+02 0 .1260000e+03) .1000000e-04)

(VALUE OF FUNCTION ARGUMENT) 
(0.66400075 0.4) 
(0.055171967 0.38074243) 
(5.283356e-4 0.37882653) 
(-4.7683716e-7 0.3788078)
;=> 0.37880784
(newton .1000000 '(.3000000e+01 -.26000000e+02 0 .1260000e+03) .1000000e-04)

(VALUE OF FUNCTION ARGUMENT) 
(0.526 0.1) 
(0.022853851 0.123672366) 
(5.9843063e-5 0.12480271)
;=> 0.12480568
(newton 0 '(.4000000e+01 0 .10000000e+01) .10000000e-07)

(VALUE OF FUNCTION ARGUMENT) 
(4.0 0) 
(#<SINGLE-FLOAT quiet NaN> #.SB-EXT:SINGLE-FLOAT-NEGATIVE-INFINITY) 
(#<SINGLE-FLOAT quiet NaN> #<SINGLE-FLOAT quiet NaN>) 
...
(#<SINGLE-FLOAT quiet NaN> #<SINGLE-FLOAT quiet NaN>)
;=>NG

40年前のプログラムがたったこれだけの手間で普通に動くとかLISPって移植性ばつ牛ン!!!

2009-06-26

括弧の閉じ方に名前を付けてみる

| 23:19 | 括弧の閉じ方に名前を付けてみる - わだばLisperになる を含むブックマーク はてなブックマーク - 括弧の閉じ方に名前を付けてみる - わだばLisperになる

括弧の閉じ方には言語によって様々あると思いますが、ことLISPに関しては、随分昔から、

(defun fib (n)
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2)))))
                  ^^^^^^

のように最後の括弧は纏めて書くようです。史上2番目に古い言語だけに、手本にするスタイルが云々というより自然にこうなってしまったのでしょう。

ふと、このように最後に括弧を纏めるスタイルを親しみを込めて「LISP馬鹿」と呼んでみてはどうかと思いました。

対して、

(defun fib (n)
  (if (< n 2)
      n
      (+ (fib (1- n))
         (fib (- n 2))
         )
      )
  )
)

のようなスタイルは、親しみを込めて「Algol馬鹿」と呼んでみるのはどうでしょうか。

「Algol馬鹿」の用法としては、

(with-..
  (do-something1 ...)
  (do-something2 ...)
  (do-something3 ...)
  (do-something4 ...)
  (do-something5 ...)
  ...
  ) ; algol馬鹿

『ここのwith-のところ、後で(do-something ...)を追加するから、そのまま「Algol馬鹿」にしといて!』みたいな。

ちなみにこれまで私が目にしたAlgol馬鹿スタイルで最大級のものは、*Lispシミュレータのソースで、全編Algol馬鹿で書かれています…。

2009-06-24

Shibuya.lisp TT#3 オンライン観覧組

| 01:37 | Shibuya.lisp TT#3 オンライン観覧組 - わだばLisperになる を含むブックマーク はてなブックマーク - Shibuya.lisp TT#3 オンライン観覧組 - わだばLisperになる

Shibuya.lisp TT#3の観覧希望も満席となりました。

TT#1は、約17時間、TT#2は、丁度2時間位、という流れで行くと今回は15分位で満席になったりするのかと思いましたが、今回は16時間で満員ということで#1と大体同じ位みたいです。しかし申し込み開始15分の勢いは凄くて30分位で本当に埋まるかと思いましたw

ところで今回のTT#3ですが、自分はustream経由でオンラインで観覧しようと思っています。

ustreamsのチャネルにはチャット機能がありますが、それぞれ対応したIRC部屋にもなっているので、自分は当日ここにJOINしてチャットしながら観覧しようかなとか考えています。(もちろんIRCクライアントを使わなくてもウェブブラウザから書き込むことも可能です。)

渋谷の会場まで遠いーという方、家から出たくないーという方、一緒にust観覧しましょう!

自分は、割と沢山書き込んでしまうタイプなのですが、自分の書き込みが多くてうざいかもと思った場合は、空気を読んでChaton CL部屋に移動させて頂きますw

UstreamのIRC部屋と、IRCクライアントの利用については

が詳しいです。

2009-06-13

10分でコーディング 続・破壊的操作

| 21:41 | 10分でコーディング 続・破壊的操作 - わだばLisperになる を含むブックマーク はてなブックマーク - 10分でコーディング 続・破壊的操作 - わだばLisperになる

正方行列の転置を破壊的に

kozimaさんの 10分でコーディング 続・破壊的操作編 - kozima の日記 - cadr groupを見て、10分どころでなく散々試行錯誤したんですが、そうか、carを書き換えれば良いのか!、こんとんじょのいこ!! ということで

(defun transpose% (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (rotatef (nth x (nth y list))
                         (nth y (nth x list)))))))

という風に書いてみました。

(transpose% (make-matrix 4))
;=> ((1 5 9 13) (2 6 10 14) (3 7 11 15) (4 8 12 16))

;; SBCL
(prog ((u (make-matrix 5)))
   (transpose% u))
;=> NIL
----------
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  15,687 processor cycles
  0 bytes consed

ほうほう、0bytes。

ちょっと大きくしてみよう

;; SBCL
(prog ((u (make-matrix 300)))
   (transpose% u))
;=> NIL
----------
Evaluation took:
  0.129 seconds of real time
  0.130000 seconds of total run time (0.130000 user, 0.000000 system)
  100.78% CPU
  309,236,580 processor cycles
  1,467,424 bytes consed
  ^^^^^^^^^

あれ…。carの書き換え(rplaca)だとコンシングが発生するの?

rplaca抜きで

(defun no-transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (progn (nth x (nth y list))
                     #|(nth y (nth x list))|#)))))
;; SBCL
(prog ((u (make-matrix 600)))
   (no-transpose u))
;=> NIL
----------
Evaluation took:
  0.745 seconds of real time
  0.750000 seconds of total run time (0.750000 user, 0.000000 system)
  100.67% CPU
  1,786,044,609 processor cycles
  46,352 bytes consed

あれ…、rlpacaが原因かどうか以前に、nthでアクセスするとコンシングが発生するの?

うーん、

;; 中身あり
(defun transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (let ((a (nth x (nth y list)))
                      (b (nth y (nth x list))))
                  (rotatef a b))))))

;; 中身なし
(defun no-transpose (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (let ((a (nth x (nth y list)))
                      (b (nth y (nth x list))))
                  () )))))

;; なにもなし
(defun no-transpose-complete (list)
  (let ((len (length list)))
    (dotimes (x len list)
      (loop :for y :from x :below len
            :do (progn)))))
;; 中身あり
;; SBCL
(prog ((u (make-matrix 600)))
   (time (transpose u)))
;=> NIL
----------
Evaluation took:
  1.119 seconds of real time
  1.120000 seconds of total run time (1.120000 user, 0.000000 system)
  100.09% CPU
  2,679,908,625 processor cycles
  79,328 bytes consed

;; 中身なし
;; SBCL
(prog ((u (make-matrix 600)))
   (time (no-transpose u)))
;=> NIL
----------
Evaluation took:
  0.604 seconds of real time
  0.610000 seconds of total run time (0.610000 user, 0.000000 system)
  100.99% CPU
  1,447,224,714 processor cycles
  44,848 bytes consed

;; なにもなし
;; SBCL
(prog ((u (make-matrix 600)))
   (time (no-transpose-complete u)))
;=>
----------
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  292,959 processor cycles
  0 bytes consed

おやー、SBCLのnthが変なのかしらん…。

ちなみに、CLISPだとコンシングは0でした。

探索はつづく…。

2009-06-06

bit別冊Common Lispオブジェクトシステム-CLOSとその周辺

| 21:38 | bit別冊Common Lispオブジェクトシステム-CLOSとその周辺 - わだばLisperになる を含むブックマーク はてなブックマーク - bit別冊Common Lispオブジェクトシステム-CLOSとその周辺 - わだばLisperになる

書評というよりメモです。

この本は、復刊ドットコムでも100票以上を獲得していたりするのですが、

果して復刊したりするのか!、古本屋で見付けた方は保護して愛読するか、Amazonのマーケットプレイスにでも是非出品を!

自分は幸運なことに近所の図書館で借りられるのですが、ひさびさに借りたついでにちょっとエントリにすることにしました。

とりあえず、この本の大体の構成ですが、

※(3章はMOPについて(X3J13 88-003)で含まれていない。)

という感じです。内容が翻訳でかつPDFでネットから入手可能なものはリンクをつけてみました。

333ページの本書ですが、第II部と、5章 共通例題による他の言語との比較+実装のソースコードで約250ページを占めています。

その第II部の CLOSの仕様 CLOS仕様書(X3J13 88-002R)ですが、これは、CLtL2日本語訳の28章の元となっていて、若干違うもの中身は大体一緒。

CLOSメタオブジェクトカーネル現状報告」も英語の元の論文はPDFで入手可能です。

「5章 共通例題による他の言語との比較」は面白い企画で、

にある例題Grapherを様々な言語で実装してみせるという内容。

TAOや、CommonObjects、Flavors、ESP等レアな言語での実装が載っています。

1〜3はCLOSの情報をググったり当時メジャーだった大元の論文を読んだりすれば大体カバーできるんじゃないかと思います。

まとめ

言語のオブジェクトシステムを設計するような方には参考になるかもしれませんが、普通のユーザがCLOSを知りたくて読んでも、実装やその仕様が決まってゆくプロセスを報告している割合が大き過ぎてなんだか良く分からない本である気がしないでもありません。

CLOSや、MOPについては、日本語に限らず書籍は少ないようなのですが、個人的には、本書や、Amazon CAPTCHAあたりの内容をカバーするような本を新刊で黒田さんが書いてくれたりしたら最高なのになあと思ったりしています。

CLOS MOPだけだと市場的に厳しいかもしれませんが、「MOP全般を元祖CLOS MOPを軸に解説」みたいな感じで実際のところはCLOSの本という感じならどうにかならないだろうか…(´▽`*)…ならないか…。

国産CL処理系は割とあったらしい(2)

| 16:34 | 国産CL処理系は割とあったらしい(2) - わだばLisperになる を含むブックマーク はてなブックマーク - 国産CL処理系は割とあったらしい(2) - わだばLisperになる

この前国産CL処理系が割とあるのを発見して意外だというエントリを書いたのですが、

あれからもCiNiiやJLUGのページで3つ程みつけたり、

正式な名称が判明したりしたので、また表にしてみました。

どこかに一覧を纏めたいところです。

処理系会社方言プラットフォーム参考ページ
Kyoto Common LISP京大CLtL1ワークステーション等-
Tachyon Common Lisp沖電気ANSI/CLtL2ワークステーション-
HiLisp日立CLtL2VOS3(汎用機)-
NX-LISPNECCLtL2+MOPACOS(汎用機)-
ELIS Common LispNTTCLtL1?+拡張ELIS(Lispマシン)-
Fujitsu LISP富士通CLtL1+Utilisp関数OS IV/XSP AFII(汎用機)LISP V11 (B9313EB0)
Hokkaido Common Lisp北大工CLtL1?-CiNii 論文 -  小さなCommonLispのための記憶領域管理法
It's CL(株)BUGCLtL1+CLOS?Intel 80386no title
MC/LISP-CLtL1?FACOM M-780(汎用機)CiNii 論文 -  Overview of MC/LISP System,CiNii 論文 -  MC/LISP処理系の翻訳系の構成
Concurrent Common LISP-CLtL1?-CiNii 論文 -  CommonLISP仕様に基づくConcurrentLISP処理系の実現
ICLisp-32(株)インフォメーションアンドコントロール研究所CLtL1?MS-DOS/Windows等Index of /iclisp

※cametanさんにICLisp-32について教えて頂いたので、記述を追加しました。また、KCLは有名なのですっかり忘れてましたが、KCLも載せました。