[SML 7875] Re: 連想計算というリフレクティブな手法

[Masato Sumi]

sumim です。

まだ流れを追いきれていないので、Smalltalk的に書き直せていませんが、
とりあえず成田さんのCLのコードをSmalltalkで動くよう直訳してみました。
Squeak4.1とVisualWorks7.7で動作します。


| sequentialSquare compositionOp fibo fibonacci |

sequentialSquare := nil.
sequentialSquare := [:compOp :operator :n |
   n < 1 ifTrue: [nil] ifFalse: [
   n = 1 ifTrue: [operator] ifFalse: [
   n > 1
      ifTrue: [
         n odd ifTrue: [
            compOp
               value: (sequentialSquare
                  value: compOp value: operator value: n - 1)
               value: operator]
      ifFalse: [
         | sqOp |
         sqOp := sequentialSquare
            value: compOp value: operator value: n / 2.
         compOp value: sqOp value: sqOp]]]]].

compositionOp := [:func1 :func2 |
   [:x | func1 value: (func2 value: x)]].

fibo := [:x | Array with: x first + (x at: 2) with: x first].

fibonacci := [:x |
   x < 1 ifTrue: [nil] ifFalse: [
   x = 1
      ifTrue: [1]
      ifFalse: [
         ((sequentialSquare
               value: compositionOp value: fibo value: x - 1)
            value: #(1 0)) first]]].

fibonacci value: 1000


2010年12月14日17:11 Narita Takaoki <Narita.Takaoki ＠ exc.epson.co.jp>:
> 成田です。
>
>> sumim こと鷲見です。
>>
>> 連想計算でもリフレクティブでもないので恐縮ですが、
>> にぎやかしにと、２つほど考えてみました。
>
> 同様にぎやかしですが、それどころか Smalltalk にもなってません。
>
> これを Smalltalk 的に書くとしたら？で詰まってしまった・・・
> Common Lisp で書いてしまいましたが：
>
> (defun sequential-square (comp-op operator n)
>  (assert (integerp n) (n)) ;; 本質には関係しないので無視してください。
>  (cond ((< n 1) nil)
>        ((= n 1) operator)
>        ((> n 1)
>         (cond ((oddp n)
>                (funcall comp-op
>                 (sequential-square comp-op operator (1- n)) operator))
>               ('t
>                (let
>                 ((sq-op (sequential-square comp-op operator (/ n 2))))
>                 (funcall comp-op sq-op sq-op)))))))
>
> (defun composition-op (func1 func2)
>  (lambda (x) (funcall func1 (funcall func2 x))))
>
> (defun fibo (x) (list (+ (car x) (cadr x)) (car x)))
>
> (defun fibonacci (x)
>  (cond ((< x 1) nil)
>        ((= x 1) 1) ;; かなりインチキ
>        ('t
>         (car
>          (funcall
>           (sequential-square #'composition-op #'fibo (1- x)) '(1 0))))))