2009-01-17

erlangの機能をlispの書式で使う

LFE erlang

erlangの機能をlispの書式で使えるLFE(Lisp Flavoured Erlang)というプロジェクトが在るようです。

=> http://forum.trapexit.org/viewtopic.php?p=40268#40268

erlangの書式に慣れられなかった人もこれで安心です。

lfeの"doc/user-guide.txt"を見ながら、少し遊んでみようと思います。

erlangのversionはR12B-5、lfeのversionは0.3を使いました。

lfeを展開し、makeします。

bash-3.2$ unzip lfe_v0.3.zip 
Archive:  lfe_v0.3.zip
  inflating: lfe/COPYRIGHT           
  inflating: lfe/doc/release_notes.txt  
  inflating: lfe/doc/user_guide.txt  
  inflating: lfe/ebin/lfe_boot.beam  
  inflating: lfe/ebin/lfe_codegen.beam  
  inflating: lfe/ebin/lfe_comp.beam  
  inflating: lfe/ebin/lfe_eval.beam  
  inflating: lfe/ebin/lfe_gen.beam   
  inflating: lfe/ebin/lfe_io.beam    
  inflating: lfe/ebin/lfe_lib.beam   
  inflating: lfe/ebin/lfe_lint.beam  
  inflating: lfe/ebin/lfe_macro.beam  
  inflating: lfe/ebin/lfe_parse.beam  
  inflating: lfe/ebin/lfe_scan.beam  
  inflating: lfe/ebin/lfe_shell.beam  
  inflating: lfe/ebin/user_drv.beam  
  inflating: lfe/examples/gps1.lfe   
  inflating: lfe/examples/lfe_eval.lfe  
  inflating: lfe/Makefile            
  inflating: lfe/README              
  inflating: lfe/src/ChangeLog       
  inflating: lfe/src/lfe-mode.el     
  inflating: lfe/src/lfe-mode.elc    
  inflating: lfe/src/lfe_boot.erl    
  inflating: lfe/src/lfe_codegen.erl  
  inflating: lfe/src/lfe_comp.erl    
  inflating: lfe/src/lfe_eval.erl    
  inflating: lfe/src/lfe_gen.erl     
  inflating: lfe/src/lfe_io.erl      
  inflating: lfe/src/lfe_lib.erl     
  inflating: lfe/src/lfe_lint.erl    
  inflating: lfe/src/lfe_macro.erl   
  inflating: lfe/src/lfe_parse.erl   
  inflating: lfe/src/lfe_scan.erl    
  inflating: lfe/src/lfe_scan.xrl    
  inflating: lfe/src/lfe_shell.erl   
  inflating: lfe/src/user_drv.erl    
  inflating: lfe/test/recfs.lfe      
  inflating: lfe/test/test_bin.lfe   
  inflating: lfe/test/test_case.lfe  
  inflating: lfe/test/test_flet.lfe  
  inflating: lfe/test/test_guard.lfe  
  inflating: lfe/test/test_inc.lfe   
  inflating: lfe/test/test_lc.lfe    
  inflating: lfe/test/test_lc_e.erl  
  inflating: lfe/test/test_let.lfe   
  inflating: lfe/test/test_macro.lfe  
  inflating: lfe/test/test_pat.lfe   
  inflating: lfe/test/test_pat_e.erl  
  inflating: lfe/test/test_rec_defs.lfe  
  inflating: lfe/test/test_slurp.lfe  
  inflating: lfe/test/test_sr.lfe    
  inflating: lfe/test/test_try.lfe   
bash-3.2$ cd lfe
bash-3.2$ make
mkdir -p ebin
erlc -I include -o ebin -W0 -Ddebug +debug_info src/*.erl
#erl -I -pa ebin -noshell -eval -noshell -run edoc file src/leex.erl -run init stop
#erl -I -pa ebin -noshell -eval -noshell -run edoc_run application "'Leex'" '"."' '[no_packages]'
#mv src/*.html doc/
bash-3.2$

emacsにerlangモードの設定を行います。

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; erlang-mode
(setq load-path (cons "/usr/local/lib/erlang/lib/erts-5.6.5/emacs/"
		      load-path))
(setq erlang-root-dir "/usr/local/lib/erlang")
(setq exec-path (cons "/usr/local/lib/erlang/bin" exec-path))
(require 'erlang-start)

M-x erlang-shellでerlangを起動します。

Erlang (BEAM) emulator version 5.6.5 [source] [smp:2] [async-threads:0] [kernel-poll:false]

Eshell V5.6.5  (abort with ^G)
1>

erlang-shellでは"help()."でhelpが表示できます。

6> help().
** shell internal commands **
b()        -- display all variable bindings
e(N)       -- repeat the expression in query <N>
f()        -- forget all variable bindings
f(X)       -- forget the binding of variable X
h()        -- history
history(N) -- set how many previous commands to keep
results(N) -- set how many previous command results to keep
v(N)       -- use the value of query <N>
rd(R,D)    -- define a record
rf()       -- remove all record information
rf(R)      -- remove record information about R
rl()       -- display all record information
rl(R)      -- display record information about R
rp(Term)   -- display Term using the shell's record information
rr(File)   -- read record information from File (wildcards allowed)
rr(F,R)    -- read selected record information from file(s)
rr(F,R,O)  -- read selected record information with options
** commands in module c **
bt(Pid)    -- stack backtrace for a process
c(File)    -- compile and load code in <File>
cd(Dir)    -- change working directory
flush()    -- flush any messages sent to the shell
help()     -- help info
i()        -- information about the system
ni()       -- information about the networked system
i(X,Y,Z)   -- information about pid <X,Y,Z>
l(Module)  -- load or reload module
lc([File]) -- compile a list of Erlang modules
ls()       -- list files in the current directory
ls(Dir)    -- list files in directory <Dir>
m()        -- which modules are loaded
m(Mod)     -- information about module <Mod>
memory()   -- memory allocation information
memory(T)  -- memory allocation information of type <T>
nc(File)   -- compile and load code in <File> on all nodes
nl(Module) -- load module on all nodes
pid(X,Y,Z) -- convert X,Y,Z to a Pid
pwd()      -- print working directory
q()        -- quit - shorthand for init:stop()
regs()     -- information about registered processes
nregs()    -- information about all registered processes
xm(M)      -- cross reference check a module
y(File)    -- generate a Yecc parser
** commands in module i (interpreter interface) **
ih()       -- print help for the i module
true
7>

lfeのshellをerlang-shellから起動します。

3> cd("src/lfe").
/Users/TakayukiSuzuki/src/lfe
ok
5> ls().
COPYRIGHT          Makefile           README             doc                
ebin               erl_crash.dump     examples           src                
test               
ok
12> cd(ebin).
/Users/TakayukiSuzuki/src/lfe/ebin
ok
13> l(lfe_shell).
{module,lfe_shell} 
23> lfe_shell:server().
LFE Shell V5.6.5 (abort with ^G)
>

shellまで起動できました。
erlangはあまりなじみが無いので、いろいろ手探りです。
とりあえず、lfeのexamplesにあるgpsv1.lfeを動かすことを目標とします。

lfe shellでは、erlang-shellの機能を "(: c Command Arg ...)"で使える様です。

>  (: c cd "../example").
exception error: {bad_form,application}
  in function  lfe_eval:eval_expr/2
  in call from lists:map/2
  in call from lfe_eval:eval_call/2
>

文字列ではないんかー。引数の型が分からない…。
色々試行錯誤した結果、cdの場合、シンボルをクォートしてあげればよいことが分かりました。

> (: c pwd)
/Users/TakayukiSuzuki/src/lfe/ebin
ok
> (: c cd '..)
/Users/TakayukiSuzuki/src/lfe
ok
> (: c cd 'ebin)
/Users/TakayukiSuzuki/src/lfe/ebin
ok
>

サンプル(gpsv1)をコンパイルする

このサンプルはPAIP由来のgpsの様です。

> (c '../examples/gps1.lfe)
#(module gps1)
> (slurp '../examples/gps1.lfe)
#(ok gps1)

cでコンパイルし、slurpでファイル内で定義したマクロや関数をlfe shellから使える様に出来ます。slurpは同時に１つのファイルのみを有効に出来るようで、別のファイルをslurpするとそれまでにslurpしていたファイル内の定義はlfe shellから見えなくなる様です。

gpsを使ってみます。

> (gps '(son-at-home) '(son-at-school) (school-ops))
false
> (gps '(son-at-home have-money have-phone-book car-needs-battery) '(son-at-school) (school-ops))
executing 'look-up-number'
executing 'telephone-shop'
executing 'tell-shop-problem'
executing 'give-shop-money'
executing 'shop-installs-battery'
executing 'drive-son-to-school'
solved
>

動きました。:を使うと、slurpしなくても良さそうです。

> (: gps1 gps '(son-at-home have-money have-phone-book car-needs-battery) '(son-at-school) (: gps1 school-ops))
executing 'look-up-number'
executing 'telephone-shop'
executing 'tell-shop-problem'
executing 'give-shop-money'
executing 'shop-installs-battery'
executing 'drive-son-to-school'
solved
>

2009-01-10

ex2.6 Church数

SICP

ex2.6はチャーチ数の問題で、以前に取り組んだ時はweb上の情報をみてもさっぱり分からなかった問題です。
今回いろいろやってみて、何となく分かって来ました。
あと、素のラムダ計算を記述するためには、schemeは絶望的に向いていなそうです。大分慣れたと思っていた括弧の海に再び飲まれてしまいました...。

問題では、以下の２つの関数が示され、1,2の直接表現と足し算関数を定義せよとされています。

(define zero
  (lambda (f)
    (lambda (x)
      x)))

(define (add-1 n)
  (lambda (f)
    (lambda (x)
      (f ((n f) x)))))

(add-1 zero)を置き換えモデルで展開します。
add-1のnをzeroの定義でそっくり置き換えます。zeroで使用している変数をそのまま使うと混乱するので、名前は換えました。

(lambda (f)
  (lambda (x)
    (f (((lambda (f1)
           (lambda (x1) x1)) f) x))))

((lambda (f1) ...) f)でf1をfに置き換えますが、内部では使われていません。そのため、...の部分だけ抜き出せます。

(lambda (f)
  (lambda (x)
    (f ((lambda (x1) x1) x))))

((lambda (x1) x1) x)も、結局xに置き換えられます。その結果が、(add-1 zero)の置き換え結果、すなわちoneです。

(lambda (f)
  (lambda (x)
    (f x)))

さらに、oneに対してadd-1を適用してみます。

(add-1 (lambda (f) (lambda (x) (f x))))

add-1のnを(lambda (f1) (lambda (x1) (f1 x1)))でそっくり置き換えます。ここでもzeroで使用している変数をそのまま使うと混乱するので、名前は換えました。

(lambda (f)
  (lambda (x)
    (f (((lambda (f1)
           (lambda (x1) (f1 x1))) f) x))))

((lambda (f1) ...) f)は、f1をfに置き換え、lambdaを外します。

(lambda (f)
  (lambda (x)
    (f ((lambda (x1) (f x1)) x))))

同様に、((lambda (x1) (f x1) ) x)も、x1をxに置き換えられます。

(lambda (f)
  (lambda (x)
    (f (f x))))

以上の置き換えから、Church数の体系では、

数とは、fを引数としてとり、xを引数としてとる関数を返す関数である
数を1増やすとは、fの適用回数を1回増やすことである
数の大きさは、xに対してfを何回適用するかで示される

ということが分かります。

数が、xにfを一度も適用しなければ、0
数が、xにfを1回適用すれば、1
数が、xにfを2回適用すれば、2
:

ですね。

Church数のままだと、演算結果を確認する方法がないので、表示可能な形式に変換してあげると便利です。

xに対しfが何回適用されたかをschemeの数字に変換してあげるには、xに0、fにinc、つまり(lambda (x) (+ x 1))を渡してあげればよいです。

Church数 zeroに inc,0を渡すと 0にincが0回適用される => 0
Church数 zeroに inc,0を渡すと 0にincが1回適用される => 1
Church数 zeroに inc,0を渡すと 0にincが2回適用される => 2

となり、計算結果がREPLで確認可能となります。

(define (p cn)
  (define (inc x) (+ x 1))
  ((cn inc) 0))

数 1の直接的な定義

(define one
  (lambda (f)
    (lambda (x)
      (f x))))

数 2の直接的な定義

(define two
  (lambda (f)
    (lambda (x)
      (f (f x)))))

数 3の直接的な定義

(define three
  (lambda (f)
    (lambda (x)
      (f (f (f x))))))

確認してみます。

;; (p zero)
;; => 0
;; (p (add-1 zero))
;; => 1
;; (p one)
;; => 1
;; (p (add-1 (add-1 zero)))
;; => 2
;; (p two)
;; => 2
;; (p three)
;; => 3

よさそうです。

足し算の定義

インタフェースは、

(plus-cn a b)
;; a: Church数
;; b: Church数

とします。

まず fにaを適用(a f)します。これでxに対してfをa回適用する関数が得られます。
bも同様(b f)です。

xに対して(b f)を適用したものに対して、(a f)をさらに適用するとxにfをa+b回適用したことになります。

(define (plus-cn a b)
  (lambda (f)
    (lambda (x)
      ((a f) ((b f) x)))))

;; (p (plus-cn two three))
;; => 5
;; (p (plus-cn zero three))
;; => 3

Church数はおもしろそうなので、もう少し掘り下げてみます。

べき乗の定義

(expt-cn a b)
;; a: Church数
;; b: Church数

とします。

べき乗の定義は、実は「問題1.41、doubleの定義」にヒントがありました。
doubleの定義は、

(define (double f)
  (lambda (x)
    (f (f x))))

ですが、これは以下と等価です。

(define double
  (lambda (f)
    (lambda (x)
      (f (f x)))))

そしてこれは、Church数の2と全く同じ定義です。つまり、doubleはChurch数だったのです。

そして、問1.41では、(((double (double double) ) inc) 5)の値は何かと聞いています。

この答えは21だったのですが、解析の途中で、(double double)がfを引数にとり、xに対しfを4回適用する関数を返す関数を返すことが分かります。つまりchurch数の4ですね。

これにさらにdoubleを適用すると、4回適用する関数に4回適用する関数を適用することとなり、fを引数にとり、xに対しfを16回適用する関数を返す関数を返すことが分かりました。4*4の演算ですね。

このことから類推すると、Chuch数にChuch数を適用するとべき乗が計算できそうです。

;; (p (two two))
;; => 4 : 2*2
;; (p (two (two two)))
;; => 16 : (2 * 2) * (2 * 2)
;; (p (three (two two)))
;; => 64 : (2 * 2) * (2 * 2) * (2 * 2)

どうやら出来そうです。

(define (expt-cn a b)
  (b a))

;; (p (expt-cn three three))
;; => 27
;; (p (expt-cn three (add-1 three)))
;; => 81

掛け算の定義

(mul-cn a b)
;; a: Church数
;; b: Church数

とします。

まず fにbを適用(b f)します。これでxに対してfをb回適用する関数が得られます。
(b f)をa回適用すれば、掛け算を行ったことになります。

(define (mul-cn a b)
  (lambda (f)
    (lambda (x)
      ((a (b f)) x))))

;; (p (mul-cn zero one))
;; => 0
;; (p (mul-cn two three))
;; => 6
;; (p (mul-cn three two))
;; => 6
;; (p (mul-cn one one))
;; => 1

1を引く関数

これは厄介。

+1はfへnを適用した結果にfを再度適用するだけだったので(まだ)簡単でしたが、
1度だけ適用されないようにするというのをどうすればよいのでしょうか?

とりあえずWikipediaの「ラムダ計算」を参考に、答えは見ずに、途中でちらっとみえたif関数を導入してみます。
ifは、関数適用のためのカッコが多くなったので、3引数の関数としておきます。

(define true-cn  (lambda (a)(lambda (b) a)))
(define false-cn (lambda (a)(lambda (b) b)))
(define if-cn    (lambda (bool tr fl)
                   ((bool tr) fl)))

;; (if-cn true-cn 1 2)
;; => 1
;; (if-cn false-cn 1 2)
;; => 2

つぎにzeroかどうかを判定する関数を考えます

Chuch数では、xにfを適用するのだから、fが適用されたらfalse-cnになるようなfがあればよいです。
つまり、fは無条件でfalse-cnを返し、xをtrue-cnとすればよいことになります。

(define (is-zero-cn n)
  ((n (lambda (x) false-cn)) true-cn))

(define (cn->bool bool)
  ((bool #t) #f))

;; (cn->bool (is-zero-cn zero))
;; => #t
;; (cn->bool (is-zero-cn one))
;; => #f

これらの条件式を用いて、最初の関数適用か、最後の関数適用を
skipできないかどうかを考えてみます。

(f (f (f .... (f x))))

上の形からすると、一番内側でごまかすのがよい気がします。

つまり、fとxをなんらかの関数でくるんでどうにか最初の適用を逃れ、その後は普通に適用させる作戦です。

f'(x) = x ただし0回めの場合
f'(x) = f(x) ただし0回目ではない場合

となるようなf'を定義できれば 1引くことができます。
0回めだけ適用しないということは、一度だけ特殊な処理をすればよいということです。

一度だけという条件を一引数で満たすために、対を定義してみます。
これは問2.4で定義したものと同じですね。

(define (cons-cn car-val cdr-val)
  (lambda (bool)
    ((bool car-val) cdr-val)))
(define (car-cn pair) (pair true-cn))
(define (cdr-cn pair) (pair false-cn))

;; (car-cn (cons-cn 1 2))
;; => 1
;; (cdr-cn (cons-cn 1 2))
;; => 2

ここまでツールができれば、sub-1が書けます。

(define (sub-1 n)
  (lambda (f)
    (lambda (x)
      (cdr-cn ((n (lambda (pair)
                    (if-cn (car-cn pair)
                           (cons-cn false-cn (cdr-cn pair))
                           (cons-cn false-cn (f (cdr-cn pair))))))
               (cons-cn true-cn x))))))

;; (p (sub-1 one))
;; => 0
;; (p (sub-1 two))
;; => 1

答えが出来たので、ここで、Wikipediaの「ラムダ計算」のPREDの定義と見比べてみます。

(define (pred n)
  (lambda (f)
    (lambda (x)
      (((n (lambda (g)
             (lambda (h)
               (h (g f)))))
        (lambda (u) x))
       (lambda (u) u)))))

さすがに簡潔ですね。

原理がよく分からないので、例によってtwoに適用して置き換えてみます。
nをtwoの定義で置き換えます。twoのfはf1にxはx1に置き換えます。

(lambda (f)
  (lambda (x)
    ((((lambda (f1)
         (lambda (x1)
           (f1 (f1 x1))))
       (lambda (g)
         (lambda (h)
           (h (g f)))))
      (lambda (u) x))
     (lambda (u) u))))

f1を(lambda (g) ...)で置き換えます
ここでfがn個分展開されます。

(lambda (f)
  (lambda (x)
    (((lambda (x1)
        ((lambda (g)
           (lambda (h)
             (h (g f)))) ; <-f
         ((lambda (g)
            (lambda (h)
              (h (g f)))) ; <-f
          x1)))
      (lambda (u) x))
     (lambda (u) u))))

x1を(lambda (u) x)で置き換えます

(lambda (f)
  (lambda (x)
    (((lambda (g)
        (lambda (h)
          (h (g f))))
      ((lambda (g)
         (lambda (h)
           (h (g f))))
       (lambda (u) x)))
     (lambda (u) u))))

下の段のgを(lambda (u) x)で置き換えます。
ここでfが一つ消えますね。
このgとhの折込まれたような適用が肝のようです。
最初の適用でfが一つ消えた後は、fがn-1回適用されます。
一番最後に残った(lambda (h) ...)へidを適用することで、つじつまをあわせているようです。

(lambda (f)
  (lambda (x)
    (((lambda (g)
        (lambda (h)
          (h (g f))))
      (h ((lambda (u) x) f)))
     (lambda (u) u))))

(lambda (f)
  (lambda (x)
    (((lambda (g)
        (lambda (h)
          (h (g f))))
      (lambda (h)
        (h x))) ; <- fが消えた
    (lambda (u) u))))

gを(lambda (h) ...)で置き換えます

(lambda (f)
  (lambda (x)
    ((lambda (h)
       (h ((lambda (h)
             (h x)) f)))
     (lambda (u) u))))

内側のhをfで置き換えます。

(lambda (f)
  (lambda (x)
    ((lambda (h)
       (h (f x)))
     (lambda (u) u))))

hをuで置き換えます。

(lambda (f)
  (lambda (x)
    ((lambda (h)
       (h (f x)))
     (lambda (u) u))))

uを置き換えます。

(lambda (f)
  (lambda (x)
    ((lambda (u) u) (f x))))

oneになりました。

(lambda (f)
  (lambda (x)
    (f x)))

原理は何となく分かりましたが、とても思いつきそうにありません。

2008-11-01

->とcut

Common Lisp

l4u!の->演算子ってどんなだったかなと思い出しながら書いていたら、全く別物になってしまいました。

>がブロックをつくり、直前の式の評価値が、次の式の最後に暗黙的に渡されます。

(-> (list 1 2 3)
    (princ)
    (mapcar #'(lambda (x) (+ x 10))))
;; (1 2 3)
;; => (11 12 13)

"_"で直前の値を埋め込む場所を明示出来ます。

(-> (consp '(a . b))
    (if _ 'cons 'not-cons))
;; => CONS

埋め込む場所を明示する場合、_1,_2,...で多値を受けることも出来ます。

(-> (values (list 1 2 3)
	    (list 4 5 6))
            (mapcar #'+ _1 _2))
;; => (5 7 9)

これを使うと、第二戻り値が簡単に受けられます。

(defvar ht (make-hash-table))
;; => HT
(setf (gethash 'a ht) 'hoge)
;; => HOGE
(-> (gethash 'a ht) _2)
;; => T
(-> (gethash 'b ht) _2)
;; => NIL

ついでに_1,_2の展開論理を使って、cutっぽいものも作れました。

(macroexpand '(cut + 1))
;; => #'(LAMBDA (_) (+ 1 _))
;;    T

(macroexpand '(cut list 1 _1 3 _2 5))
;; => #'(LAMBDA (|_1| |_2|) (LIST 1 |_1| 3 |_2| 5))
;;    T

(funcall (cut list 1 _1 3 _2 5) 2 4)
;; => (1 2 3 4 5)

「listの全要素に10を足してから、全要素を20倍する」は->とcutを使うと、次のように書けます。

(-> (list 1 2 3)
    (mapcar (cut + 10))
    (mapcar (cut * 20)))
;; => (220 240 260)

ただし、今の実装だと、->の_と干渉してしまいます。

(-> (list 1 2 3)
    (mapcar (cut - _ 5)))
;; => エラー：mapcarへの引数不足
(-> (list 1 2 3)
    (mapcar (cut - _ 5) _))
;; => (-4 -3 -2)

やたらと長くなった実装↓

(defpackage :implicit-params
    (:use :cl)
  (:export :|->| :cut))

(in-package :implicit-params)

(defun flatten (list)
  (labels ((iter (l acc)
	     (cond ((null l)        acc)
		   ((consp (car l)) (iter (cdr l) (iter (car l) acc)))
		   (t               (iter (cdr l) (cons (car l) acc))))))
    (nreverse (iter list '()))))

(defun rest2 (list)
  (rest (rest list)))

(defmacro let1 (var val &body body)
  `(let ((,var ,val))
     ,@body))
     
(defun _symbol-p (sym)
  (and (symbolp sym)
       (eql (char (symbol-name sym) 0) #\_)
       (every #'digit-char-p (subseq (symbol-name sym) 1))))

(defun _symbol-num (sym)
  (if (not (_symbol-p sym)) 0
      (multiple-value-bind (val index) (parse-integer (subseq (symbol-name sym) 1) :junk-allowed t)
	(if (> index 0) val 0))))

(defun max-_symbol-num (exp)
  (if (null exp) 0
      (reduce #'(lambda (n m) (max n m)) (flatten exp) :key #'_symbol-num)))

(defun generate-_-var (exp)
  (let ((n (max-_symbol-num exp)))
    (if (= n 0) '(_)
	(loop for i from 1 to n collect (intern (format nil "_~a" i))))))

(defun maybe-insert (it exp)
  (cond ((null exp) (list it))
	((atom exp) (maybe-insert it `(progn ,exp)))
	(t (if (find-if #'_symbol-p (flatten exp))
	     exp
	     (nreverse (cons it (reverse exp)))))))

(defmacro -> (&body body)
  (cond ((endp (rest body)) (first body))
	(t (let1 m-v-b-var (generate-_-var (second body))
	     `(multiple-value-bind ,m-v-b-var ,(first body)
		(declare (ignorable ,@m-v-b-var))
		(-> ,(maybe-insert '_ (second body))
		    ,@(rest2 body)))))))

(defmacro cut (func &rest args)
  (let1 lambda-var (generate-_-var args)
    `(lambda ,lambda-var
       (,func ,@(maybe-insert '_ args)))))

2008-09-14

Gauche/Kahuaセミナー2008 Fallに行ってきました

Gauche Kahua

Gauche/Kahua セミナー2008 Fallに行ってきました。

http://practical-scheme.net/wiliki/wiliki.cgi?Seminar%3aGauche%2fKahua

セミナーの内容は以下のものでした。

HOPプロジェクトの説明(山下さん)
Gauche on Railsの内部実装の解説(吉田さん)
Kahuaの内部実装(主にpersistent部分)の解説(備前さん)

とても興味深い内容でした。

以下メモです。

HOPプロジェクト

HOPプロジェクトは、GaucheやHaskellを使ったソフトウェア開発の促進を目的としている様です。

プレスリリース
http://www.timedia.co.jp/news/press/3545906324

GaucheやHaskellをいざ仕事で使おうとした際の障壁を少なくするために、

開発に必要な情報の共有
開発事例の蓄積

などを推進していく様です。

Gauche on Rails

Gauche on Railsの内部実装の解説は基本的にはGauche nightの時と同じでした。
今回はさらに内部実装に突っ込んだ話をして頂きました。

Gaucheの(CLOS由来の)オブジェクトシステムではクラスとメソッドが分離している
Gachueにはクラス再定義の機能がある。但しGauche固有。これはKahuaを実装するために追加された機能らしい。再定義機能は、ActiveRecoadでDBから読み出してきたレコード情報からクラスへスロットを追加するために使った。
ActiveControllerは、マクロを使って実装。マクロでこっそりコンテキスト情報を渡すコードを生成。
(reload-modified-modules)を呼ぶと、変更の在ったモジュールが再読み込みされる。便利。
(report-error e)は正式なAPIでは無いが、stack traceを取得できる。

ソースは以下から…
http://ey-office.com/svn/rails/trunk/GaucheRails
リンクが切れている模様です。

Kahuaの内部実装

Kauhaプロジェクトのサイト
http://www.kahua.org/

Kahuaの内部実装の解説をすることで、Gaucheの使い方のえぐい面を見てみましょうという内容です。

MOP使いまくり。便利
entry-lambdaとかマクロ使いまくり。バッククォート、アンクォート使いまくり。
persistent-class-bind-metainfoは内部定義を含めて100行もある。長ー

あとは、現在のKahuaの問題点として以下のような話がありました。

継続手続きはプロセスローカルとなる。つまり、同一アプリケーションを複数プロセスで動かしている場合、継続を埋め込んだプロセスが必ずその継続手続きを実行しなければならない。
プロセスを再起動すると、全ての継続手続きが消えてしまう。これはpersistent可能なlambdaで解決可能かも。
ファイルシステム上のDBはまだトランザクション機能が無い。必要な場合、RDBMSを使ってね。
Kahua独自のデータ形式でデータベースを使うため、既存のデータベースと連携が出来ない。

高負荷に耐えるGauche webサーバ

Kahua内蔵のwebサーバは現在はselect + posixスレッドベース。posixスレッドは重い。
昔のapacheではプロセスを複数立ち上げて、fdパッシングを使って負荷分散をしていた。Gaucheにはfdパッシングの機構が無い。仕様を綺麗にするためには結構考えないとならない。
call/ccを使った比較的軽いグリーンスレッドを使う場合、non-blocking I/Oが無いため、I/Oで止まる。
I/OはGauche 0.9から1.0にかけて見直される予定のため、取りあえずそれまでまつ方針。

2008-08-19

今週末はPAIP読書会

Common Lisp PAIP

あっという間に1ヶ月以上経っている。
今回からAIの部分に入ります。ちょっと流し読みしておこう。

2008-07-09

PAIP読書会

Common Lisp PAIP

２ヶ月くらい放置してしまいましたが、今週末からPAIP読書会が再会するようなので、これを機にまた更新していきたいと思います。

2008-05-11

Ex5.4〜Ex5.6 ELIZAの改良問題

PAIP Common Lisp

ELIZAの改良問題を３つ

;; Exercise 5.4 [s] We mentioned that our version of ELIZA cannot
;; handle commas or double quote makes in the input. However, it seems
;; to handle the apostrophe in both input and patterns, Explain.

commaやdouble quoteが扱えないのは、readに特殊文字として解釈されてしまうからですね。 '(アポストロフィー)を扱えているのは、これもreadがquoteに置き換えているからです。

(hoge's) => (hoge (quote s))

Ex5.4を受けて、Ex5.5,Ex5.6では以下の４つの改良をします。

区切り文字を入力出来るようにする
()を入力しないですむ様にする
Abortしないで終了出来るようにする
出力から()をとる

;; Exercise 5.5 [h] Alter the input mechanism to handle commas and
;; other punctuation characters. Also arrange so that the user doesn't
;; have to type parentheses around the whole input expression. (Hint:
;; this can only be done using some Lisp functions we have not seen
;; yet. Look at read-line and read-from-string.)

;; Exercise 5.6 [m] Modify ELIZA to have an explicit exit. Also
;; arrange so that the output is not printed in parentheses either.

(in-package :eliza)

(defparameter *eliza-punctuation-char*
  '(#\{ #\} #\( #\) #\, #\. #\' #\` #\" #\' #\# #\\ #\;))　;"

(defun eliza-escape-punctuation-char (string)
  (substitute-if #\space #'(lambda (c)
			     (member c *eliza-punctuation-char*)) string))
					 
(defun eliza-read ()
  (let ((s (make-string-output-stream)))
    (write-string "(" s)
    (write-string (eliza-escape-punctuation-char (read-line)) s)
    (write-string ")" s)
    (read-from-string (get-output-stream-string s))))

(defun eliza-print (list &rest rest)
  (declare (ignore rest))
  (format t "~@(~{~s ~}~)~%" list))

(defun eliza ()
  "パターンマッチを使って、ユーザのインプットに答える。"
  (loop 
     (print 'eliza>)
     (let ((input (eliza-read)))
       (cond ((eq (car input) 'quit) (return))
	     (t
	      (eliza-print (flatten (use-eliza-rules input))))))))

上記のように作ってみましたが、PAIPのAnswersの方が綺麗です。
Answersを見て学習したこと。

文字列（というかシーケンスならなんでも）の結合にはconcatenateが使える
文字列に対してもfindできる

シーケンスに適用できる関数は汎用性が高いですね。更なる学習が必要です。