sasagawa:Simple

sasagawa:Simple

SECDマシン Schemeコンパイラ Simpleの開発記録

https://github.com/sasagawa888/Simple

syntactic-closure 再検討

局所変数ではうまくいっていない理由を探っている。コンパイルされたコードが若干違っている。

(define-syntax swap! 
   (sc-macro-transformer 
    (lambda (form environment) 
      (let ((a (make-syntactic-closure environment '() (cadr form))) 
            (b (make-syntactic-closure environment '() (caddr form)))) 
        `(LET ((v ,a)) 
           (SET! ,a ,b) 
           (SET! ,b v))))))

(define-macro swap2
              (lambda (a b)
                `(let ((v a))
                   (set! a b)
                   (set! b v))))

Simp> (compile '(let ((a 1)(b 2)) (swap! a b)))
(ldc 1 ldc 2 args 2 ldf (ld (0 . 0) args 1 ldf (ld (0 . 1) lset (0 . 0) pop ld (0 . 0) lset (0 . 1) rtn) 1 tapp rtn) 2 app stop)

Simp> (compile '(let ((a 1)(b 2)) (swap2 a b)))
(ldc 1 ldc 2 args 2 ldf (ld (0 . 0) args 1 ldf (ld (1 . 1) lset (1 . 0) pop ld (0 . 0) lset (1 . 1) rtn) 1 tapp rtn) 2 app stop)
Simp> 


これだとうまくいく。

(define-syntax nil! 
   (sc-macro-transformer 
    (lambda (form environment) 
      (let ((a (make-syntactic-closure environment '() (cadr form))) )
        `(set! ,a '())))))

Simp> (define x 10)
x
Simp> x
10
Simp> (let ((x 0)) (nil! x))
()
Simp> x
10
Simp> 

ちょっと変更してuse-envを'()にすると大域定義を探しに行く。use-envはこれでうまくできてるようだ。

(define-syntax nil! 
   (sc-macro-transformer 
    (lambda (form environment) 
      (let ((a (make-syntactic-closure '() '() (cadr form))) )
        `(set! ,a '())))))

Simp> (define x 10)
x
Simp> (let ((x 0)) (nil! x))
()
Simp> x
()
Simp> 

Chibi Scheme syntax-rules.scm 解析

er-macro-transformerが機能し始めたのでChibiの解析、移植作業にとりかかる。 手始めに内部defineのletrecへの変換が不完全だったことが判明。深いところに内部定義があった場合にうまく変換されていなかった。従来Cで書いていたがややこしいのでSchemeで書き直した。subrのtransferはSchemeで書いたものに置き換え。

内部定義のバグをつぶしてsyntax-rulesをコンパイルするところまでは可能になった。 試してみると移植が不完全なのでエラー。

(define-syntax swap!
  (syntax-rules ()
    ((_ a b)(let ((v a)) (set! a b) (set! b v)))))

Simp> (define a 1)
a
Simp> (define b 2)
b
Simp> (swap! a b)
Exception: variable expr is not bound
Simp> 

でこれくさんの解説を参考に解読。 本体部分は最後のところ。

(list     
          _er-macro-transformer    
          (list _lambda (list _expr _rename _compare)  
                (cons _or (append  
                            (map (lambda (clause) (expand-pattern (car clause) (cadr clause))) forms)                 
                            (list (list 'error "no expansion"))))))))))

こういう意味らしい。

`(,_er-macrotransformer
  (._lambda (,_expr ,_rename ,_compare)
            (,_or (append (map (lambda (clause) (expand-patter (car clause) (cadr clause))) forms)
                          (list (list 'error "no expansion"))))))

とりあえず本体部分にダミーのfooをかませて確認した。

(list     
          _er-macro-transformer    
          (list _lambda (list _expr _rename _compare)  
                (cons _or (append  
                            (map (lambda (clause) (foo (car clause) (cadr clause))) forms)                 
                            (list (list 'error "no expansion"))))))))))

(define (foo x y) y)

(define-syntax boo
  (syntax-rules ()
    ((_ x) (display "boo-template"))))

Simp> (boo 3)
boo-template()
Simp> 

補助関数のテスト。

各補助関数は内部定義となっていてトレースできない。そこで大域に定義をひっぱりだしてきて束縛しておきそこでテスト、動作確認をすることとした。

next-v

Simp> (g-next-v)
#<synclo>
Simp> (define x (g-next-v))
x
Simp> (get-sc-expr x)
v.7
Simp> 

ellipse?

Simp> (g-ellipse? '(x ...))
#t
Simp> (g-ellipse? '(x))
#f
Simp> (g-ellipse? '(...))
#f
Simp> 

ellipse-depth

Simp> (g-ellipse-depth '(x ...))
1
Simp> (g-ellipse-depth '(x ... ...))
2
Simp> (g-ellipse-depth '(x ... ... ...))
3
Simp> (g-ellipse-depth '(x))
0
Simp> 

ellipse-tail

Simp> (g-ellipse-tail '(x ... y))
(y)
Simp> (g-ellipse-tail '(x ... ... y))
(y)
Simp> (g-ellipse-tail '(x ... ... ... z))
(z)
Simp> 

all-vars identifier? をsymbol?に変更した。

Simp> (g-all-vars '(a b c d) 0)
((a . 0) (b . 0) (c . 0) (d . 0))
Simp> (g-all-vars '(a b c d) 1)
((a . 1) (b . 1) (c . 1) (d . 1))
Simp> (g-all-vars '(a b c ... d) 1)
((a . 1) (b . 1) (c . 2))
Simp> (g-all-vars '(a b (c ...) d) 0)
((a . 0) (b . 0) (c . 1) (d . 0))
Simp>

Simp> (g-all-vars '(a b (c d) e) 0)
((a . 0) (b . 0) (c . 0) (d . 0) (e . 0))
Simp> (g-all-vars '(#(a b)) 0)
((a . 0) (b . 0))
Simp> 

free-vars

Simp> (g-free-vars 'a '((a . 0)) 0)
(a)
Simp> (g-free-vars 'b '((a . 0)) 0)
(b)
Simp> #t
Simp> 

expand-template

Simp> (g-expand-template 'a '((a . 0)))
a
Simp> (g-expand-template 'b '((a . 0)))
*undef
Simp> (g-expand-template 1 '((a . 0)))
1
Simp> 

expand-pattern

Simp> (g-expand-pattern '(_ () x) '(begin x))
(#<synclo> ((#<synclo> (#<synclo> #<synclo>))) (#<synclo> (#<synclo> #<synclo>) (#<synclo> ((#<synclo> (#<synclo> #<synclo>))) (#<synclo> (#<synclo> #<synclo>) (#<synclo> ((#<synclo> (#<synclo> #<synclo>))) (#<synclo> (#<synclo> #<synclo>) (#<synclo> ((#<synclo> (#<synclo> #<synclo>))) (#<synclo> ((x #<synclo>)) (#<synclo> ((#<synclo> (#<synclo> #<synclo>))) (#<synclo> (#<synclo> #<synclo>) (#<synclo> *undef (#<synclo> x (#<synclo> ())))))))))))))
Simp> 

syncloをシンボルに置き換えて読める状態にする関数を作らないと判読不能。decodeしてみる。

(define (decode ls)
  (map (lambda (x) (cond ((syntactic-closure? x) (get-sc-expr x))
                         ((list? x) (decode x))
                         (else x)))
       ls))

Simp> (decode (g-expand-pattern '(_ () x) '(begin x)))
(let ((v.9 (cdr expr))) (and (pair? v.9) (let ((v.10 (car v.9))) (and (null? v.10) (let ((v.11 (cdr v.9))) (and (pair? v.11) (let ((v.12 (car v.11))) (let ((x v.12)) (let ((v.13 (cdr v.11))) (and (null? v.13) (cons *undef (cons x (quote ())))))))))))))
Simp> 

結果は明らかにおかしい。compareを手抜きしてeq?ですましたからかもしれない。

意味は通っているのかもしれない。下記例

Simp> (decode (g-expand-pattern '(_ x) '(1)))
(let ((v.16 (cdr expr))) (and (pair? v.16) (let ((v.17 (car v.16))) (let ((x v.17)) (let ((v.18 (cdr v.16))) (and (null? v.18) (cons 1 (quote ()))))))))
Simp> (cons 1 '())
(1)
Simp> 

*undefとなっているのはSimpleのバグっぽいが、そこが+になれば一応、意味のあるS式が生成されているように思える。

Simp> (decode (g-expand-pattern '(_ x) '(+ x x)))
(let ((v.23 (cdr expr))) (and (pair? v.23) (let ((v.24 (car v.23))) (let ((x v.24)) (let ((v.25 (cdr v.23))) (and (null? v.25) (cons *undef (cons x (cons x (quote ()))))))))))
Simp> 

er-macro-transformer

いじくりながら動作を確認。定義はChibiのもの。identifier=?がよくわからないのでとりあえずeq?で代用。

(define er-macro-transformer
  (lambda (f)
    (lambda (expr use-env mac-env)
      ((lambda (rename compare) (f expr rename compare))
       ((lambda (renames)
          (lambda (identifier)
            ((lambda (cell)
               (if cell
                   (cdr cell)
                   ((lambda (name)
                      (set! renames (cons (cons identifier name) renames))
                      name)
                    (make-syntactic-closure mac-env '() identifier))))
             (assq identifier renames))))
        '())
       (lambda (x y) (eq? x y))))))

(define-syntax my-let*
  (er-macro-transformer
   (lambda (expr rename compare)
     (if (null? (cadr expr))
         `(,(rename 'begin) ,@(cddr expr))
         `(,(rename 'let) (,(caadr expr))
           (,(rename 'let*) ,(cdadr expr) ,@(cddr expr)))))))

Simp> (my-let* () 1)
Exception: invalid application #<macro>
Simp> begin
#<macro>
Simp> (define x (macroexpand '(my-let* () 1)))
x
Simp> x
(#<synclo> 1)
Simp> x
(#<synclo> 1)
Simp> (get-sc-expr x)
(begin)
Simp> n
Exception: variable n is not bound
Simp> (define x (macroexpand '(my-let* () 1)))
x
Simp> (get-sc-expr x)
(begin)
Simp> 

あまり深く検討していないものの次のようにコンパイラに追加すると動くようになる。

((syntactic-closure? (car expr))
         (comp (cons (get-sc-expr (car expr)) (cdr expr))
                env
                code
                tail
                lmac))

Simp> (my-let* () 1)
1
Simp> 
Simp> (my-let* ((a 2)) a)
2
Simp> (my-let* ((a 2)(b a)) b)
2
Simp>

定義時の環境でコンパイルされないといけないのでこれだとダメなはず。要検討。

こうやると実行時の局所変数が見えなくなってしまいエラーとなる。やはり↑のままでいいようだ。

((syntactic-closure? (car expr))
         (comp (cons (get-sc-expr (car expr)) (cdr expr))
                (get-sc-env (car expr))
                code
                tail
                lmac))

Simp> (my-let* ((a 1)(b a)) b)
Exception: variable a is not bound
Simp> 

sc-macro-transfer

動き出したのでメモ。

(define-syntax foo
  (sc-macro-transformer
    (lambda (expr use-env)
      (let ((a (make-syntactic-closure use-env '() (cadr expr)))
            (b (make-syntactic-closure use-env '() (caddr expr))))
      `(+ ,a ,b)))))

Simp> (foo 1 2)
3
Simp> 

コンパイラの改良

((hygienic-name? (car expr))
         ; マクロ展開してからコンパイルする
         (let ((new-expr (vm '()
                             (cons (list expr env (get-hygienic-compile-env (car expr)))
                                   (get-hygienic-env(car expr)))
                             (if (symbol? (car expr))
                                 (get-macro-code (car expr))
                                 (get-macro-code (identifier->symbol (car expr))))
                             (list (list '() '() '(stop))))))
           (comp new-expr env code tail lmac)))

SC-transferはlambda式が二重になっており部分適用された状態でdefine-syntaxにより束縛される。。このlambda式をマクロで実行するにはそのlambdaに保持されているEレジスタの値を復元しないと正しく動作しない。 vmの第二引数がその部分。get-hygienic-envはそのEレジスタにあった値を取り出している。

デバッグするのにvmの実行の様子をステップ実行する必要があったためvm-stepを追加。S,E,C,Dのスタックを設定してステップ実行できる。

コンパイラは従来C言語で書いたものをメインとしてきたが今後コンパイラを柔軟に変更する必要があるためSchemeで書かれたものがデフォルトとなる。コンパイラの改造で動作不良になった場合には (change)でC言語でかかれたものに切り替える。C言語でかかれたコンパイラは現状維持で改良しない。非常時用。

以下のコードはまだ動かない。set!のコンパイルを改良しないといけない。 (set! synclo 3) のように第一引数にsyntactic-closureが来る場合にはコンパイル方法を変えないといけない。

(define-syntax swap! 
   (sc-macro-transformer 
    (lambda (form environment) 
      (let ((a (make-syntactic-closure environment '() (cadr form))) 
            (b (make-syntactic-closure environment '() (caddr form)))) 
        `(LET ((VALUE ,a)) 
           (SET! ,a ,b) 
           (SET! ,b VALUE))))))

動作した。set!のコンパイルを次のように改良。

((eqv? (car expr) 'set!)
         (if (and (not (symbol? (cadr expr)))
                  (not (identifier? (cadr expr)))
                  (not (syntactic-closure? (cadr expr))))
             (error "invalid syntax " expr))
         (if (not (= (length expr) 3)) (error "invalid syntx " expr))
         (cond ((symbol? (cadr expr))
                (let ((pos (location (cadr expr) env)))
                  (if pos
                      ; 局所変数
                      (comp (caddr expr) env (list* 'lset pos code) #f lmac)
                      ; 大域変数
                      (comp (caddr expr) env (list* 'gset (cadr expr) code) #f lmac))))
               ((identifier? (cadr expr))
                (comp (caddr expr) env (list* 'gset (identifier->symbol (cadr expr)) code) #f lmac))
               ((syntactic-closure? (cadr expr))
                (let ((pos (location (get-sc-expr (cadr expr)) (get-sc-env (cadr expr)))))
                  (if pos
                      (comp (caddr expr) env (list* 'lset pos code) #f lmac)
                      (comp (caddr expr) env (list* 'gset (get-sc-expr (cadr expr)) code) #f lmac)))))

Simp> (define a 1)
a
Simp> (define b 2)
b
Simp> (swap! a b)
1
Simp> a
2
Simp> b
1
Simp> 

局所環境ではうまくいっていない。

Simp> (let ((a 1)(b 2)) (swap! a b) (list a b))
(1 2)
Simp> 

Hygienic macro

自分なりに考えて健全マクロを書いたものの、どうもバグがとりきれない。十分に自分の頭で考え、検討したので、今度は典型的な実装を参考に書き直すこととした。今までのコードは放棄。

Chibi Schemeを参考にする。まずはsyntactic-closureからとりかかる。2012/08/28 08:48:02 UTC

まずはmake-syntactic-closure を実装した。セルにはcarとcdrしかないので3つの構造体を作るとするとメモリに無駄がでて速度も低下してしまう。exprとfvをconsして節約することとした。

int f_make_syntactic_closure(int env, int fv, int expr){
        int res;
    
    if(IS_SYNCLO(expr))
        return(expr);
    
    res = freshcell();
    SET_ENV(res,env);
    SET_BIND(res,cons(expr,fv));
    SET_TAG(res,SYNCLO);
    return(res);        
}

VMの命令にhygienic用のDEFH命令を追加した。伝統マクロと似ているが定義時の局所環境も引数に含めている。

(defh name body env) としておりnameのenvをとると定義時の局所環境を取得できるようにした。コンパイラはこれを利用してsyntactic-closureを生成する。

コンパイルするうえで必要なSCに関するpeocedureを用意した。

Simp> (define a (make-syntactic-closure 'a 'b 'c))
a
Simp> (get-sc-expr a)
c
Simp> (get-sc-fv a)
b
Simp> (get-sc-env a)
a

試行錯誤のために切り替え可能にしておいたSchemeで書かれたコンパイラを改造。SCをコンパイルできるようにした。exprを保存しておいた局所環境でコンパイルできるようになった。

Simp> (define a (make-syntactic-closure '() '() 'c))
a
Simp> a
#<synclo>
Simp> (compile a)
(ldg c stop)
Simp> (define a (make-syntactic-closure '() '() '(sin 1)))
a
Simp> (compile a)
(ldc 1 args 1 ldg sin app stop)
Simp> 

コンパイラを書き直してuse-env,mac-envを与えて展開できるところまでこぎつけた。

((hygienic-name? (car expr))
         ; マクロ展開してからコンパイルする
         (let ((new-expr (vm '()
                             (list (list expr env (get-macro-env (car expr))))
                             (if (symbol? (car expr))
                                 (get-macro-code (car expr))
                                 (get-macro-code (identifier->symbol (car expr))))
                             (list (list '() '() '(stop))))))
           (comp new-expr env code tail lmac)))

(define-syntax foo
  (lambda (expr use-env mac-env)
    (display expr)
    (display use-env)
    (display mac-env)
    `(+ ,(cadr expr) ,(caddr expr))))

Simp? (foo 2 3)
(foo 2 3)()()5
Simp? 

基本的な部分は動作している。

(define-syntax foo
  (lambda (expr use-env mac-env)
    (let ((a (make-syntactic-closure use-env '() (cadr expr)))
          (b (make-syntactic-closure use-env '() (caddr expr))))
      (make-syntactic-closure mac-env '() `(let ((a ,a)(b ,b)) (+ a b))))))

Simp? (foo 1 2)
3
Simp? foo
#<hygienic>
Simp? 

Simp? (define a 10)
a
Simp? (define b 20)
b
Simp? (let ((a 1)(b 2)) (foo a b))
3
Simp? 

er-macro-transfomerをテスト。まだよく理解できていない。

(define-syntax my-let*
  (er-macro-transformer
   (lambda (expr rename compare)
     (if (null? (cadr expr))
         `(,(rename 'begin) ,@(cddr expr))
         `(,(rename 'let) (,(caadr expr))
           (,(rename 'let*) ,(cdadr expr) ,@(cddr expr)))))))

Simp? (my-let* () 1)
()
Simp? (macroexpand '(my-let* () 1))
(#<synclo> 1)

モジュールの実装

R5RSの範囲内しか実装しないつもりだったものの、健全マクロのデバッグに困難があるためモジュールを導入することにした。せっかくだから先行してR7RSの仕様に従おうと思う。2012/08/23 03:31:14 UTC

まだよく理解できてないが、どうもこんな風なものらしい。

(define-library(example hello)
  (export hello-world)
  (import (scheme base))
  (begin      
    (define (hello-world) "hello, world")))  

デバッガ

マクロのデバッグをするのにもデバッガが必要。 学習用としてもデバッガは必要不可欠。おおよその仕組みを考えてみたのでメモ。

(trace exp)

一般的にSchemeに用意されているトレーサー。 トレースするリストを連想リストとして記憶。 ((fn1 n)(fn2 m)...) n,mにはネストレベルを記憶。

App,Tapp命令ではトレースリストがnullなら通常動作。 nullでなければassqしてクローじゃ、あるいは、subrが連想リストにあれば ネストレベル分空白を表示して引数をプリント。 ネストレベルを+1する。

CTRL+Cで連想リストをリセット。

検討した結果、C言語でVMに手を入れるのは困難と判断、Schemeレヴェルでtraceを実装した。 以前Gauche用に書いたものをR5RSの範囲で書き直し、simpmacs.scmに追加。 起動した時点で使える。今のところのデバッグツールはtraceとbreakの2つ。

(break)

単純にSECDの各スタックを表示してreplに戻る。 Dレジスタでそれまでの実行状況がわかる。 Eレジスタで局所変数がわかる。

Simp> (trace fact)
#t
Simp> (fact 10)
|(fact 10)
| (fact 9)
| |(fact 8)
| | (fact 7)
| | |(fact 6)
| | | (fact 5)
| | | |(fact 4)
| | | | (fact 3)
| | | | |(fact 2)
| | | |[10](fact 1)
| | | |[11](fact 0)
| | | |[11]1
| | | |[10]1
| | | | |2
| | | | 6
| | | |24
| | | 120
| | |720
| | 5040
| |40320
| 362880
|3628800
3628800
Simp> 

最後の追い込み

秋、完成を目指して最後の追い込み。2012/08/17 20:01:00 UTC

最終的に簡易開発環境、BabbageにSimpleを組み込む。 あらかじめ簡易グラフィクス、MIDIインターフェース用の手続きを組み込んでしまう。 インストールしたらすぐにプログラミングに取り掛かれてとりあえず面倒なことは覚えなくても それなりに楽しめる初心者向け環境を目指す。

バグリスト。

inexact->exact 大きな数のときにbignumに変換されていない。 一応実装、ただし精度に難あり。

Simp> (inexact->exact 12345e+40)
123450000000000000748048384932310016150369280
Simp> 

こうなってしまう。2進と10進の誤差の違いか?

複素数極座標形式 1@2のようなものが読み込めない。 実装済み 疑問:R5RSにはこの記法の説明が見当たらない。 教えてもらった。7.1.1字句の更生。R進複素数に記述があった。

文字が小文字に変換されてしまっている。 #\R -> #\r Charがらみのトークン取得は厄介。やっとバグがとれた。

let-syntax 次の場合に仕様不適合。(相模さんより)

(define x 'a)

(display
 (let ()
   (let-syntax ((my-define
                 (syntax-rules ()
                   ((_ v f)
                    (define v f)))))
     (my-define x 'b)
     (set! x 'b)
     x)
   ))

(display x)

健全マクロ パターンマッチ、仕様不適合。(相模さんより)

(define-syntax hoge
  (syntax-rules()
    ((_ b ...)(list b ...))))

(display (hoge)) 

マクロ、パターンマッチング修正。

Simp> ()#t
Simp> 

健全マクロ、パタンマッチ、仕様不適合。(相模さんより)

(define-syntax foo
  (syntax-rules()
    ((_ a)
     (let((a #t))a))))

(define-syntax bar
  (syntax-rules()
    ((_)(foo b))))

(bar)

↑、これGaucheだと通ってしまう。どうして??? bはパターン変数ではないので 自由変数、大域変数を参照してしまうはずなのに?

上記、理解した。fooはマクロなのでbはシンボルのままfooに渡される。自由変数にはならないのでこれで動かないといけない。問題はその実装法。

↑対応済。組み込みマクロ以外のマクロの展開をするときには識別子をsymbolに戻してコンパイルすることにした。2012/08/23 09:31:58 UTC

↑、不完全だった。こりゃなかなかにめんどうだ。

↑、ようやく解決。マクロが識別子を受け取ることは通常はなく、あるとすればこのような場合に限られる。それは変換前のシンボルであるべきだ。そこで識別子をあらかじめシンボルに変換してからマッチングに入ることとした。2012/08/23 12:14:33 UTC

省略子の関係のバグ(相模さんより)

(define-syntax hoge-helper
  (syntax-rules ()
    ((_ (n ...) () (temp ...))
     (let ((temp n) ...)
       (list temp ...)))
    ((_ (n ...) (r0 r1 ...) (temp ...))
     (hoge-helper (n ...) (r1 ...) (newtemp temp ...)))))
 
(define-syntax hoge
  (syntax-rules ()
    ((_ num ...)
     (hoge-helper (num ...) (num ...) ()))))
 
(display (hoge 1 2 3))

↑これはとても難しい。とりあえず省略子の処理を改良して次のようなものには対応した。

(define-syntax foo
  (syntax-rules ()
    ((_ (var ...) (num ...)) (let ((var num)...) (list var)))))

Simp> (foo (a b c) (1 2 3))
(1 2 3)
Simp> (macroexpand '(foo (a b c) (1 2 3)))
((lambda (a b c) (%list a b c)) 1 2 3)
Simp> 

newtempにはgensymでぶつからない新しい名前を与えればいいのだけど、そうするとマクロがマクロにSUBRを渡すときに問題がおきる。SUBRやClosureのときには識別子のまま渡ってくれないと困る。

さて、困った。難問。

複素関数 再び

Cに複素数ライブラリがあるなんて知らずに懸命にオイラーの公式から導出して自前で複素関数を実装していた。なんのことはないCにも複素数ライブラリがあったことを知って書き直し。単純になったものの微妙にGaucheの計算結果と違う場合がでてきた。2012/08/16 06:59:09 UTC

int f_cos(int lvar){
        int arg;
    double x,x1,y,y1;
        double complex z,z1;
    
    if(length(lvar) != 1)
        exception("cos", INCORRECT_ARG_CNT, NIL);
    arg = car(lvar);
    
    if(!numberp(arg))
        exception("cos", NOT_NUMBER, arg);
    
    if(realp(arg))
        return(makeflt(cos(GET_REAL_FLT(exact_to_inexact(arg)))));
    if(complexp(arg)){
        x = GET_REAL_FLT(arg);
        y = GET_IMAG_FLT(arg);
        z = x+y*I;
        z1 = ccos(z);
        x1 = creal(z1);
        y1 = cimag(z1);
        return(makecomp(x1,y1));
    }
}


祝い tarai 8秒台

ctrl+cでrepl復帰、ctrl+dで処理系強制終了を追加。オーバーヘッドを確認するのに例によって(tarai 12 6 0) をやってみると速くなってる。低レベルにある関数 get_gvarのバグをつぶした結果 無駄がなくなったらしい。2012/08/13 01:58:47 UTC

Simp> (time (tarai 12 6 0))
12
total 8.502000 second
gc    2.342000 second
Simp> 

ArduinoVM

とても単純なものながらSimpleからArduinoを操作するものを作った。付属ファイルのarduino.acmと arduinoVM.inoがそれ。あらかじめarduinoIDEでarduinoVMをコンパイル、書き込んでおく。 Simpleにarduino.scmをロードしてシリアル通信回線を開くとそこからインタラクティブに操作できる。kondo-lispに比較するときわめて単純、低機能ながら似たようなことができるようになった。 以下はLEDを点滅させるサンプルコード。2012/08/12 20:57:24 UTC

;; sample
(define led 13)

(define (setup)
  (pin-mode led 'output))

(define (led-on)
  (digital-write led 'high))

(define (led-off)
  (digital-write led 'low))

(define (blink n)
  (setup)
  (let loop ((m n))
    (if (= m 0)
        #t
        (begin
          (led-on)
          (sleep 100)
          (led-off)
          (sleep 100)
          (loop (- m 1))))))

;;(open-port! "COM3")
;;(blink 100)
;;(close-port!)


COM? はパソコンに依存する。COM3かCOM4にシリアル通信ポートが割り当てられているケースが多い。 Windowsのバージョンによってはそのままでは動かないときがあり、そのときはArduinoのツールの シリアルモニタを起動するとうまく動くようになる。理由はよくわからない。

オープンソース

他の掲示板で質問を受けたのですがSimpleのライセンスです。 M.Hiroiさんの書いたもの、設計が含まれているのでその著作権は尊重してほしいものの 基本的には改造自由のフリーソフトのつもりでいました。しかし、その辺りが現在の表示では わかりづらいとの指摘がありましたので、Gaucheに倣ってBSDライセンスであることを明記することにしました。

改造自由です。できればバグ修正のソースなどの情報ももらえればと思っています。バグはまだまだかなりあります。 2012/08/12 01:21:36 UTC

Arduino VM 計画

シリアル通信でArduinoをSchemeの手足にしてしまおうという計画。書き始めた。

//Arduino VM for Scheme with RS232C

#define PM 101
#define DW 102
#define DR 103

int opc,arg1,arg2,arg3;

void setup() {
  Serial.begin(9600);
}

void loop() {
   while(Serial.available() == 0)
     continue;
   opc = Serial.read();
   while(Serial.available() == 0)
     continue;
   arg1 = Serial.read();
   while(Serial.available() == 0)
     continue;
   arg2 = Serial.read();
    
    
    switch(opc){
      case PM:  
                switch(arg2){
                  case 1:  pinMode(arg1, INPUT); break;
                  case 2:  pinMode(arg1, OUTPUT); break;
                  case 3:  pinMode(arg1, INPUT_PULLUP); break;
                }
                break;
      case DW: 
               switch(arg2){
                  case 1:  digitalWrite(arg1, HIGH); break;
                  case 2:  digitalWrite(arg1, LOW); break;  
               }
               break;
   
    }
    //for debug
    Serial.write(opc);
    Serial.write(arg1);
    Serial.write(arg2);
    Serial.write(arg3);
    delay(5);

}


(define *port* #f)

(define pm 101)
(define dw 102)
(define dr 103)

(define led 13)

(define (send ls)
  (if (null? ls)
      #t
      (begin (write-char (integer->char (car ls)) *port*)
             (send (cdr ls)))))


(define (pin-mode x mode)
  (case mode
    ((input)
     (send `(,pm ,x 1)))
    ((output)
     (send `(,pm ,x 2)))
    ((input-pullup)
     (send `(,pm ,x 3)))
    (else #f)))

(define (open-port! x)
  (set! *port* (open-port x)))

(define (close-port!)
  (close-port *port*)
  (set! *port* #f)
  #t)

(define (digital-write x val)
  (case val
    ((high)
     (send `(,dw ,x 1)))
    ((low)
     (send `(,dw ,x 2)))
    (else #f)))

(define (setup)
  (pin-mode led 'output))

(define (led-on)
  (digital-write led 'high))

(define (led-off)
  (digital-write led 'low))

(define (getc)
  (char->integer (read-char *port*)))

Simp> (open-port! "COM3")
#<port>
Simp> (setup)
#t
Simp> (led-on)
#t
Simp> (led-off)
#t
Simp> (close-port!)
#t
Simp> 


目標

赤外線リモコンによる制御機能を取り入れたい。ホビーロボットをSchemeで動かす。

Arduinoのことを紹介してもらった。これは面白そう。さっそく発注する。Schemeでアセンブリコードを生成、シリアルで転送して動作させてみたい。2012/07/31 23:46:51 UTC

Arduinoの接続を終了。シリアル通信で制御する方法を模索中。 Simpleをちょっと改造すれば単純なシリアル通信ができることが判明。 以下、サンプル。 スケッチのコードはcranebirdさんのブログにあったものを 一部改編して使わせていただきました。2012/08/05 08:11:20 UTC

educational Scheme compiler Simple Ver0.31.4 (written by Kenichi.Sasagawa)
Simp> (define out (open-output-file "COM3"))
out
Simp> (write-char #\h out)
#<undef>
Simp> (write-char #\l out)
#<undef>
Simp> (write-char #\h out)

LEDが点滅。

// Serial - Gauche - Test - Arduino 
#define LED 13
int inByte;

void setup() {
  pinMode(LED, OUTPUT);
  Serial.begin(9600);
}

void loop() {
  //  Serial.println("x");
  if (Serial.available() > 0) {
    inByte = Serial.read();
    if (inByte == 'l') {
      digitalWrite(LED, LOW);
    } 
    else if (inByte == 'h') {
      digitalWrite(LED, HIGH);
    } 
    else if (inByte == 's') {
      delay(100);
    }

    //Serial.write("AR: "); 
    //Serial.write(inByte);
    //Serial.write("\n");
    delay(5);
  }
}

Simpleは単方向のシリアル通信としてしかopenできないのでwriteの部分はコメントアウト。
これで正常動作する。

マクロの書き直し

let,condなどが伝統的マクロで書かれている。依存関係を整理、簡潔にし 健全マクロ関係の関数の名前を隠ぺいしてしまおうと考えている。 letで使われているmapをletを使わずに書くには??? 内部defineはletに変換する仕組みにしている、どうしよう? lambdaなどコアのものだけを使って書き直した.2012/07/28 10:44:55 UTC

(define map 
  (lambda (f ls . more)
    ((lambda (map1 map-more)
       (set! map1 (lambda (ls)
                    (if (null? ls) 
                        (quote ()) 
                        (cons (f (car ls))
                              (map1 (cdr ls))))))
       (set! map-more (lambda (ls more)
                        (if (null? ls)
                            (quote ()) 
                            (cons (apply f (car ls) (map car more))
                                  (map-more (cdr ls) (map cdr more))))))
       (if (null? more)
           (map1 ls)
           (map-more ls more)))
      (quote *undef*) (quote *undef*))))

letrec-syntax

最後の難関。R5RSの例題は次のよう。

(letrec-syntax 
  ((my-or (syntax-rules ()
            ((my-or) #f)
            ((my-or e) e)
            ((my-or e1 e2 ...)
             (let ((temp e1))
               (if temp
                   temp
                   (my-or e2 ...)))))))
  (let ((x #f)
        (y 7)
        (temp 8)
        (let odd?)
        (if even?))
    (my-or x
           (let temp)
           (if y)
           y)))

テンプレート部に再帰をもつ健全マクロを展開するために識別子に変換された マクロを展開する部分を追加。

((and (identifier? (car expr))(assq (identifier->symbol (car expr)) lmac))
         ;;局所マクロの場合
         (let* ((clo (vm '()
                         '()
                         (compile (cadr (assq (identifier->symbol (car expr)) lmac)))
                         (list (list '() '() '(stop)))))
                (new-expr (apply clo (cdr expr))))
           (comp new-expr env code tail lmac)))

さらにletにある局所定義された関数呼び出しに対応するために次を追加。

((and (symbol? (car expr))(location (car expr) env))
         (complis (cdr expr)
                   env
                   (list* 'args
                          (length (cdr expr))
                          (comp (car expr) env (cons (if tail 'tapp 'app) code) #f lmac))
                   lmac))
        

無事動作に至った。

Simp> (change)
#<undef>
Simp? 7
Simp? 

2012/07/26 07:02:55 UTC

実験用コンパイラ

Cで書かれたコンパイラだと改良がめんどうくさい。そこでSchemeで書かれたコンパイラを読み込んでおいて切り替えられるにようした。(change)で切り替わる。プロンプトが変わる。Schemeなら変更が容易なので十分にコンパイラを試してからCに書き直せる。いや、もうCで書かれたコンパイラは必要ないのかもしれない。Cで書かれたコンパイラは実験でおかしくなったときの緊急用になるかもしれない。2012/07/24 09:21:56 UTC

educational Scheme compiler Simple Ver0.31.0 (written by Kenichi.Sasagawa)
Simp> (+ 1 2)
3
Simp> (change)
#<undef>
Simp? (+ 1 2)
3
Simp? 

let-syntax

let-syntax にめどがついたのでメモ。 schemeで書かれたコンパイラに次を加える。

((eq? (car expr) 'let-syntax)
         (comp-body (cddr expr) env code (append (cadr expr) lmac)))

((assq (car expr) lmac)
         ;;局所マクロの場合
         (let* ((clo (vm '()
                         '()
                         (compile (cadr (assq (car expr) lmac)))
                         (list (list '() '() '(stop)))))
                (new-expr (apply clo (cdr expr))))
           (comp new-expr env code tail lmac)))

let-syntaxは単純に局所マクロの連想リストをコンパイラの引数に保ち、body部をコンパイルする。

局所マクロを接頭にもつexprを見つけたらその実体であるexprをコンパイル。 コンパイルしたclosureにマクロの引数を与えてパターンマッチの結果であるexprを取り出す。 最後にそのexprをコンパイルする。2012/07/23 23:09:13 UTC

お休み

細々としたところが未完成なものの、しばらくお休み。

ライブハウス出演のため音楽に没頭予定。2012/07/16 17:47:04 UTC

実装アイディアメモ 2012/07/16 00:27:20 UTC

inexact->exact 浮動小数点数の場合。

例 0.0023 -> 23/10000 既約分数につき終了。 0.0022 -> 22/10000 -> 11/5000 既約分数。

問題はCで各桁の数をどう効率よく取り出すか?

string->number bignumの場合

x = bignum. y = digit
r = 0 剰余
str = ""

x1 = reverse(x);
while(!nullp(x1){
l = get_int(car(x));
q = l / y;
r = l % y;
str = str + itoa(r*bignumbase+q, y);
x1 = cdr(x1);
}

return(str);

10進はうまくいったものの、n進数の場合がどうもうまくいかない。

Bug 要修正リスト

山ほどBugはありましょうが・・・。気がついたものから。気長に修正。2012/07/09 12:28:44 UTC

指数形式の浮動小数点数が読み込めない。 修正済み

文字列の中に文字列があった場合が読み取れない。 修正済み

let-syntax がまだ実装されていない。 let-syntax、letrec-syntax 実装済み。

エラーメッセージを返さないsubrがある。

gcd,lcmで23.0 などの不正確な整数が処理されない。 修正済み

evalの第2引数に対応してない。

gensymで生成されたシンボルの唯一性が不完全。

Vectorのメモリ領域のGCがまだ実装されていない。 実装済み

値を持たないシンボルがGCで回収されていない。

bignumの除算が未整備。 分数は分子、分母ともにCのintegerの範囲内。 (/ bignum int) で整数、あるいは上記の分数に収まらなければエラーにする。

遅延関係のprocedureが未実装。規格には入ってないけれど。

inexact->exact 不完全

シンボルの文字セット 一部準拠してない。 修正済み

<未完に終わったこと>

型推論

世代別GC

<テスト>

r4rstest.scm まだ通らない。

シンボルに許す文字、補充。&,~,^。 修正済み

スペース文字を表すのは#\spaceのはず。R4RSは#\ を許容している。??? 修正済み

理解不能。->解決。shiroさんありがとうございました。 修正済み

(#<subr null?> ())  ==> #t
 BUT EXPECTED #f
(#<subr symbol?> ())  ==> #f
 BUT EXPECTED #t
#t
Simp> 

cond節の =>が未実装だった。 修正済み

let内の内部定義のスコープを間違えてる。間違っていない。test側に問題がある。 ->関数適用の場合に引数の内部定義の変換ができていなかった。 修正済み

(if (procedure? fun) (apply fun args) (car args)))))

letはマクロになってるのでこれだとうまく判定されないはず。 equal?で判定していてこれだとうまく判定できていない。計算結果は正しい。

beginの場合にはdefineは大域定義となる。内部定義と間違えていた。 修正済み

gosh> (begin (define a 1) a)
1
gosh> a
1

vectorに対するeq?など等価述語が異常終了。 equal?修正済み

appendの末尾要素はpairも許容するのか。知らなかった。 修正済み

gosh> (append '() "a")
"a"
gosh> 

知らなかった!

おや? Norvig先生の名前が・・・メモに。

string->number, number->stringでサボっていたn進を実装。

string-append 引数なしの場合には""を返す。 修正済み

let* パラメータが()のときにエラー。修正済み

test-bignum 内部定義が最後にきている。R5RS仕様不適合のはず。書き換える。

bignumでのmodulo計算誤り。修正済み

bignumでのnumber->string 未実装。 実装済み(ただし10進数のみ)

エラー処理不完全。修正済み

Simp> (1 2 3)
()
Simp> 

数値、#e,#i 接頭辞、未実装。 実装済み。

もうすぐSimpleプロジェクト終了

Prologを作るつもりがLispにはまり、Scheme作成に没頭することとなった。 昭和58年頃に8bitマイコンで動く純Lispを移植、逆アセンブルしていたのが始めで かれこれ30年以上が経過していた。Shiroさん、M.Hiroiさん他パイオニアの助言を得てなんとか その頃の夢が実現できてうれしい。

おおむねR5RSの仕様は充足したのであとは細々とした修正追加が残るのみ。 実用は意図していないのでsrfiなどライブラリの充足はまったく考えていない。 どんな仕組みでSchemeは動いているのか? I/Oやアスキーを読みながら Basicインタプリタの逆アセンブルをしたノリでSchemeを楽しんでいただけたら 望外の喜び。デザインの元となったSECDマシンはとてもエレガントであり、これが私が生まれた頃に考案されて いたというのだから驚きだった。

もしもよろしければSimpleをつかってBasicを逆アセンブルするノリでSchemeと SECDマシンを楽しんでください。2012/07/08 18:36:41 UTC

健全マクロ 達成か?

識別子を使う方法によりなんとかスコープの問題を解決した(はず)。2012/07/08 10:51:21 UTC

(define-syntax settest
  (syntax-rules ()
    ((_) (set! b 1))))

(define b 0)
(let ((b 10)) (settest))

Simp> settest
Simp> b
Simp> 1
Simp> 

Simp> (macroexpand '(settest))
(%set! %b 1)
Simp> 

1ヶ月も経つとおそらくどういう仕組みを考えたのか忘れてしまうはず。今のうちにメモ。

identifierの導入。 シンボルを識別子に変換するものを用意した。(symbol->identifier x) シンボルと異なりアドレスは一意ではない。 eq?で比較してもアドレスが異なるので#fとなる。 逆関数は(identifier->symbol x) 型判定は(identifier? x)

eqv?は同じ印字名を持つシンボルと識別子は等価であるということにした。 コンパイラが接頭を判定するのに用いる。

(define-syntax settest
  (syntax-rules ()
    ((_) (set! b 1))))

ではルールは識別子に変換される。識別子は先頭に%をつけて表示される。

((%_) (%set %b 1))

さらにパターンの省略子(x y ...)をマッチングで扱いやすいように識別子に変換する。

テンプレート部にletなど局所変数を生ずるものがある場合には(gensym)で生成したシンボルに置き換える。

上記の例だとマッチングにより生ずる局所変数はないので生成されるテンプレートは

(%set %b 1)

コンパイラは%setとシンボルのset!をeqv?により判定、同一視する。%bは自由変数なので コンパイラは(ldg b)を生成する。これにより

(let ((b 0)) (settest))

であっても局所ではなく大域定義を参照することになる。

パターンマッチングなどはSchemeでかかれており添付のsimpmacs.scmに収録されている。

identifier 導入

健全マクロ、アイディアをもとに実装。いいところまで漕ぎ着けたものの、パターンマッチで置換した局所変数のスコープがおかしくなる。そこでidentifierという型を導入する。コンパイラは例えばset!という印字名のsymbolとiditifierがあったら同一視する。置換されたパターン変数、letなどでgensymにより生成されたものだけはld命令にコンパイルする。

健全マクロ 再考

思いついたのでメモ:

パターンマッチングのときと、テンプレート実行のときのスコープルールを変更してコンパイルするようにコンパイラを変更する。

(bend template literal)

というのを作る。テンプレート実行時にはシンボルは基本、大域変数とみてldg命令を生成する。 literalに含まれてるシンボルはldc命令を生成。gensymで置換されているものだけは局所変数なのでld命令を生成。 (compile ... )に通常スコープかテンプレート実行時スコープかを区別するために引数を与える。 2012/07/03 03:25:02 UTC

ああ、その前にマクロなら置換してそれからコンパイルだった。macroexpand macroexpand1 gensym? を整備してコンパイラを改造。

祝い tarai 10秒切り

微妙に速くなっていてなぜ?と考えてみたら再帰で書かれて不具合のあったassqなどを繰り返しに直したせいだった。C言語にとって再帰は効率が悪い。シンボルの検索はハッシュで配列を探しハッシュ値の同じシンボルの中からassqで線形検索をしていた。そこで効率上がった結果のようだ。

Simp> (time (tarai 12 6 0))
12
total 9.844000 second
gc    2.294000 second
Simp> 

思いおこせば昭和59年ごろ、竹内関数という名前さえ知らなかった私は8bitの64KB FLEXで動作するLisp09でこのtaraiを計算していた。Lisp09は健気にもGCを繰り返しつつ計算をしていた。が、たしかに1日かかっても計算は終わりそうもなかった。それが今やスーパーコンピューターのようなパソコンを所持している。そのスーパーマシンのうえで自作の処理系が10秒足らずでこの計算をこなしている。 なんとも感慨深い。2012/07/02 08:56:41 UTC

UTF8へ変更など

sakaeさん、お久しぶりです。その節はお世話になりました。

unixへの移植記事を読んであちこち変更。文字コードはUTF8へ変更。 assqなど再帰で書いてあったものは繰り返しに変更。 loadで使っていたlongjumpはすでに使っていない。

小規模な変更でunix系でも動いてくれたらうれしいです。2012/07/01 23:31:26 UTC

truncateでおおハマリ

R5RSを注意深く読むとちゃんと書いてある。でも、はまった。 素数夜曲のこのコード。

(define adjust-of
  (lambda (x)
    (let ((digit 100)
          (slide (if (positive? x) 1/2 -1/2)))
      (/ (truncate (+ slide (* digit x))) digit))))

Simp> (adjust-of 0.299)
0.3
Simp> (adjust-of 3)
3
Simp>

truncateって分数のときには正確数で、不正確な浮動小数点数だと不正確で返さないといけない。

Simp> (map / num1-9)
(1 1/2 1/3 1/4 1/5 1/6 1/7 1/8 1/9)
Simp> 

こうならなくてどうしてか?とひどく悩んだ。2012/07/01 09:59:01 UTC

素数夜曲

オイラーの贈り物は20代の頃に購入し、数学再学習への動機となった本のひとつだった。この度、 素数夜曲が発刊されたのでSimpleの数学関数のバグつぶしをしながら読んでいる。 +i = 0+1i, -i = 0-1i はおそらくGaucheの拡張だと思うのだけど同様にトークン取り込みを改良した。誤差の問題がなければあの懐かしいe^(i pi) = -1 がでてくる。2012/06/30 00:37:50 UTC

Simp> (define pi (acos -1))
pi
Simp> pi
3.141592653589793
Simp> (define e (exp 1))
e
Simp> (expt e (* +i pi))
-1+1.224606353822377e-016i
Simp> 

Schemeで書かれたコンパイラ

ver0.21.2からSchemeで書かれたコンパイラ compile.scm が付属している。コードは原作者の M.Hiroiさんが書いたものとほぼ同じ。(macro? )の部分が違うのと引数の個数チェックをldf命令に 追加しているのが違うくらい。2012/06/29 10:10:45 UTC

次のようにしてコンパイラの生成するコードを確認し、vmも呼び出すことができる。 vm procedureの引数は4つでS,E,C,Dの各レジスタに与えるリスト。 これによりコンパイラの生成するコードをあれこれといじってみようと思っている。

Simp> (compile '(+ 1 2))
(ldc 1 ldc 2 args 2 ldg + app stop)
Simp> (vm '() '() (compile '(+ 1 2)) '())
3
Simp> 

LDF命令拡張 引数個数チェック

lambdaを定義実行するときに引数の個数があっているかをチェックする仕組みを入れた。ldf命令 にlambdaの引数の個数を示す引数をひとつ加えた。任意個の引数の時にはマイナスで表す。 (lambda (x . y) ...) だと-2。app,tapp命令で実行時に引数の個数の整合性をチェックし不整合ならエラーを呼び出す。問題はオーバヘッド。taraiのように既に1回やれば引数の個数が正しいことがわかりきっているものに対して数百万回もチェックをする。大丈夫か?

Simp> (time (tarai 12 6 0))
12
total 24.144000 second
gc    9.423000 second
Simp> 

ほとんどオーバーヘッドはなかった。古いマシンでもこの程度なので新しいマシンなら問題にはならないだろう。2012/06/28 23:17:48 UTC

新しいマシンが正常に動き出したのでテスト。

Simp> (time (ack 3 8))
2045
total 3.130000 second
gc    0.740000 second
Simp> (time (tarai 12 6 0))
12
total 10.141000 second
gc    2.280000 second
Simp> 

Gaucheの20倍遅いが、簡単な計算ならそこそこ動くようになった。学習用ということならこれでイケルかもしれない。2012/06/29 08:47:36 UTC

動作不安定

古いノートマシンが限界で新しいノートを発注。納品されたのでSimpleを試してみると。なんかすごいばらつき。他のマシンだと安定してほぼ同じタイムを出す(time (tarai 12 6 0))11秒~30までばらつく。これは何だろう。GCのバグなら他のマシンでもばらつきができるはずなのに。同じスペックの仕事用のマシンは安定して10秒を切っている。わけがわからない。2012/06/26 12:42:45 UTC

どうもよくわからない。Windowsが嫌いになりそうだ。Gaucheをインストールして動かすと正常に高速に動作する。ところがSimpleを起動させると動作速度が不安定となる。不思議なのは他の同等のWin7マシンではまったく問題がおきないこと。仮想記憶を疑ったがそれは違うようだ。印字名確保ように動的に確保しているメモリの解放漏れかとGC時に全部freeしてもダメ。同じプログラムが同じメーカーの同じWin7マシンで動く場合と不安定になる場合があるというのはどうにも理解不能。お手上げ。2012/06/27 11:13:16 UTC

単にマシンの初期不良なのかも。Gaucheも最初は高速に動作するものの、しばらくすると動作が遅くなる。WOW64のオーバーヘッドにしてはひどすぎる。突然に3倍も遅くなるなんてあり得ない。

サポートの人に見てもらった。無線LANなど当方に必要ない常駐ソフトのプロセスをカットしてもらったところ、Gaucheはその本来の性能で動作している。Simpleも(tarai 12 6 0)が11秒台。 他の同種のマシンだと9秒台。まだ余計なプロセスがメモリを無駄にしているのかもしれない。2012/06/29 02:43:55 UTC

素数計算 末尾再帰

途中でハングする。原因のGCを直してもまだセル不足に陥る次のコード。

(define (deterministic-prime? n)
  (define (iter x y)
    (cond ((> x y) #t)
          ((divisible? n x) #f)
          ((= x 2) (iter 3 y))
          (else (iter (+ x 2) y))))
  (if (< n 2)
      #f
      (iter 2 (sqrt n))))

(define (divisible? m n)
  (= (modulo m n) 0))

;;155196355420821961 素数

素数判定。大きめの素数の判定をするとセルがどんどん減っていく。末尾再帰になっていずにDスタックを消費していくのが原因だった。Gaucheはこのくらいでも計算してくれたのでいいのかと思っていた。この書き方じゃだめなのか?あるいは、コンパイラで工夫の余地があるのか。わかってたつもりの末尾再帰、理解が浅いのでしばらくこの辺りを整理してみようと思う。2012/06/24 07:58:40 UTC

これを書いたのって3年くらい前か。ひどく非効率。2との比較は最初だけでいいのに。 condがマクロでifに展開されるためわかりづらい。直接ifで書いた。これならどうか?

(define (deterministic-prime? n)
  (define (iter x y)
    (if (> x y)
        #t
        (if (divisible? n x)
            #f
            (iter (+ x 2) y))))
  (cond ((< n 2) #f)
        ((= n 2) #t)
        (else (iter 3 (ceiling (sqrt n))))))



(define (divisible? m n)
  (= (modulo m n) 0))

末尾再帰にコンパイルされた。ただし、計算はいつになったら終わることやら。2012/06/25 12:14:51 UTC

5~6分、GCを繰り返して計算終了。一応は動く。遅いけど。

exit  GBC free= 4991293
enter GBC free= 499999
exit  GBC free= 4991293
enter GBC free= 499999
exit  GBC free= 4991296
enter GBC free= 499999
exit  GBC free= 4991286
enter GBC free= 499990
exit  GBC free= 4991288
#t
Simp> 

原因判明。マクロ展開するときに末尾再帰かどうかの判定スイッチを#fにしてコンパイルしてた。 意味がよくわかってなくて#fにしてしまってた。

((macroname? (car expr))
         (let ((new-expr (vm '()
                             (list (cdr expr))
                             (get-macro-code (car expr))
                             (list (list '() '() '(stop))))))
           (comp new-expr env code tail))) ;;ここがまちがってた。#fを渡してた。

2012/07/05 09:20:59 UTC

大域変数 ハッシュテーブル

学習用なので大域変数は連想リストでいいと思っていた。 しかし、相模さんからの助言でシンボルの同一性、eq?の実装から 小規模な処理系といえども大域定義は効率良く、シンボルは常に 同一のアドレスのものを指すべきだと気がついた。

ヘクマトプール教授のLispもCプログラムブックのLispも大域変数は ハッシュテーブルを使って管理している。同様な手法によりSimpleも書き直した。

これによりeq?はとても簡潔になった。そしてldg命令もとても簡潔になった。 シンボルの示す実体はシンボルセルの構造体要素BINDに接続するようににしたので かなり簡潔になった。これにより無駄なシンボルの消費が減ったので若干GCの効率がよくなり 性能向上に繋がった。

GCはOblistにある値は持たないがシンボルとして登録されたものを削除する必要がある。 Vectorの領域とあわせてGCのコードを書きなおす必要がある。

全体としてかなり無駄なコードを削ることができた。2012/06/23 10:06:45 UTC

自由変数の衝突

局所変数のリネーム、衝突防止はできたかに思えた。しかし、敵はまだもう一人いた。自由変数だ。

Simp> (let ((< (lambda args #f)))
  (arithmetic-if -1 'neg 'zero 'pos))
pos
Simp> 

これは間違ってる2012/06/18 23:28:39 UTC

対策メモ:定義時の局所環境を保存してマクロの環境にセット、実行時に定義時の環境を再現して実行と考えていた。しかし、それだと

(define-syntax setvar
  (syntax-rules ()
    ((_ var x) (set! var x))))

のときに外側の局所環境が拾えない。

そこで、自由変数には区別可能な名前にリネームすることを考えている。例えばa なら #:_a のようにしてコンパイラはその特殊な名前のときにはldg命令を生成するようにする。

さて、どうかな。

名前付きのletのときにその名前をgensymで置き換えていなかった。そこを直せばそれなりに自由変数の問題も回避できてるようだ。だが、やり方がなんとも汚らしい。自由変数を拾いだすところがごちゃごちゃ。局所変数でマクロ内で生成されたものはgensymで置き換えられている。そうするとあとは大域定義に無い変数、定義があってもProcedureやMacro、syntaxでないもの、それを自由変数として拾い出してコンパイラがわかるようなシンボルに付け替えている。

この仕組みがどうも気に入らないのでSyntatic-Closureというものを勉強しはじめたがなかなか時間がかかりそうだ。2012/06/20 23:36:02 UTC

健全マクロ 動作

改良して同じアイディアで動くようになった。流れは局所変数のgensymへの置換。省略子の置換、最後にパターン変数の置換。2012/06/17 00:05:04 UTC

Simp> (let ((var 3)) (arithmetic-if -1 (list var)))
(3)
Simp> (let ((i 88)) (for (i 1 10) (display i)) (newline) (display i))
12345678910
88#<undef>
Simp> 
;;健全マクロ
;;伝統的マクロの枠組みでパターンマッチングによるdefine-syntaxを実装している。

;;省略子をシンボルに変換 ex (_ x ...) -> (_ ?x)
(define (omit->symbol x)
  (cond ((null? x) '())
        ((atom? x) x)
        ((and (list? x)(>= (length x) 2)(symbol? (car x)) (eq? (cadr x) '...))
         (cons (string->symbol (string-append "?" (symbol->string (car x)))) (cddr x)))
        (else (cons (omit->symbol (car x)) (omit->symbol (cdr x))))))


(define (match x y except)
    (match1 (omit->symbol x) y except '()))

(define (match1 x y except rel)
  (cond ((and (null? x) (not (null? y))) 'fail)
        ((and (not (null? x)) (null? y)) 'fail)
        ((null? x) rel)
        ((symbol? x) (cons (cons x y) rel))
        ((omit? (car x)) (cons (cons (car x) y) rel))
        (else (let ((r1 (match1 (car x) (car y) except rel))
                    (r2 (match1 (cdr x) (cdr y) except rel)))
                (if (or (eq? r1 'fail) (eq? r2 'fail))
                    'fail
                    (append r1 r2))))))


(define (omit? x)
  (and (symbol? x)
       (char=? #\? (string-ref (symbol->string x) 0))))


(define (fail? x)
  (eq? x 'fail))

(define-macro try
  (lambda args
    (if (null? args)
        'fail
        (if (null? (cdr args))
            (car args)
            `(let ((+value+ ,(car args)))
               (if (not (fail? +value+)) +value+ (try ,@(cdr args))))))))


;;パターン変数を置換
(define (subst x lis)
    (subst1 (omit->symbol x) lis))
    


(define (subst1 x lis)
  (cond ((fail? lis) 'fail)
        ((null? x) '())
        ((and (symbol? x) (assoc x lis)) (cdr (assoc x lis)))
        ((atom? x) x)
        ((omit? (car x))
         (append (cdr (assoc (car x) lis)) (subst1 (cdr x) lis)))
        (else (cons (subst1 (car x) lis)
                    (subst1 (cdr x) lis)))))

(define (let? x)
  (and (list? x) (eq? (car x) 'let) (not (symbol? (cadr x)))))

(define (named-let? x)
  (and (list? x) (eq? (car x) 'let) (symbol? (cadr x))))

(define (letrec? x)
  (and (list?  x) (eq? (car x) 'letrec)))

(define (let*? x)
  (and (list?  x) (eq? (car x) 'let*)))

(define (vars->gen vars)
  (vars->gen1 vars '()))

(define (vars->gen1 vars lis)
  (if (null? vars)
      lis
      (vars->gen1 (cdr vars) (cons (cons (caar vars) (gensym)) lis))))

;;局所変数をgenymに置換
(define (subst-local-vars x)
  (subst-local-vars1 x (make-local-vars (cdr x) '())))

;;置換対応表から局所変数をgensymで生成されたシンボルに置換。
(define (subst-local-vars1 x lis)
  (cond ((null? x) '())
        ((and (atom? x)(assoc x lis)) (cdr (assoc x lis)))
        ((atom? x) x)
        (else (cons (subst-local-vars1 (car x) lis)
                    (subst-local-vars1 (cdr x) lis)))))
          
        
;;局所変数の置換対応表を作る。
(define (make-local-vars x lis)
  (cond ((null? x) lis)
        ((atom? x) lis)
        ((let? x) (make-local-vars (cddr x) (vars->gen (cadr x))))
        ((letrec? x) (make-local-vars (cddr x) (vars->gen (cadr x))))
        ((named-let? x) (make-local-vars (cdddr x) (vars->gen (caddr x))))
        (else (append (make-local-vars (car x) lis)
                      (make-local-vars (cdr x) lis)))))


(define-macro syntax-rules
  (lambda (except . rules)
    `(lambda x
       (let ((e ',except)
             (r #f))
         (set! r (try ,@(make-pat rules)))
         (if (fail? r)
             (exception "invalid syntax" '())
             r)))))

(define (make-pat rules)
  (map (lambda (x) 
         (let ((y (subst-local-vars x)))
         `(subst ',(cadr y) 
                           (match ',(cdar y) x e)))) rules))



健全マクロ 試作品

とりあえずの試作品。不完全。一応、変数衝突を回避しようとしているものの、うまくいかない場合がある。 アイディアは省略子を扱いやすいように(_ x ...)->(_ ?x)に変換。さらにパタン変数のxを置換。最後にletなどで生ずる局所変数をgensymで置換。

うまくいく例

Simp> (let ((i 88)) (for (i 1 10) (display i)) i)
1234567891088
Simp> 

うまくいかない例

(define-syntax arithmetic-if 
  (syntax-rules ()
    ((arithmetic-if test neg-form zero-form pos-form)
     (let ((var test))
       (cond ((< var 0) neg-form)
             ((= var 0) zero-form)
             (else      pos-form))))
    ((arithmetic-if test neg-form zero-form)
     (arithmetic-if test neg-form zero-form #f))
    ((arithmetic-if test neg-form)
     (arithmetic-if test neg-form #f #f))))


Simp> (let ((var 3)) (arithmetic-if -1 (list var)))
(-1)
Simp> 
;;健全マクロ
;;伝統的マクロの枠組みでパターンマッチングによるdefine-syntaxを実装している。
(define (omit->symbol x)
  (cond ((null? x) '())
        ((atom? x) x)
        ((and (list? x)(>= (length x) 2)(symbol? (car x)) (eq? (cadr x) '...))
         (cons (string->symbol (string-append "?" (symbol->string (car x)))) (cddr x)))
        (else (cons (omit->symbol (car x)) (omit->symbol (cdr x))))))


(define (match x y except)
    (match1 (omit->symbol x) y except '()))

(define (match1 x y except rel)
  (cond ((and (null? x) (not (null? y))) 'fail)
        ((and (not (null? x)) (null? y)) 'fail)
        ((null? x) rel)
        ((symbol? x) (cons (cons x y) rel))
        ((omit? (car x)) (cons (cons (car x) y) rel))
        (else (let ((r1 (match1 (car x) (car y) except rel))
                    (r2 (match1 (cdr x) (cdr y) except rel)))
                (if (or (eq? r1 'fail) (eq? r2 'fail))
                    'fail
                    (append r1 r2))))))


(define (omit? x)
  (and (symbol? x)
       (char=? #\? (string-ref (symbol->string x) 0))))


(define (fail? x)
  (eq? x 'fail))

(define-macro try
  (lambda args
    (if (null? args)
        'fail
        (if (null? (cdr args))
            (car args)
            `(let ((+value+ ,(car args)))
               (if (not (fail? +value+)) +value+ (try ,@(cdr args))))))))



(define (subst x lis)
    (subst2 (subst1 (omit->symbol x) lis)
            '()))
    


(define (subst1 x lis)
  (cond ((fail? lis) 'fail)
        ((null? x) '())
        ((and (symbol? x) (assoc x lis)) (cdr (assoc x lis)))
        ((atom? x) x)
        ((omit? (car x))
         (append (cdr (assoc (car x) lis)) (subst1 (cdr x) lis)))
        (else (cons (subst1 (car x) lis)
                    (subst1 (cdr x) lis)))))

(define (let? x)
  (and (list? x) (eq? (car x) 'let) (not (symbol? (cadr x)))))

(define (named-let? x)
  (and (list? x) (eq? (car x) 'let) (symbol? (cadr x))))

(define (letrec? x)
  (and (list?  x) (eq? (car x) 'letrec)))

(define (let*? x)
  (and (list?  x) (eq? (car x) 'let*)))

(define (vars->gen vars)
  (vars->gen1 vars '()))

(define (vars->gen1 vars lis)
  (if (null? vars)
      lis
      (vars->gen1 (cdr vars) (cons (cons (caar vars) (gensym)) lis))))

(define (subst-vars x lis)
  (if (null? x)
      '()
      (cons (list (cdr (assoc (caar x) lis)) (cadar x)) (subst-vars (cdr x) lis))))
        

(define (subst2 x lis)
  (cond ((null? x) '())
        ((and (atom? x) (assoc x lis)) (cdr (assoc x lis)))
        ((atom? x) x)
        ((let? x) (let ((gens (vars->gen (cadr x))))
                    (cons (car x) (cons (subst-vars (cadr x) gens) (subst2 (cddr x) (append gens lis))))))
        ((letrec? x) (let ((gens (vars->gen (cadr x))))
                    (cons (car x) (cons (subst-vars (cadr x) gens) (subst2 (cddr x) (append gens lis))))))
        ((named-let? x) (let ((gens (vars->gen (caddr x))))
                          (cons (car x) (cons (cadr x) (cons (subst-vars (caddr x) gens) (subst2 (cdddr x) (append gens lis)))))))
        (else (cons (subst2 (car x) lis)
                    (subst2 (cdr x) lis)))))



(define-macro syntax-rules
  (lambda (except . rules)
    `(lambda x
       (let ((e ',except)
             (r #f))
         (set! r (try ,@(make-pat rules)))
         (if (fail? r)
             (exception "invalid syntax" '())
             r)))))

(define (make-pat rules)
  (map (lambda (x) `(subst ',(cadr x) 
                           (match ',(cdar x) x e))) rules))

変数衝突実験

SchemeのマクロとCommonLispのマクロとの対比のページを参考にして試してみた。 Simpleはまだ変数の置換をしていないので結果がおかしくなる。2012/06/16 01:25:37 UTC

参考:http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E3%83%9E%E3%82%AF%E3%83%AD%3ACommonLisp%E3%81%A8%E3%81%AE%E6%AF%94%E8%BC%83

(define-syntax arithmetic-if 
  (syntax-rules ()
    ((arithmetic-if test neg-form zero-form pos-form)
     (let ((var test))
       (cond ((< var 0) neg-form)
             ((= var 0) zero-form)
             (else      pos-form))))
    ((arithmetic-if test neg-form zero-form)
     (arithmetic-if test neg-form zero-form #f))
    ((arithmetic-if test neg-form)
     (arithmetic-if test neg-form #f #f))))

Simp> (let ((var 3)) (arithmetic-if -1 (list var)))
(-1)
Simp> 

else などの束縛されてないシンボル、自由変数について。今のところのアイディアはsyntax-rurlesに'(else) が与えられるのでそこにシンボルがなく、大域定義環境にもやはりシンボルがなければ置き換えるべき局所変数なのだろうと判断するつもりでいる。さて、うまくいくのかな。

gensym

健全マクロの実装準備としてgensymをGaucheを参考に実装していた。長らく誤解していたことがあった。手入力などで作られたシンボルとgensymが生成したシンボルとは印字名が同じであっても 異なるものとして扱われている。実際そうしないと健全にはならない。そこで識別子をデータにいれて通常のシンボルとgensymで生成されたシンボルとが同じにはならないようにした。2012/06/15 23:51:06 UTC

Simp> (eq? (gensym) '#:G1)
#f
Simp> (gensym)
#:G2
Simp> 

error処理

手抜きなエラーメッセージのため、ちょっと込み入った関数のデバッグではわけがわからなくなる。 そろそろちゃんとエラーメッセージを整理しよう。簡素にこんな感じかな。

  error in oo: XX is not ...

どれだけメッセージの類型を用意したらいいものやら、検討もつかない。2012/06/14 03:29:52 UTC

char-ready?

input_portから入力可能かどうかを調べる関数。こんな感じかと試してみた。

int     f_char_readyp(int lvar){
        int arg;
    
    arg = car(lvar);
    if(!nullp(arg) && GET_TAG(arg) != PRT)
        error(ILLEGAL_ARGUMENT, arg);
        
    if(isatty(fileno(input_port)))
        return(BOOLT);
    else
        return(BOOLF);
}

うまくいかない。2012/06/13 08:13:46 UTC

int     f_char_readyp(int lvar){
        int arg;
        char c;    

    arg = car(lvar);
    if(!nullp(arg) && GET_TAG(arg) != PRT)
        error(ILLEGAL_ARGUMENT, arg);
    
    c = getc(input_port);    
    if(c == EOF)
        return(BOOLF);
    else{
        ungetc(c,input_port);
        return(BOOLT);
    }
}

こうやってみた。

パターンマッチマクロ

中途半端にしていたマクロ。次の点で書き直し中。 省略子はシンボルを付け替える。(x y ...) => (x ?y) matchの失敗には#fではなく'failを返す。#fはmatchの結果かもしれない。2012/06/11 19:12:46 UTC

(define (omit->symbol x)
  (cond ((null? x) '())
        ((atom? x) x)
        ((and (list? x)(>= (length x) 2)(symbol? (car x)) (eq? (cadr x) '...))
         (list (string->symbol (string-append "?" (symbol->string (car x))))))
        (else (cons (omit->symbol (car x)) (omit->symbol (cdr x))))))


(define (match x y except)
    (match1 x y except '()))

(define (match1 x y except rel)
  (cond ((and (null? x) (not (null? y))) 'fail)
        ((and (not (null? x)) (null? y)) 'fail)
        ((null? x) rel)
        ((symbol? x) (cons (cons x y) rel))
        ((omit? (car x)) (cons (cons (car x) y) rel))
        (else (let ((r1 (match1 (car x) (car y) except rel))
                    (r2 (match1 (cdr x) (cdr y) except rel)))
                (if (or (eq? r1 'fail) (eq? r2 'fail))
                    'fail
                    (append r1 r2))))))


(define (omit? x)
  (and (symbol? x)
       (char=? #\? (string-ref (symbol->string x) 0))))

(define (atom? x)
  (not (pair? x)))

(define (fail? x)
  (eq? x 'fail))

(define-macro try
  (lambda args
    (if (null? args)
        'fail
        (if (null? (cdr args))
            (car args)
            `(let ((+value+ ,(car args)))
               (if (not (fail? +value+)) +value+ (try ,@(cdr args))))))))

(define (subst x lis)
  (cond ((fail? lis) 'fail)
        ((null? x) '())
        ((and (symbol? x) (assoc x lis)) (cdr (assoc x lis)))
        ((atom? x) x)
        ((omit? (car x))
         (append (cdr (assoc (car x) lis)) (subst (cdr x) lis)))
        (else (cons (subst (car x) lis)
                    (subst (cdr x) lis)))))

(define-macro syntax-rules
  (lambda (except . rules)
    `(lambda x
       (let ((e ',except))
         (try ,@(make-pat rules))))))

(define (make-pat rules)
  (map (lambda (x) `(subst ',(omit->symbol (cadr x)) 
                           (match ',(omit->symbol (cdar x)) x e))) rules))

なんとかこのあたりまでは動くようになった。ただし、変数衝突は考慮されていない。2012/06/12 08:57:30 UTC

例題コードの出典は紫藤さんのSchemeのページより。

(define-syntax nil!
  (syntax-rules ()
    ((_ x)
     (set! x '()))))

(define-syntax my-or 
  (syntax-rules ()
    ((_) #f)
    ((_ e) e)
    ((_ e1 e2 ...)
     (let ((t e1))
       (if t t (my-or e2 ...))))))

(define-syntax when
  (syntax-rules ()
    ((_ pred b1 ...)
     (if pred (begin b1 ...)))))


(define-syntax for
  (syntax-rules ()
    ((_ (i from to) b1 ...)
     (let loop((i from))
       (when (< i to  )
          b1 ...
          (loop (1+ i)))))))

Simp> (for (i 1 10) (display i))
123456789#<undef>
Simp> 

ダイレクトスレッデッドコード

VMの命令分岐につきダイレクトスレデッドコードに置き換えた。ld,ldcなどの命令シンボルは2n+3番地にある。このため分岐するアドレスを格納する配列にはダミーをいれてCスタックから取りだした命令番地からストレートにjumpするようにした。(tarai 12 6 0)で数秒の短縮。

思ったよりもスピードアップしていないのはGCCのバージョンによるものかもしれない。通常のswitchと同様なコードにコンパイルされるのだそう。

参考文献 http://jp.rubyist.net/magazine/?0008-YarvManiacs

2012/06/10 01:16:15 UTC

う~ん、おかしいなぁ。却って微妙に遅くなってる。アセンブラ出力をみるとdirect threaded codeになってるんだけどなぁ。

Simp> (time (tarai 12 6 0))
12
total 26.369000 second
gc    10.336000 second
Simp> 

マシンによって速くなる場合と逆に遅くなる場合があってよくわからない。2012/06/10 04:28:27 UTC

どうも私の古いマシンが壊れかけているのが問題なようだ。遅くはなっていない。

Simp> (time (tarai 12 6 0))
12
total 24.382000 second
gc    9.359000 second
Simp> 

古いマシンがあてにならないので試しに64bit、Win7マシンで動作確認。GCCで再コンパイルして 動作した。さすがに新しいマシンは速い。10秒を切ってる。

Simp> (time (tarai 12 6 0))
12
total 9.828000 second
gc    2.345000 second
Simp> 

メモリ節約

FUNATOさんの助言によりデータ構造の見直し。Schemeのobjectはcontinuation以外は2つ以内のデータで足りる。cons=2, rational=2, complex=2 ...そこで

struct cell {
        tag tag;
    flag flag;
        char *name;
        union{
        int             car;
        int             intnum;
                double  fltnum;
        int             numer;
        int     bind;
                int     ( *subr) ();
        FILE    *port;
    } car;
    union{
        int             cdr;
        double  fltnum;
        int             denom;
        int             env;
    } cdr;
};

のように共用体に押し込めた。かなりメモリの節約になったはず。

さらにこれに合わせてGCを書き直したらなんとスピードアップ。(tarai 12 6 0)が30秒台を切った。

Simp> (time (tarai 12 6 0))
12
total 24.493000 second
gc    8.908000 second
Simp> 

vector アイディアメモ

数学で遊ぶにはどうしてもベクタは不可欠。さて、どうやって実装したら? アイディアメモ。 セル領域の上位アドレスにベクトル領域を設ける。セルが500万個,ベクタは100万個くらいあればいいかな。

構造はセルと同じ。ベクタは連続領域を確保する。ベクタを表すセルの先頭セルにベクタの長さを記憶しておく。 real.intnの整数用のところが使える。

ガベージコレクタはベクタの領域も同様に使用中のものにはuフラグを立てる。 GCはベクタの領域だけは違う動作をさせる。前に詰めてコピーしていく方式。2012/06/05 23:26:17 UTC

データ構造。メモ:

ベクタは開始アドレスと長さのデータをもつ。それぞれreal.intn imag.intn に保持する。

#(1 2 #(3 4) 5)

addr 
5000001  VEC real.intn = 5000002 imag.intn = 4
5000002  INT 1
5000003  INT 2
5000004  VEC real.intn = 5000006 imag.intn = 2
5000005  INT 5
5000006  INT 3
5000007  INT 4

開始アドレスと長さはそれぞれcar、cdrにおいた。kent教授のコードがとてもヒントになった。

Simp> (define a #(1 2 #(3 4) 5))
a
Simp> a
#(1 2 #(3 4) 5)
Simp> (dump 5000000)
addr      car     cdr     env     tag    val
5000000 F 5000001 0000002 0000000 Vec    
5000001 F 0021707 0000000 0000000 Emp    
5000002 F 0021708 0000000 0000000 Emp    
5000003 F 5000004 0000004 0000000 Vec    
5000004 F 0021705 0000000 0000000 Emp    
5000005 F 0021706 0000000 0000000 Emp    
5000006 F 5000000 0000000 0000000 Emp    
5000007 F 0021712 0000000 0000000 Emp    
5000008 F 0000000 0000000 0000000 Emp    

VM,GCの高速化

小手先なのだけどコーディング上の無駄なところ、profile用のコードを普段は起動させないことなどを実施。さらにGCCのコンパイルオプションでO2で最適化した。O3だと動かなくなる。 この結果、竹内関数を30秒台にまでこぎつけた。ちなみにGaucheは約1秒。2012/06/02 04:21:40 UTC

Simp> (time (tarai 12 6 0))
12
total 34.626000 second
gc    14.750000 second
Simp> (exit)
- good bye. -

C:\MinGW\Simple>gosh -i
gosh -i
gosh> #t
gosh> (time (tarai 12 6 0))
;(time (tarai 12 6 0))
; real   1.092
; user   1.076
; sys    0.000
12
gosh>

gccの-O2最適化をするとマシンによってはload procedureがハングする。どうやらlongjmpは最適化によっておかしくなる場合があるらしい。replの大域脱出の方はlongjmpが効いているのでloadの方のEOFに達した場合の制御移動を普通にlongjmpに依らずに書き直した。32bitマシンなら普通に動くはず。64bitは対応したgccで再コンパイルしないとダメみたい。2012/06/03 01:21:12 UTC

ldg命令の高速化

以前、M.Hiroiさんに助言いただいたldg命令の高速化。そのアイディアも参考にしつつ次のアプローチを思いついた。def命令などでいったん大域変数に登録した後でclosureならばその本体コードを書きなおす方法。

(ldg ??? app)のパターンを探して???が既に大域に定義されてあればその実体に置き換える。さて、うまくいくかな。2012/05/31 23:36:06 UTC

こんな感じのコードをcで書き直す。

(define (replace-ldg-sym x y)
  (cond ((null? x) '())
        ((list? (car x)) (cons (replace-ldg-sym (car x) y) (replace-ldg-sym (cdr x) y)))
        ((ldg? x) (cons (car x) (cons y (cons (caddr x) (replace-ldg-sym (cdddr x) y)))))
        (else (cons (car x) (replace-ldg-sym (cdr x) y)))))



(define (ldg? x)
  (and (list? x) (> (length x) 3) (eq? (car x) 'ldg) (symbol? (cadr x)) (or (eq? (caddr x) 'app) (eq? (caddr x) 'tapp))))

改良した結果、竹内関数は次のようにコンパイルされるようになった。

Simp> (vmcode tarai)
(ld (0 . 0) ld (0 . 1) args 2 ldg #<subr <=> app selr (ld (0 . 1) rtn) 
(ld (0 . 0) args 1 ldg #<closure 1-> app ld (0 . 1) ld (0 . 2) args 3 ldg #<closure tarai> app ld (0 . 1) args 1 ldg #<closure 1-> app ld (0 . 2) ld 
(0 . 0) args 3 ldg #<closure tarai> app ld (0 . 2) args 1 ldg #<closure 1-> 
app ld (0 . 0) ld (0 . 1) args 3 ldg #<closure tarai> app args 3 ldg #<closure tarai> tapp rtn))
Simp> 

速度はあまり改善が見られなかった。

Simp> (time (tarai 12 6 0))
12
total 94.075000 second
gc    19.499000 second

ldg命令は性能改善している。GCに問題があるのかもしれない。

opcode       count    total time(sec)
ld        72477948    13.876000000000
ldc        9453648    1.011000000000
ldg       44117012    7.011000000000
ldf              0    0.000000000000
ldct             0    0.000000000000
def              0    0.000000000000
lset             0    0.000000000000
gset             0    0.000000000000
args      44117012    11.162000000000
app       31512152    9.242000000000
tapp      12604860    3.527000000000
args_ap          0    0.000000000000
rtn       18907291    3.612000000000
sel              0    0.000000000000
selr      12604861    1.689000000000
join             0    0.000000000000
pop              0    0.000000000000
push             0    0.000000000000
12
Simp> 

原因判明。(1- x)をclosureで定義していてそのオーバーヘッドだった。(- x 1)に書きかえると

Simp> (time (tarai 12 6 0))
12
total 72.428000 second
gc    14.010000 second
Simp> 

性能は改善していた。

さらにM.Hiroiさんのところで紹介されていた遅延評価のコードだと

(define (tarai3 x y z)
  (if (<= x y)
      y
    (tarai-lazy (tarai3 (- x 1) y z) (tarai3 (- y 1) z x) (- z 1) x y)))

(define (tarai-lazy x y xx yy zz)
  (if (<= x y)
      y
    (let ((z (tarai3 xx yy zz)))
      (tarai-lazy (tarai3 (- x 1) y z) (tarai3 (- y 1) z x) (- z 1) x y))))

Simp> (time (tarai3 12 6 0))
12
total 0.000000 second
gc    0.000000 second
Simp> 

遅延を使えば速くなるのは知っていたが、上記のコードの書き方に感心してしまった。2012/06/01 23:53:02 UTC

SimpleはGaucheの30倍は遅いのだけどその方がアルゴリズムの工夫を要し、ダメなアルゴリズムのダメさがはっきりわかるのでいいかもしれない。自分のための教育用なんだし(笑)。

Simp> (prof (tarai3 200 100 0))

opcode       count    total time(sec)
ld          170003    0.000000000000
ldc          30003    0.000000000000
ldg          90002    0.031000000000
ldf              0    0.000000000000
ldct             0    0.000000000000
def              0    0.000000000000
lset             0    0.000000000000
gset             0    0.000000000000
args         90002    0.063000000000
app          80002    0.000000000000
tapp         10000    0.000000000000
args_ap          0    0.000000000000
rtn          20001    0.000000000000
sel              0    0.000000000000
selr         30001    0.015000000000
join             0    0.000000000000
pop              0    0.000000000000
push             0    0.000000000000
200
Simp> 

内部定義

内部定義のdefineをletrecに変換するものに取り組んでいる。Cで書く前にGaucheで書いてテスト。たぶんまだバグってる。完全動作するようになったらCに書き直してread()の結果を変換して マクロのquasi-quoteを変換してコンパイラに渡す。こんなややこしいものを最初からCで書くなんて私にはできない。2012/05/26 20:47:21 UTC

(define (top-level x)
  (if (define? x)
      (let ((e (formal-define x)))
        (list (car e) (cadr e) (trans (caddr e))))
      (trans x)))

(define (trans x)
  (cond ((eq? (car x) 'lambda) (cons (car x) (cons (cadr x) (inner (cddr x)))))
        ((eq? (car x) 'let)    (cons (car x) (cons (cadr x) (inner (cddr x)))))
        ((eq? (car x) 'letrec) (cons (car x) (cons (cadr x) (inner (cddr x)))))
        ((eq? (car x) 'let*)   (cons (car x) (cons (cadr x) (inner (cddr x)))))
        ((eq? (car x) 'begin)  (cons (car x) (inner (cdr x))))
        (else x)))

;;定義部と本体を分離してletrecに変換する。
(define (inner x)
  (let ((e (separate x)))
    (if (null? (car e))
        (cdr e)
        (list (cons 'letrec (cons (reverse (car e)) (cdr e)))))))

;;定義部と本体に分離。
(define (separate x)
  (separate1 x '()))

(define (separate1 x def)
  (if (define? (car x))
      (let ((e (formal-define (car x)))) 
        (separate1 (cdr x)
                   (cons (list (cadr e) (trans (caddr e))) def)))
      (cons def x)))

;;定義文か?
(define (define? x)
  (and (list? x) (eq? (car x) 'define)))

;;mitスタイルならlambdaへ変換。
(define (formal-define x)
  (if (symbol? (cadr x))
      x
      (list (car x) (caadr x) (cons 'lambda (cons (cdadr x) (cddr x))))))


(define test1 '(define foo (lambda (x) x)))
(define test2 '(define (foo x) (+ x x)))
(define test3 '(define foo (lambda (x) (define x 1) x)))
(define test4 '(lambda (x) (define x 1) x))
(define test5 '(define foo (lambda (x) (define (boo x) (+ x x)) x)))

gosh> (top-level test1)
(define foo (lambda (x) x))
gosh> (top-level test2)
(define foo (lambda (x) (+ x x)))
gosh> (top-level test3)
(define foo (lambda (x) (letrec ((x 1)) x)))
gosh> (top-level test4)
(lambda (x) (letrec ((x 1)) x))
gosh> (top-level test5)
(define foo (lambda (x) (letrec ((boo (lambda (x) (+ x x)))) x)))
gosh> 

上記をCに書き直して動き出した。2012/05/27 10:16:13 UTC

//-------internal define--------------
//internl-defineをletrecに置き換える。
               
int define_to_letrec(int lis){
        int e;
    
    if(definep(lis)){
        e = formal_define(lis);
        return(list3(car(e),cadr(e),replace(caddr(e))));
    }
    else
        return(replace(lis));
    
}

int definep(x){
        if(listp(x) && eqp(car(x),define))
        return(1);
    else
        return(0);
}

int replace(int lis){
        int e;
    
        if(listp(lis) && 
      (eqp(car(lis),lambda) || eqp(car(lis),let) || eqp(car(lis),letrec) || eqp(car(lis),letstar)))
        return(cons(car(lis),cons(cadr(lis),replace1(cddr(lis)))));
    else
    if(listp(lis) && eqp(car(lis),begin)){
        e = car(replace1(cdr(lis)));
        return(cons(car(e),cons(cadr(e),list1(cons(begin,cddr(e))))));
    }
    else
        return(lis);
        
}

int replace1(int lis){
        int e;
    
    e = replace2(lis);
    if(nullp(car(e)))
        return(cdr(e));
    else
        return(list1(cons(letrec,cons(reverse(car(e)),cdr(e)))));
}

int replace2(int lis){
        return(replace3(lis,NIL));
}

int replace3(int lis, int def){
        int e;
    
    if(definep(car(lis))){
        e = formal_define(car(lis));
        return(replace3(cdr(lis),cons(list2(cadr(e),replace(caddr(e))),def)));
    }
    else
        return(cons(def,lis));
        
}

int formal_define(int lis){
        if(symbolp(cadr(lis)))
        return(lis);
    else
        return(list3(car(lis),caadr(lis),cons(lambda,cons(cdadr(lis),cddr(lis)))));
}


call/cc 修正

下記によりcall/ccをクロージャとして生成、dynamic-windは機能したものの、これでは多値が機能しないことに気がついた。そこでvaluesで呼び出しているcall/ccはCで書かれているコアの方の simp-call/ccに置き換えた。そしてクロージャになっているcall/ccはsimp-call/ccにapplyで送ることにした。2012/05/25 22:19:02 UTC

;;多値
;;R5RSの定義と同じ。
(define (values . things)
  (simp-call/cc
    (lambda (cont)
      (apply cont things))))


(define (call/cc f)
  (simp-call/cc
    (lambda (k)
      (f (let ((save ***winders***))
           (lambda x
             (if (not (eq? save ***winders***)) (***do-wind*** save))
                 (apply k x)))))))

(define call-with-current-continuation call/cc)


dynamic-wind 正常動作 今までのまとめ

ようやく正常動作するようになった。

;;Shiroさんからの例題
Simp> ABCDEFGHIJKBCDEFL#t
Simp> 

;;R5RSにある例題
(connect talk1 disconnect connect talk2 disconnect)
Simp> 

C言語で記述しようとすると継続が断絶してしまいうまく書けなかった。Schemeレベルなら継続の記述は簡単だ。Moshなどはdynamic-windを Schemeで記述しているとの情報がありKent教授の本を参考にSchemeで書いてみた。コードはSimpleの起動時に読み込まれるsimpmacs.scmに収録されている。Simpleで動くように素朴でわかりやすいコードに書き換えている。

問題は継続の動作。Schemeレベルでの継続を使えば継続起動後の動作は簡単なのだけど、継続起動前に現状のWinderと継続生成時のWinderの差異補正をする部分をcall/ccに組み込まないといけない。そんなことができるのか?

Kent教授の書きかえられたcall/ccを参考に次のように定義した。

(define call/cc
  (lambda (f)
    (simp-call/cc
      (lambda (k)
        (f (let ((save ***winders***))
             (lambda (x)
               (***do-wind*** save) ;;ここ
               (k x))))))))

(define call-with-current-continuation call/cc)

「ここ」にはKent教授の書いているとおり(if (not (eq? save ***winders**)...)があった方が効率がよかった。抜けていた。

dynamic-windは通信手順などを記述するためものなのだろう。リーマン面のような印象を受けた。 複素平面の2PI違いの複素平面に戻るためにぐるりと一回りして戻る。日常生活のようなものかもしれない。

A: 起きる。 B:朝食をとる。 C: 電車に乗り、会社に行く。 D:仕事をする。 E: 電車に乗り、自宅に帰る。 F: 夕食をとる。 G: 寝る。

今が電車に乗って自宅に帰るところで、継続を使って昨日の仕事をしていたタイミングに戻るには 帰って夕食をとり寝て、そして昨日に戻った私は起きて朝食をとって電車に乗って会社に行かないといけない。2012/05/24 21:29:43 UTC

dynamic-wind 改良

dynamic-windで継続が断たれてしまうのが問題だった。それもWinderと同様に保存しておけばいい。継続生成のldct命令はその保存がある場合には通常のCスタックにappendして保存しておく。2012/05/23 23:43:29 UTC

int f_dynamic_wind(int lvar){
        int before,body,after,save,l1,l2,l3,res;
    
    before = car(lvar);
    body = cadr(lvar);
    after = caddr(lvar);
    
    save = C;   ここに残りの命令列があるのでこれを保存しておく。
    push('W',cons(before,after));
    
    l1 = list6(vpush,NIL,vpush,before,app,vpop);
    l2 = list5(vpush,NIL,vpush,body,app);
    l3 = list7(vpush,NIL,vpush,after,app,vpop,stop);
        C = append(l1,append(l2,l3));
    
    res = vm();
    pop('S');
    pop('W');
    C = save;
    return(res);
}


どうにも正常動作しない場合がある。しばらくこの実装は先送り。そのうちに考えがまとまるかもしれない。人生、時には達観も必要か。2012/05/24 09:45:21 UTC

dynamic-wind 書き直し

Shiroさんに助言をもらって、ハッと気がついた。そんなにややこしいコードになるはずがない。書きなおした。

簡単なものなら動くものの、込み入ったものになると動かない。2012/05/23 12:24:07 UTC

継続は生成時にそれ以降のコードを保存しておかないといけない。しかし、下のやりかただとdynamic-wind subrが呼び出される都度それらをつなぎ合わせて命令を実行してstopしている。 これだと途切れてしまっていてネストの深いところで生成された継続はその後の全部のコードを保存できていない。

ネストの深くない例なら動く。

call/cc同様にsubrではない方法でコンパイルする必要があるように思う。その場合にWinderのスタックを操作する命令が必要になると思う。

とにかく難しい。

int f_dynamic_wind(int lvar){
        int before,body,after,save,l1,l2,l3,res;
    
    before = car(lvar);
    body = cadr(lvar);
    after = caddr(lvar);
    
        save = C;
    push('W',cons(before,after));
    
    l1 = list6(vpush,NIL,vpush,before,app,vpop);
    l2 = list5(vpush,NIL,vpush,body,app);
    l3 = list7(vpush,NIL,vpush,after,app,vpop,stop);
        C = append(l1,append(l2,l3));
    
    res = vm();
    pop('S');
    pop('W');
    C = save;
    return(res);
}

 if(continuationp(clo)){                
        //dynamic-wind
        save = GET_DENOM(clo); 継続生成時のWinderを保存してある。
        if(!eqp(save,W))
            do_wind(save);  現状のwinderと保存されていたwinderが違う場合には補正


補助関数
//------for dynamic-wind--
//kent dyvig 「プログラミング言語Scheme」p93参照
int common_tail(int x, int y){
        int lx,ly;
    
    lx = length(x);
    ly = length(y);
    if(lx > ly)
        x = listtail(x,lx-ly);
    if(ly > lx)
        y = listtail(y,ly-lx);
    
    while(!eqp(x,y)){
        x = cdr(x);
        y = cdr(y);
    }
    return(x);
}

void do_wind(int new){
        int tail,l,clo,save,before;
    
    save = C;
    tail = common_tail(new,W);
    
  //afterの実行
    l = W;
    while(!eqp(l,tail)){
        clo = cdar(l);
        C = list6(ldc,NIL,vpush,clo,app,stop);
        vm();
        pop('S');
        l = cdr(l);   
    }
    //beforeの実行 afterとは逆に外側から実行される。
    before = NIL;
    l = new;
    while(!eqp(l,tail)){
        before = cons(car(l),before);
        l = cdr(l);
    }
    
    while(!nullp(before)){
        clo = caar(before);
        C = list6(ldc,NIL,vpush,clo,app,stop);
        vm();
        pop('S');
        before = cdr(before);
    }
    W = new;
}
                

dynamic-wind デバッグ

あれこれと間違えているようだ。単純なところでは返す値を間違えてる。

(dynamic-wind
  (lambda () 1)
  (lambda () 2)
  (lambda () 3))

Simp> 3
gosh> 2
gosh> 

Shiroさんから示された例コードは途中でループにつかまっている。

op: selr
C: ((ldc #f args 1 ld (3 . 0) tapp rtn) stop) 
S: (#f #<undef> #<undef> 1) 
>

この後でstop命令が効いてない。継続の仮想命令コードの末尾をstopに強引に書き換えてるのが問題なようだ。

そして、ループに落ちる直前の実行状況をみると。

ABCDEFGHIJKCD^C

で、Bが飛んでいる。動的期間の考えがまだ正確につかめていない。

higeponさんのやさしい例題でテスト。

(dynamic-wind
  (lambda () (display "a"))
  (lambda () (display "b"))
  (lambda () (display "c")))

(define cont '())

(begin
  (display "1")
  (display (call/cc (lambda (c) (set! cont c) "2")))
  (display "3"))

(dynamic-wind
  (lambda () (display "a"))
  (lambda () (display "b") (cont "2 again"))
  (lambda () (display "c")))

(cont "2 again")

(dynamic-wind
  (lambda () (display "a"))
  (lambda ()
    (display "1")
    (display (call/cc (lambda (c) (set! cont c) "2")))
    (display "3"))
  (lambda () (display "c")))

(cont "2 again")


Simp> abc123abc2 again32 again3a123ca2 again3c#t
gosh> abc123abc2 again32 again3a123ca2 again3c#t

まずはこのコードから検討を進めよう。少しずつ複雑なものへトライ。そして理解を深める。

なんとかここまでは動くようになった。 app,tapp命令を4つに分岐させた。○動的期間外から動的期間外で生成された継続を実行する。○動的期間外で動的期間内で生成された継続を実行する。○動的期間内で動的期間外に生成された継続を実行する。○動的期間内で動的期間内に生成された継続を実行する。

ネストが深くなった場合にはbefore/afterの対応関係をスタックを遡って調べないといけないようだ。

R5RSにあった例は異常動作している。

(let ((path '())
      (c #f))
  (let ((add (lambda (s)
               (set! path (cons s path)))))
    (dynamic-wind
      (lambda () (add 'connect))
      (lambda ()
        (add (call/cc
               (lambda (c0)
                 (set! c c0)
                 'talk1))))
      (lambda () (add 'disconnect)))
    (if (< (length path) 4)
        (c 'talk2)
        (reverse path))))

Simp> (talk2 connect disconnect talk1 connect)
gosh> (connect talk1 disconnect connect talk2 disconnect)

継続実行が終了した後の制御の移動ができていない。reverseが実行されずデータも取りこぼしている。

2012/05/22 22:59:32 UTC

stepper

vmの動作を追いかけてデバッグするのにstepperを入れた。FLEX6809のデバッガを思い出した。 2012/05/20 23:39:40 UTC

educational Scheme compiler Simple Ver0.17.6 (written by sasagawa888)
Simp> (step (+ 1 2))
op: ldc
C:  (1 ldc 2 args 2 ldg #<subr +> app stop)
S:  ()
op: ldc
C:  (2 args 2 ldg #<subr +> app stop)
S:  (1)
op: args
C:  (2 ldg #<subr +> app stop)
S:  (2 1)
op: ldg
C:  (#<subr +> app stop)
S:  ((1 2))
op: app
C:  (stop)
S:  (#<subr +> (1 2))
op: stop
C:  ()
S:  (3)
3
Simp> 

dynamic-wind 整理

まずまず近い動作にはなった。

(define cc '())

(dynamic-wind 
  (lambda () (display "A"))
  (lambda () (call/cc (lambda (c) (set! cc c))) (display "B"))
  (lambda () (display "C")))


(dynamic-wind
  (lambda () (display "D"))
  (lambda () (dynamic-wind
    (lambda () (display "E"))
    (lambda () (display "F")(cc))
    (lambda () (display "G"))))
  (lambda () (display "H")))

Simp> ABCDEFGHABCGH#t
Simp>

gosh> ABCDEFGHABC#t
gosh> 

ccの起動のあとで制御を戻さないためstop命令に置き換えているもののなぜかbody-closureの実行の後でG,Hが実行されてしまう。デバッグのためにvmにステッパを入れることにした。そしてプロファイラ用にvmを2系統もっていたのだけどこれを1本化する。vmの動作が完全になったところで計測機能を取り外した実行専用のvmを切り出す。

Schemeはコンパイラ向きだ。インタプリタで継続の複雑な動作を実現することは私には困難。2012/05/20 00:27:28 UTC

やっとできた。

Simp> ABCDEFGHABC#t
Simp> 

lambdaの暗黙のprogと同じことだった。dynamic-windは次のコードを生成すればよかった。

(push before app pop push body app pop push after app stop) 

そして動的期間に生成された継続オブジェクトはbeforeをもっていればよかった。 afterは本来の継続の機能がコードに含めている。

やっと解決。

dynamic-wind

動作を完璧に誤解していた。PAIP-Schemeの拡張でdynamic-windを実装したときにはわかったつもりだったけれど、たぶんあれも間違ってる。

動的期間であることを知るには以前検討したAスタックを使った方法が使える。(cons before after)をAスタックに積んでおく。スタックにデータがある限りは動的期間内にある。

動的期間内で継続が起動する場合にはまずスタックからafterをpopしてこれを実行してから継続を実行する。継続は動的期間内なら普通に動作させる。

動的期間外から継続が起動する場合には生成された時のbefore,afterがわからないといけない。 ldct命令で継続を生成するときに動的期間内ならばスタックのbefore,afterを生成する継続のどこかに保存しておく。継続セルのどこかに空きを探す。

APP,TAPP命令は継続を起動するときに動作が分かれる。

動的期間外から起動されていて(つまりAスタックがnil)継続がbefore/afterの束縛を持ってなければ通常の継続起動。

動的期間外から起動されていて継続がbefore/afterの束縛をもっていればbefore,cont,afterの順番で実行する。

動的期間内から継続が起動された場合にはAレジスタからafterをpopして実行。継続の動作に移る。

動的期間内で生成された継続を動的期間中に起動したときはどうなるのだろう?

Gaucheでさまざまな例を試して動作を確認しよう。

2012/05/19 12:34:34 UTC

下記の例、ABCDEFGABCHだと思っていた。Gauche及びPetite Chezで確認したところ下記のようになる。う~む、わからない。

(define cc '())

(dynamic-wind 
  (lambda () (display "A"))
  (lambda () (call/cc (lambda (c) (set! cc c))) (display "B"))
  (lambda () (display "C")))

(dynamic-wind
  (lambda () (display "D"))
  (dynamic-wind
    (lambda () (display "E"))
    (lambda () (display "F")(cc))
    (lambda () (display "G")))
  (lambda () (display "H")))

gosh> ABCEFGABC#t

わかった、こう書くべきだった。

(define cc '())

(dynamic-wind 
  (lambda () (display "A"))
  (lambda () (call/cc (lambda (c) (set! cc c))) (display "B"))
  (lambda () (display "C")))

(dynamic-wind
  (lambda () (display "D"))
  (lambda () (dynamic-wind
    (lambda () (display "E"))
    (lambda () (display "F")(cc))
    (lambda () (display "G"))))
  (lambda () (display "H")))

gosh> ABCDEFGHABC#t
gosh> 

Hが実行されてからCCが起動している。ということは動的期間内で継続を起動する場合にはスタックに積んだafterを全部実行してからCCの起動ということになる。

やはりAスタックにはbeforeのデータは要らないように思える。beforeは継続オブジェクトに持たせるからスタックには要らないように思える。ちがう、必要だ。ldct命令でbefore/afterを取得しないといけないからセットで積まないといけない。

セルの虚数部のintegerが空いてる。ここを(cons before after)の保存場所にする。

一時中断

本業が忙しいので一時中断。やるべきことのメモ。(継続)

分数にbignumを実装。 分数をdoubleに変換するのをどうするか?分子分母が巨大素数だった場合に計算困難。

(expt m n)の正確数計算。

健全マクロ。パターンマッチングが不完全。省略子が途中に入るとエラー。 変数の付け替え、衝突防止。

GC 世代別GCの勉強、gcのスピードアップ。

内部defineのletrecへの変換。 Schemeで書いてcに変換。readの直後で変換をかける。

入出力手続きの実装。

文字列の残り手続きの実装。

VMのスピードアップ。LDG命令の高速化。

subrの引数個数の一致をコンパイル段階でチェック。subrに引数のデータをもたせる。

educational Scheme compiler Simple Ver0.17.4 (written by sasagawa888)
Simp> (call/cc (lambda (c) (set! cc c) 本業... (c メモ)))

アイディアメモ:

dynamic-wind アイディア

afterへの継続を専用のスタックにpushしておく。 継続は起動したらそのスタックが空なら通常の動作。 スタックにafter継続があれば、継続を実行したあとでafterを起動。

int f_dynamic-wind(int before, int body ,int after){
        afterを継続にしてpushする仮想コードを作って実行。
    (before)
    (call/cc
        (lambda (c) (c body)))
    (after)
}

app,tapp命令

スタックにafter継続があるか? ないー> 通常の継続起動。 あるー> 通常の継続を起動、終了後にafter継続を起動。

思いついたので忘れないうちにメモ。

afterは専用のAスタックを設けてそこにafterへの継続をpushしておく。

int f_dynamic_wind(int lvar){
        int before,body,after,save;
    
    before = car(lvar);
    body = cadr(lvar);
    after = caddr(lvar);
    
    save = C;
    //before実行
    C = list4(vpush,before,app,stop);
    vm();
    //after継続生成
    C = list2(ldct,list4(vpush,after,app,stop));
    vm();
    push('A' , pop('S'));
    //body実行
    C = list4(vpush,body,app,stop);
    vm();
    //継続に制御が移動しなかった場合。
    C = list3(vpush,after,stop);
    vm();
    pop('A');
    C = save;
    return(undef);
}

//継続起動部分 app命令
if(continuationp(clo)){
        //動的期間でなければ通常の継続起動
        if(nullp(A))
        C = GET_BIND(clo);
        //動的期間であればafter継続を実行しようとする継続の最後に挿入して継続実行
        else{
          after = pop('A');
           body_cc = GET_BIND(clo);
            C = append(butlast(body_cc,append(list3(vpush,after,app),last(body_cc))));
        }
      

beforeはbodyで継続が起動したときに再度実行されないといけないことがわかった。 書き直し。bodyのスコープの外での継続ならこれでよさそうな気がする。bodyのスコープ内で 継続起動だとおかしいかもしれない。

int f_dynamic_wind(int lvar){
        int before,body,after,save;
    
    before = car(lvar);
    body = cadr(lvar);
    after = caddr(lvar);
    
    save = C;
    push('A',cons(before,after));
    
    //before実行
    C = list4(vpush,before,app,stop);
    vm();
    //body実行
    C = list4(vpush,body,app,stop);
    vm();
    //継続に制御が移動しなかった場合。
    C = list4(vpush,after,app,stop);
    vm();
    pop('A');
    C = save;
    return(undef);
}

//継続起動部分 app命令
if(continuationp(clo)){
        //動的期間でなければ通常の継続起動
        if(nullp(A))
        C = GET_BIND(clo);
        //動的期間であればafter継続を実行しようとする継続の最後に挿入して継続実行
        else{
                ab = pop('A');
            before = car(ab);
            after = cdr(ab);
                body_cc = GET_BIND(clo);
            C = cons(before,append(butlast(body_cc,append(list3(vpush,after,app),last(body_cc)))));
        }
      


これのときにおかしいはず。でも、こんな使い方は意味がないので無視してもいいかなぁ。

(dynamic-wind
  (lambda () (display "before\n"))
  (lambda () (call/cc (lambda (c) (display "body\n") (c))))
  (lambda () (display "after\n")))

多倍長演算、二乗

とても単純な二乗の計算がハングすることがわかった。なぜ? bigunumの二乗の計算(* 1234567890 1234567890) のような時だけ現象がおきる。 謎?2012/05/15 08:51:33 UTC

なんのことはない、乗算のミス。被乗数の方が大きい方が効率がいいので引数を比較して場合によると順番を入れ替えるところでミスしてた。この結果、(expt m n)正常動作。

Simp> (expt 1234567889 8)
5396594849512231404283063467994501047465381569764897125090634027003351681
Simp> 

Dアルゴリズム デバッグ

被除数と除数が近いと何か問題をおこしているらしい。2012/05/14 10:55:26 UTC

Simp> (quotient 1231871231 1226869290)
10040769931004076992
Simp> 

q = min(u1+u2b/v1, b-1) のminを落としてた。でも、まだおかしい。

考察: 基数を10^9にしている。考えやすいように基数を10とする。 11/10なら、定理にあてはめるため、10/(1+1) = 5 を分子分母にかけて 55/50の計算に置き換える。q = 55/5 = 11 > (10-1) なので q=9 9を分母にかけて450。ここを考え違いしているよう。

基数を10^9にしたときにq=999,999,999になる場合があってこれが問題らしい。

逃げの解決策として近接している場合には被除数が除数の2倍より小さいなら1とするという例外 をつくることを検討。ほんとはちゃんと数学的に定理を考察しなおすべきなんだろうけれど。 2012/05/14 23:58:14 UTC

うまく行かない例。

(quotient 1231871231123 1226869290123)

被除数が除数の2倍より小さい場合には1を返すように変更。 おそらく私がクヌース先生のアルゴリズム、定理の成り立つ前提を見落としている。 時間があるときにちゃんと証明したい。2012/05/15 03:17:20 UTC

educational Scheme compiler Simple Ver0.17.3 (written by sasagawa888)
Simp> (quotient 1231871231123 1226869290123)
1
Simp> (exit)
- good bye. -

C:\MinGW\Simple>gosh -i
gosh -i
gosh> (quotient 1231871231123 1226869290123)
1
gosh> 

この結果、やっとbignumでのgcd計算にめどが立った。

Simp> (gcd 128371928379 237192837192739827)
3
Simp> (exit)
- good bye. -

C:\MinGW\Simple>gosh -i
gosh -i
gosh> (gcd 128371928379 237192837192739827)
3
gosh> 

数値関数

嫌になるくらいバグってた。sqrt(1/4)=1/2 だとかmodulo(-13,4) = 3 だとか。 テストを書いてひとつひとつ潰していく予定。angleも間違ってるなぁ。2012/05/12 04:19:34 UTC

できるだけ正確な数に変換すべきだとは思うのだけど、どう判断したらいいものだろう。 微小数を勝手に0にしてしまうのはまずいしなぁ。2012/05/12 21:08:37 UTC

Simp> (cos (acos 0))
6.1230317691e-017
Simp> (make-polar 1 (asin -1))
6.1230317691e-017-1i
Simp> 

あれ?な~んだ。できるだけ正確数と解説しているKent教授もChezでは非正確なままにしてる。 これでいいみたい。

> (make-polar 1 (asin -1))
6.123233995736766e-17-1.0i
> (cos (acos 0))
6.123233995736766e-17
> 

bignumの平方根につき手抜きをしていた。Gaucheはちゃんと計算している。

gosh> (exact? (sqrt (expt 111111111111111111111111111111111111111111111111111111 2)))
#t
gosh> 

ニュートン法だろうか? 答えが正確数になるのかどうかをどう判定しているのか。 Schemeで書いて確かめてからCでかきなおそう。開平法を検討。

多値

制御構造のvalues、call-with-valuesを考えてみた。R5RSの定義の沿って次のように書いてみた。

;;R5RSの定義と同じ。
(define (values . things)
  (call/cc
    (lambda (cont)
      (apply cont things))))

(define (call-with-values producer consumer)
  (consumer (producer '())))

Simp> (call-with-values (lambda () (values 4 5)) (lambda (a b) b))
#f
Simp> (call-with-values (lambda () (values 4 5)) (lambda (a b) a))
4
Simp> 

ひとつだけなら継続を介して受け取ることができているが、2つ目は取りこぼしている。 継続contが持っているのはrtn仮想命令でこれが問題なような気がする。2012/05/10 12:23:53 UTC

よくよく調べてみると継続は1引数ではなく多引数を受け取ることがわかった。

(define cc '())

;;R5RSの定義と同じ。
(define (values . things)
  (call/cc
    (lambda (cont)
      (set! cc cont)
      (apply cc things))))

gosh> (cc 1 2 3 4 5)
1
2
3
4
5
gosh> 

アイディアメモ:

多値型を作るtagはmul

#mul(1,2,3)

継続はそれらについて各々継続を実行して多値型にして
スタックに積む

S = push((map cont mul#(mul)),S);

受け取る側:

producer を実行する。

C = (push producer app atop)
S = vm();

多値をリストに変換してSスタックにpush
S = push(mul->lis(pop(S)),S)

consumerを実行する。

C = cons((push consumer app),C)
res = vm();

return(res);


上記のアイディアに基づいてvmの命令のうちapp,tappを書き加えた。継続に1引数が与えられた場合は従来通り。そうでなく複数の場合には多値型を生成する。valuesはR5RSの定義そのまま。 valuesはマクロと同じく起動時に読み込むファイルに挿入した。

if(code == app){
                clo = pop('S');
            lvar = pop('S');
            if(subrp(clo))
                push('S',((GET_SUBR(clo))(lvar)));
            if(closurep(clo)){
                push('D',cons(S,(cons(E,cons(C,NIL)))));
                S = NIL;
                E = cons(lvar,GET_ENV(clo));
                C = GET_BIND(clo);
            }
            if(continuationp(clo)){
                //引数1個の場合
                if(length(lvar) == 1){
                        S = cons(car(lvar),car(clo)); //carにSが保存されている。以下同様。
                        E = GET_ENV(clo);
                        C = GET_BIND(clo);
                        D = cdr(clo);
                }
                //引数が多数の場合,個々に継続を実行し結果を多値型にしてスタックに積み継続実行。
                else{
                        arg = NIL;
                    while(!nullp(lvar)){
                        S = cons(car(lvar),car(clo));
                                E = GET_ENV(clo);
                                C = GET_BIND(clo);
                                D = cdr(clo);
                        n = vm();
                        arg = cons(n,arg);
                        lvar = cdr(lvar);
                    }
                    arg = reverse2(arg);
                    SET_TAG(arg,MUL);
                    S = cons(arg,car(clo));
                        E = GET_ENV(clo);
                        C = GET_BIND(clo);
                        D = cdr(clo);
                }
            }
                goto loop;  
        }

call-with-valuesはsubrとして実装した。

int f_call_with_values(lvar){
        int save,producer,consumer,res;
    
    producer = car(lvar);
    consumer = cadr(lvar);
    
        save = C;
    C = list6(vpush,NIL,vpush,producer,app,stop);
    res = vm();
    SET_TAG(res,LIS);
    C = list6(vpush,res,vpush,consumer,app,stop);
    res = vm();
    C = save;
    return(res);
}

実行結果。

Simp> (call-with-values (lambda () (values 4 5)) (lambda (a b) b))
5
Simp> 

単純な例しか試していないので、動かない場合があるかもしれない。2012/05/11 09:43:00 UTC

引数0の継続。引数が0でapp,tapp命令が呼び出された場合には引数なしで継続を呼び出すようにした。その場合、返り値がなくstop命令は'()を返してしまう。これについてはじっくり検討する。 とりあえずは引数なしで(values)を評価しても落ちなくはなった。R5RSには引数0の場合は規定されてないようだけれど、実際問題引数なしで継続を起動することはあり得る。2012/05/11 23:54:42 UTC

テスト

どうも動作がアヤシイ関数があるんでGaucheに倣って(test* name expected expr)を組み込んだ。2012/05/09 08:58:54 UTC

Simp> test (fact-letrec 10), expects 3628800 ==> ok
test (fact-let 10), expects 3628800 ==> ok
test (equal? 'a 'b), expects #f ==> ok
test (equal? 'a 'a), expects #t ==> ok
test (equal? '(1 2) '(1 2)), expects #t ==> ok
test (equal? '(1) '(1 2)), expects #f ==> ok
test (complex? 3+4i), expects #t ==> ok
test (complex? 3), expects #t ==> ok
test (real? 3), expects #t ==> ok
test (real? -2.5+0.0i), expects #t ==> ok
test (ratinal? 6/10), expects #t ==> ok
test (exact? 1), expects #t ==> ok
test (exact? 1234567890), expects #t ==> ok
#t
Simp> 

R5RSの例でテストしていてみつけたもの。教えてもらってやっと意味がわかった。 継続ってのはprocedureなんですね。

Simp> (call/cc procedure?)
#t
Simp> 

define-syntax

健全マクロの実装に取り組んでいる。syntax-rurlesが生成するものはlambdaと考えてもいいかもしれないというアイディア。パターンの最初の変数を無視していいなら伝統的マクロと同じ仕組みにできそうな。2012/05/06 23:46:37 UTC

;;入れ子になったパターンだとうまくいかないはず。
(define (match x y except)
  (cond ((and (pair? x)(pair? y)(not (= (length x)(length y)))) #f)
        ((null? x) '())
        ((and (pair? x)(eq? (car x) '...)) (cons (car x) y))
        ((and (member x except)(not (eq? x y))) #f)
        ((symbol? x) (cons x y))
        ((and (pair? x) (not (pair? y))) #f)
        (else (let ((r (match (car x) (car y) except)))
                (if r
                    (cons r (match (cdr x) (cdr y) except))
                    #f)))))

(define (subst x lis)
  (cond ((not lis) #f)
        ((null? x) '())
        ((and (symbol? x) (assoc x lis)) (cdr (assoc x lis)))
        ((symbol? x) x)
        (else (cons (subst (car x) lis)
                    (subst (cdr x) lis)))))




(define foo
  (lambda (x)
    (let ((except '()))
      (or (subst '(set! z '()) (match '(_ z) x except))))))



まだちゃんと動かないけれど、こんなことを考えている。

(define-macro syntax-rules
  (lambda (except . rules)
    `(lambda x
       (let ((e ,except))
         (or ,@(make-pat rules))))))

(define (make-pat rules)
  (map (lambda (x) `(subst ',(cadr x) (match ',(cdar x) x e))) rules))

define-syntaxをコンパイラに追加。まだ、パターンマッチがおかしいけれど 基本的な動作はするようになった。gset,def命令で空リストがあった場合にバグ。 matchにもバグ。気長にバグ取り。伝統的マクロと同じ枠組みで動く(いてるはず)2012/05/07 23:58:42 UTC

if(eqp(car(expr),define_syntax)){
        S = NIL;
        E = NIL;
        C = comp(caddr(expr),env,list1(stop),BOOLF);
                D = NIL;
                vm() ;
        return(cons(defm,(cons (cadr(expr),list1(stop)))));
    
    }   

3度評価しないといけない。syntax-rulesでlambda式が生成される。このlambda式に マクロのパターンを与えると応じたテンプレートが生成される。さらにそれをコンパイルして ようやく目的の仮想コードが生成される。

全然、健全ではない。PAIPベースSchemeでdefine-syntaxを実装するのに相当にマイッタのを思い出した。パターンマッチングで生成される変数だけで十分に間に合うのではないのだろうか?

エラー検査

インタプリタの場合だとsubrは呼び出されたら引数の個数、型をチェックしないといけなかった。 せっかくコンパイラなのだから動的検査を避けて静的にコンパイラで検査させたい。 subrの引数の個数はあらかじめわかってるのでそれを登録しておいてコンパイラが検査すればいい。 closureはどうしよう? 定義時に引数個数を把握することはできる。けれど関数呼び出しが 定義より前にあるかもしれない。SMLのように定義は必ず前方になければいけないという制限をおけば closureの引数の個数も静的に検査できるかもしれない。

考えてみたいのは型推論。方程式を解くように推論をすすめていくのだそうだ。 Schemeでもある程度は型推論が可能なように思える。CommonLispでも処理系によっては コンパイル時点でかなりエラーをはじいてくれる。 2012/05/06 01:34:26 UTC

Peter、Landinさん

名前はどこかで知っていたのだけど、どこだったのか?思い出せない。 λ理論の本だったか、Steele博士の論文だったのか。 SECDマシンの設計者であり、クロージャーという用語、概念を初めて打ちだした人らしい。 その設計の見事さ、エレガントさとともに人柄にもとても興味がわいてきた。2012/05/04 01:13:56 UTC

プロファイラ

プロファイラを導入した。結果は次の通り。2012/05/01 23:26:41 UTC

Simp> (profile (tarai 10 5 0))
ld      0.314000 sec    1715363 count
ldc     0.000000 sec     257307 count
ldg     0.483000 sec     943450 count
ldf     0.000000 sec          0 count
ldct    0.000000 sec          0 count
def     0.000000 sec          0 count
lset    0.000000 sec          0 count
gset    0.000000 sec          0 count
args    0.219000 sec     943450 count
app     0.284000 sec     857682 count
tapp    0.000000 sec      85768 count
args_ap 0.000000 sec     943450 count
rtn     0.000000 sec     257305 count
sel     0.000000 sec          0 count
selr    0.047000 sec     343073 count
join    0.000000 sec          0 count
pop     0.000000 sec          0 count
push    0.000000 sec          0 count
10
Simp> 

あれ?tapp命令は実行しているのに時間は0になってる。精度の問題かな。

執筆活動開始

前々から書こうと思いつつ引き延ばされてきた「少し慣れた人のためのScheme」を書き始めた。 SimpleやMonoを作りながらわかったこと、発見したことをあれこれと盛り込む予定。

http://homepage1.nifty.com/~skz/Entry/scheme-powup.html

局所定義、変数

VM命令に局所定義用の命令ldefを追加しようと思っている。うまく設計できたら大域定義は従来のdefからgdefに名称変更。

(let ((x 1)(y 2)) ...)ならcompの引数envに(x y)をcons、complisに(1 2)を渡して(ldc 1 ldc 2 arg 1 ldef) ldef命令は単純にSスタックのリストをフレームとしてEスタックにconsするだけ。2012/04/29 09:20:21 UTC

これができればinternal-defineも単純にできる。compに引数を1つ追加して大域か局所かを コンパイラに知らせる。defineはそれによって大域のコードか、局所のコードかを判別して生成。

ldef命令とletをketに代えて試しに入れてみた。

Simp> (ket ((x 1)(y 2)) (+ x y))
(ldc 1 ldc 2 args 2 ldef ld (0 . 0) ld (0 . 1) args 2 ldg #<subr +> app stop)
3
Simp> 

動いた。

あれこれ試行錯誤してみたものの結局、もとのマクロによる方式に戻すことにした。internal-deineはletrecに変換する関数を用意しコンパイラにかける前に変換しておくことにした。 記念に試行錯誤したコードを残しとこう。

if(eqp(car(expr),ket)){
        vars = let_vars(cadr(expr));
        vals = let_vals(cadr(expr));
        body = caddr(expr);
        return(complis(vals,
                                cons(vars,env),
                    cons(args,
                                cons(makeint(length(vals)),
                                cons(ldef,
                                        comp(body,cons(vars,env),code,BOOLF))))));
    }

int let_vars(int x){
        int res;
    
    res = NIL;
    while(!nullp(x)){
        res = cons(caar(x),res);
        x = cdr(x);
    }
    return(reverse2(res));
}

int let_vals(int x){
        int res;
    
    res = NIL;
    while(!nullp(x)){
        res = cons(cadar(x),res);
        x = cdr(x);
    }
    return(reverse2(res));
}

べき乗

意外とめんどうそうで放置していたのが(expt x y)。xにbignumを許すのはいいとしてyに bignumを許してしまったら巨大すぎて実際問題、計算困難なはず。

gosh> (expt 123 9999999999999999)
*** ERROR: exponent too big: 9999999999999999
Stack Trace:
_______________________________________
gosh> 

さすがのGaucheもエラーにしている。底にはbignumを許すものの、指数はintを超えたらエラーにすることにした。浮動小数の場合にはcの関数を使う。複素数の場合は後日検討。2012/04/28 06:50:07 UTC

整数の場合にはSICPでやったfast-exptのアルゴリズムで計算。分数が不完全なので指数がマイナスの場合にはとりあえずエラー、複素数もとりあえずエラー。一応、動くようにした。

関数閉包

クロージャの持っている環境が見えた方が面白いだろうと、environment手続きを追加した。 以下は拙作「まったく初めての人のためのScheme」にあるクダラナイ例コード。

(define i 0)

(define love
  (let ((old-i 0))
    (lambda ()
      (cond ((< i old-i) (display "おい、頑張れよ"))
            ((= i 0) (display "彼女と会う機会を増やせ"))
            ((= i 1) (display "彼女と一緒に勉強しろよ"))
            ((= i 3) (display "彼女を公園に誘えよ"))
            ((= i 5) (display "彼女をディズニーランドに連れて行け"))
            ((= i 7) (display "彼女にクリスマスプレゼントだ"))
            ((= i 10) (display "やったね、愛は永久に")))
      (set! old-i i))))

Simp> (environment love)
((0))
Simp> 

環境を持ち歩いているってことがはっきり見えたらクロージャにも親しみがわくのではないかなぁ。2012/04/27 09:56:29 UTC

あれれ、バグってる。set!によって書きかえられないといけないのに、そのままじゃない!。 う~ん、デバッグ。

lambdaでclosureが作られるときにEスタックがclosureのenvになってる。 closureをapp、tapp命令で評価するときにはenvがEスタックとなりその局所環境で評価される。 ところが次のコードでテストすると局所変数yは書き換えられてない。なぜだ?

(define foo
  (let ((x 1)(y 2))
    (lambda (z)
      (set! y z)
      (display y)
      (register 'E))))

Simp> (foo 5)
2((5) (1 2))
Simp> 

わかった。lset命令のコンパイルを間違えていた。フレームでの位置を与えるリストをリストの アドレスにして渡していた。それでlset命令が正常動作していなかったんだ。2012/04/28 03:22:10 UTC

(define foo
  (let ((x 1)(y 2))
    (lambda (z)
      (display (register 'E))
      (set! y z)
      (register 'E))))

Simp> (foo 5)
((5) (1 2))((5) (1 5))
Simp> (environment foo)
((1 5))
Simp> 

文字列

文字列トークンの切り出しが間違ってることに気がついていたがお昼休みにて修正した。 それまで使うばかりの立場だったのでエスケープシーケンスとか意識していなかった。 \n\r\tなどが使える。display手続きに文字列を与えると画面上の字面と同じものが再現される。 readとdisplayが逆関数になっていた。2012/04/26 09:06:12 UTC

\rってのがよくわからない。

Simp> "123  
abc"
"123  \nabc"
Simp> (display "123  \nabc")
123  
abc#<undef>
Simp>

局所define

局所でのdefineはNorvig先生の本に倣ってletにtransferするやつを書いてそれでコンパイルしようと考えていた。ダメもとで現状で動かしてみると・・・

(define (foo n)
  (define (bar n)
    (define (goo n)
      (* n n))
    (+ (goo n)(goo n)))
  (bar n))

Simp> (foo 3)
18

あれまあ、動いた!。でも、よくよく調べてみると。

Simp> (vmcode foo)
(ldf (ldf (ld (0 . 0) ld (0 . 0) args 2 ldg <subr *> tapp rtn) def goo pop ld
 (0 . 0) args 1 ldg goo app ld (0 . 0) args 1 ldg goo app args 2 ldg <subr +> 
tapp rtn) def bar pop ld (0 . 0) args 1 ldg bar tapp rtn)
Simp> goo
<closure>
Simp> bar
<closure>
Simp> 

大域に定義されてしまっている。やはりletに置き換えるものを書かなければいけない。2012/04/25 23:43:32 UTC

局所定義をletに変換するものを当初、Cで書こうと思っていたが、ややこしい。 せっかくマクロがあるんだからマクロにしよう。大域定義は別名のdefってことにして、 defineをマクロにして次のように変換するように書けばいいと思う。2012/04/27 06:56:34 UTC

(define (foo x)
  (define (bar x)
    (define (boo x)
      (/ x 2))
    (+ (boo x)(boo x)))
  (define (goo x) (* x x))
  (+ (bar x) (goo x)))

これを下のように変換。

(def (foo x)
  (let ((bar (lambda (x)
               (let ((boo (lambda (x) (/ x 2)))) (+ (boo x)(boo x)))))
        (goo (lambda (x) (* x x))))
    (+ (bar x) (goo x))))

よくよくr5rsを読んでたらletじゃなくってletrecと等価だた。let、let*のbodyの最初に定義が許される。それならばletマクロに処理を追加しようかと考えたものの、lambdaそのものの最初の部分での定義がそれだとうまくいかない。def命令を大域定義用のgdefと局所定義用のldefの2つを用意しようかどうか考えている。PAIPのときはどうやったんだっけか。

Gaucheはletに展開されていた。

http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3A%E5%86%85%E9%83%A8define%E3%81%AE%E8%A9%95%E4%BE%A1%E9%A0%86

vmcode手続き

関数をコンパイルした後のvmコードを取り出せる手続きを追加した。 どんなコードに展開されるんだ?という疑問に応えるため。2012/04/23 09:56:09 UTC

Simp> (vmcode tarai)
(ld (0 . 0) ld (0 . 1) args 2 ldg <subr <=> app selr (ld (0 . 1) rtn)
 (ld (0 . 0) ldc 1 args 2 ldg <subr -> app ld (0 . 1) ld (0 . 2) args 3 ldg 
 tarai app ld (0 . 1) ldc 1 args 2 ldg <subr -> app ld (0 . 2) ld (0 . 0) args 3
 ldg tarai app ld (0 . 2) ldc 1 args 2 ldg <subr -> app ld (0 . 0) ld (0 . 1)
 args 3 ldg tarai app args 3 ldg tarai tapp rtn))
Simp> 

あれ?以前、助言をもらってクロージャー呼び出しを埋め込みに改良したところが機能してないなぁ。要デバッグ。

大域変数の参照のところでミスってた。二度以上評価すると予定通りにクロージャーがコードに埋め込まれてるのだけど、初回にはシンボルになったままになっていた。せっかくなので両者を比較すると(tarai 12 6 0) で4秒ほど差が出た。関数登録数が多いともっと差が出ると思う。

クロージャをただ<closure>と表示したのでは何の関数なのかがわからない。定義するときに 名前も記録しておこう。GCのときにfree()しないといけないけど、仮想コードがわかりやすい方がいい。

Simp> (vmcode tarai)
(ld (0 . 0) ld (0 . 1) args 2 ldg <subr <=> app selr (ld (0 . 1) rtn)
 (ld (0 . 0) ldc 1 args 2 ldg <subr -> app ld (0 . 1) ld (0 . 2) args 3 ldg
 <closure> app ld (0 . 1) ldc 1 args 2 ldg <subr -> app ld (0 . 2) ld (0 . 0)
 args 3 ldg <closure> app ld (0 . 2) ldc 1 args 2 ldg <subr -> app ld (0 . 0)
 ld (0 . 1) args 3 ldg <closure> app args 3 ldg <closure> tapp rtn))

バグ補正をしようと次のように直してみた。暴走する。

if(symbolp(expr)){
        pos = location(expr,env);
        if(pos != 0)
                return(cons(ld,cons(pos,code)));
        else{
                        fn = get_gvar(expr);
            //subrかclosureの場合にはそれそのものをcodeに埋め込む。
                if(subrp(fn) || closurep(fn))
                        return(cons(ldg,cons(fn,code)));
                else
            //そのシンボルが未定義の場合にはundefとして定義しそれをcodeに埋め込む。
            if(fn == 0){
                push('G',cons(expr,undef));
                fn = get_gvar(expr);
                        return(cons(ldg,cons(fn,code)));
            }
            else
            //定義されていてsubrでもclosureでもない場合。
                return(cons(ldg,cons(expr,code)));      
        }
    }

undefが悪さをしているような気がするのだけど。わからないのでとりあえず元のままにして 後日、再検討。2012/04/24 12:05:34 UTC

根本的に間違えてた。とりあえずundefを割り当てておいて、シンボルexprにclosureが割り当てられれば自動的にundefがそのclosureに置き換えられるような錯覚をおこしていた。undefのままで 変わらない。subrだと最初から定義があることが明らかなので簡単なのだけど、closureだとあちこち書き直さないといけない。う~ん、後回し。(笑)subrだけ置き換えることにしよう。 2012/04/25 10:28:32 UTC

マクロtransfer

`(1 ,`2) => (1 2) のようにunquoteの中でquasiquoteに対応できるように transferをtransfer1との相互再帰に書き加えた。2012/04/22 11:44:54 UTC

set! デバッグ

マクロの一部が動作せず調べていたところ、どうもset!に問題があるようだ。 (let ((x 1)(y 2)) (set! x 3)(set! y 4) (+ x y)) = 7 のはず。 それが#fを返す。どうも局所変数に対するset!がバグってるようだ。2012/04/22 07:51:33 UTC

局所変数を登録したEスタック、せっかくregister手続きを用意したのでどのようになっているのか 調べてみた。

Simp> (let ((x 1)(y 2)) (let ((z 3)(a 5)) (register 'E))
        )
((3 5) (1 2))
Simp> (let ((x 1)(y 2)) (let ((z 3)(a 5)) (set! z 8) (register 'E)))
((3 . 8) (1 2))

間違ってpairになっていた。set!に対応する命令を間違えていたようだ。

lset-varを間違えていた。setcarしないといけないところをsetcdrとしていた。 こんどはOK。

Simp> (let ((x 1)(y 2)) (set! x 5) x (register 'E))
((5 2))
Simp> 

register手続き

SECDGの各レジスタの内容を取り出す手続き (register x)を追加した。 taraiの実行中のEレジスタを見たければ次のようにすると・・・ Dレジスタも覗いてみると面白い。2012/04/22 05:19:45 UTC

(define tarai
  (lambda (x y z)
    (display (register 'E))(newline)
    (if (<= x y)
        y
        (tarai (tarai (- x 1) y z)
               (tarai (- y 1) z x)
               (tarai (- z 1) x y)))))

Simp> (tarai 4 2 0)
((4 2 0))
((3 2 0))
((2 2 0))
((1 0 3))
((0 0 3))
((-1 3 1))
..........
((2 2 0))
((3 3 2))
((0 4 3))
((-1 4 2))
((3 4 4))
4
Simp> 

taraiテスト

CELLの使い切りを検出してその場合にはエラーにした。consする都度監視しているので オーバーヘッドは?と思い計測してみた。あれ?却って前より速くなってるよ。謎。 もっともGaucheの30倍程度は遅いけれど。2012/04/22 03:36:41 UTC

Simp> (time (tarai 12 6 0))
12
total 63.694000 second
gc    14.726000 second
Simp> 

EスタックをCELLを使って実装している。これを配列使う方式にすればtaraiは速くなるはず。 taraiはひたすら局所変数を使い回しているだけなのでそこの性能に左右されるはず。

コラッツ予想でbignumテスト

30ケタくらの数を与えても瞬時に結果が出る。基本的な四則演算はなんとかなったようだ。 今後は分数の既約分数化にとりくむ。2012/04/22 03:28:03 UTC

(define (collatz n)
  (display n)(display '->)
  (cond ((= n 1) #t)
        ((even? n) (collatz (quotient n 2)))
        ((odd? n) (collatz (+ (* n 3) 1)))
        (else #f)))

Simp> (collatz 1231298371923791287392873923298739128739127898797987989781
 

乗算、改良

(fact 300)くらいでメモリ不足をおこしGCも起動されない。調べてみるとbignumの乗算に問題があった。セルを消費し過ぎてる。少なくとも一方の引数がint型のときにはもっとセルを節約できる。 VMは各命令が終了した都度、セルの空き容量を点検して一定数以下になっている場合にはGCを起動していた。subrの*(乗算)がセルを使いすぎていてGCが起動する前にセル不足になっていたのが原因。命令の実行が終わるまでは値が束縛されておらずGCでマークできない。状態を保存してGCを起動するのは煩わしいので最低限残す空き容量を増加させるとともに乗算の効率アップをすれば(fact 2000)くらいまでは全く問題がないことがわかった。2012/04/21 22:58:13 UTC

改良の結果、(fact 15000)程度までは動くことが確認でした。桁数多すぎて画面に収まりきらないが、下の方の桁ではGaucheの計算結果と合致しているのでおそらく結果は合ってるはず。2012/04/22 03:21:13 UTC

Simp> (fact 500)
12201368259911100687012387854230469262535743428031928421924135883858453731538...

除算、バグ取り

コラッツ予想の計算をbignumでやらせてテストをするとダメ。除算が間違ってた。理由は除数が極端に小さい場合のオーバーフロー。クヌース先生の定理にあてはめるためにd=BIGNUM_BASE /(v+1)で調整をする。 被除数の上位2セル分をとり、さらにdをかけるとオーバーフローを起こす場合があった。例えば除数が2のように小さい場合。

そこで除数がint型の場合にはDアルゴリズムによらずc言語の除算を使って多桁の計算するものとした。ようやく解決。2012/04/17 23:41:33 UTC

Simp> 
Simp> (collatz 8888888888)
8888888888
4444444444
2222222222
1111111111
3333333334
...........
88
44
22
11
34
17
52
26
13
40
20
10
5
16
8
4
2
1
#t
Simp> 

少し慣れた人のためのScheme

以前書いた駄文「まったく初めての人のためのScheme」の続きを書きたくなってきた。 セル構造のこと、レキシカルスコープのこと、継続のこと、その他あれこれ。 登場人物たちが勝手にしゃべってくれそうな感じ。2012/04/15 23:33:13 UTC

お話のなかでSimpleを使うのでメモリダンプの機能を追加。

Simp> (dump 0)
addr      car     cdr     env     tag    val
0000000 F 0000000 0000000 0000000 Sys    ()
0000001 F 0000000 0000000 0000000 Bol    #t
0000002 F 0000000 0000000 0000000 Sys    #t
0000003 F 0000002 0000001 0000000 Lis    
0000004 F 0000003 0000000 0000000 Lis    
0000005 F 0000000 0000000 0000000 Bol    #f
0000006 F 0000000 0000000 0000000 Sys    #f
0000007 F 0000006 0000005 0000000 Lis    
0000008 F 0000007 0000004 0000000 Lis    
0000009 F 0000000 0000000 0000000 Sys    stop

セルの構造変更

有理数は分子分母ともにbignumを許すらしい。これに対応するために根本のセルの構造を変更。2012/04/15 12:40:32 UTC

struct cell {
        tag tag;
        flag flag;
        char *name;
        union{
        int     intnum;
        double  fltnum;
        int     numer;
        int     bind;
        int     ( *subr) ();
    } real;
    union{
        double  fltnum;
        int             denom;
    } imag;
    int env; 
    int car;
    int cdr;
};

bignum 除算

除算が一番、めんどうくさい。あれこれ試行錯誤、独自に考えたものの、最終的にクヌース先生の Dアルゴリズムに辿りついた。第4巻の88ページ。そんなうまい定理が成り立つなんて。 2012/04/13 10:23:09 UTC

試行錯誤しながらクヌース先生の定理を利用した除算がなんとか動いた。たまにおかしい。2012/04/14 07:27:11 UTC

gosh> (quotient 100000000000000000000000000 777777777777)
128571428571557
gosh> (exit)

C:\MinGW\Simple>simp
simp
educational Scheme compiler Simple Ver0.13 (written by sasagawa888)
Simp> (quotient 100000000000000000000000000 777777777777)
128571428571557
Simp> 

bignum仕様、検討したこと

int型のセルをリストにつないでbignumとする。 tagにBIGをセット。

1セルあたりの扱える整数は-999,999,999~999,999,999 BIGNUM_UNIT=1,000,000,000を単位として多桁演算をする。

セルのcarが最下位整数。

readでは9ケタを超える整数が与えられたときにBIGNUM型に変換する。

bignumの計算をして結果が2,000,000,000以下ならばint型の整数に 変換する。1セルの場合には明らかにint型に変換可能。2セルにまたがる場合には 上位のセルの数値で判断。下位セルは無視して効率の方をとった。

乗算の場合の繰り上がり。1セルに入るのはmax=999,999,999として max^2 + max 。これがlonglongint型の範囲に入っていれば積の計算でオーバーフローを 起こさない。max(max+1) < longlongmax.

gosh> (sqrt 9223372036854775807)
3.03700049997605e9
gosh> 

longlongmaxの平方根はおおよそ3,000,000,000 なので収まるはず。

bignum型の正負判定は最上位のセルで判定しないといけない。 いちいち最上位セルまでcdrをとらないといけないけれど仕方がない。2012/04/11 23:05:25 UTC

bignumシンプルに解決

助言をいただいてGCCにはlong long int 型があることがわかった。 それなら話は簡単。オーバーフロー判定も単純になるし(効率は不明) bignumも1セルあたりの桁数をぐっと増やせる。2012/04/08 07:48:25 UTC

と思いきや、オーバーヘッドが大きいことが判明。 intの減算にオーバーフローチェックをいれてオーバーしてたらbingumというように変更。

switch(GET_TAG(arg1)){
        case INTN:
                switch(GET_TAG(arg2)){
                        case INTN: {l1 = (long long int)GET_REAL_INT(arg1);
                                        l2 = (long long int)GET_REAL_INT(arg2);
                            l = l1 - l2;
                            if(LONG_MIN < l && l < LONG_MAX)
                                return(makeint((int)l));
                            else
                                return(bignum_minus(int_to_bignum(arg1),int_to_bignum(arg2)));}
                case BIG:  return(bignum_minus(int_to_bignum(arg1),arg2));

そして (tarai 12 6 0) を実行してみると

Simp> (time (tarai 12 6 0))
12
total 73.554000 second
gc    14.891000 second

60秒を下回っていたのが14秒ほど遅くなってしまった。long long intの演算はけっこうコストが高いらしい。難しいもんだなね。性能を上げるにはアセンブラレベルでオーバーフローのフラグを拾うしかないみたい。 2012/04/09 06:53:47 UTC

一応、動くレベルまできた。ただし、遅い。2012/04/09 11:37:46 UTC

gosh> (sigma 200000)
20000100000
gosh> (exit)

C:\MinGW\Simple>simp
simp
educational Scheme system Simple Ver0.12 (written by sasagawa888)
Simp> 
Simp> (sigma 200000)
20000100000
Simp> 

(define (sigma n)
  (if (= n 0)
      0
      (+ n (sigma (- n 1)))))

どうにか乗算も動くようになった。2012/04/11 10:12:19 UTC

educational Scheme compiler Simple Ver0.12 (written by sasagawa888)
Simp> (* 1234567890 98765432100)
121932631112635269000
Simp> (* 11111111111111111 11111111111111111111111111)
123456790123456788888888887654320987654321
Simp> (exit)
- good bye. -

C:\MinGW\Simple>gosh -i
gosh -i
gosh> (* 1234567890 98765432100)
121932631112635269000
gosh> (* 11111111111111111 11111111111111111111111111)
123456790123456788888888887654320987654321
gosh> 

やっとできたか。

Simp> (fact 200)
788657867364790503552363213932185062295135977687173263294742533244359449963403342920304284011984623904177212138919638830257642790242637105061926624952829931113462857270763317237396988943922445621451664240254033291864131227428294853277524242407573903240321257405579568660226031904170324062351700858796178922222789623703897374720000000000000000000000000000000000000000000000000

bignum頭の整理

bignumで加算、減算まで実装、シグマ計算くらはできるようになったものの、 設計のまずさほか、あれこれ問題続出。頭の整理。

cのint型は-214783648~214783647を扱えるのに-9999~9999にintを限定してしまった。 これは効率悪すぎ。こうした訳はbingumで1セルあたりを小さくすれば 乗算でCのint内に収まりそこから桁あがり分を計算すればいいと思ったから。 でも、いかにも効率が悪い。しかし、1セルあたり100000000にしたときに 桁あがりの数をどのように計算していいのかわからない。

標準形を設けた方がいいらしいこと。減算だと(- 10000 2) で9999で桁あがりにして いたので上位を1つ借りてきてそれから引くという小学校で習った方法をとった。 ところが(- -10000 2) = -29998 のようなおかしな結果になる。 (- -10000 2) = -(+ 10000 2) = -10002 にしないといけないんじゃないだろうか。 ちょうど数式も標準形があって常にそれにもっていっていたように。

標準形:こういう風にする。

(+ arg1 arg2) arg>0 arg2>0

(- arg1 arg2) arg1>0 arg2>0 arg1>arg2

変形規則;

(+ -arg1 arg2) = (- arg2 arg1).
(+ -arg1 -arg2) = -(+ arg1 arg2).
(+ arg1 -arg2) = (- arg1 arg2).

(- arg1 arg2){arg2 < arg1} = -(- arg2 arg1).
(- -arg1 arg2) = (+ -arg1 -arg2) = -(+ arg1 arg2).
(- -arg1 -arg2) = (+ -arg1 arg2) = (- arg2 arg1).
(- arg1 -arg2) = (+ arg1 arg2) 
int * bignum = (bignum)int * bingum = if(digit(bignum) < digit(int)) (int)bignum else bignum.
bignum * int = int * bignum.

int a * int b = if(a<sqrt(intmat) && b<sqrt(intmax)) int a* int b else if(a < max/b) inta * int b else (bignum)a * (bignum)b.

bignum * bignum = if((bignum *bignum) < intmax) (int)(bignum * bignum) else (bignum * bignum).


int整数で扱える範囲ではめいっぱいそれを利用し、オーバーしたときだけ 1セルあたり9999までのbignumにしておいて計算する都度、intに変換できるかどうかを チェックし可能ならintに戻してしまう。2012/04/06 12:36:37 UTC

cでint型について乗算、加算をしたときにオーバーフローすることを確認できる方法があればいい。 そのときにはint型の引数をbignumに変換してbignumのルーチンを呼び出せばいいから。

思いついた方法メモ。

a*b < max , a=> b>=1 につき a< max/bでチェック。a,bともにsqrt(max)以下のときには オーバーフローはあり得ないので検査しない。可算も同様に a< max/2 b<max/2 なら検査しない。 a< max-b でチェック。オーバーフローするときにはintをbignumに変換して計算。 また、bignumの計算で結果がintの範囲で収まるときにはint型のセルに変換格納。

bignum 加算

とりあえず単純な加算だけはなんとか動くようになった。2012/04/05 13:12:53 UTC

Simp> (+ 100000000000000000000000002 3000000000000000000000009)
103000000000000000000000011
Simp> 

参考

ひげぽんさんのMoshの開発話がYoutubeにあった。 http://www.youtube.com/watch?v=bGdkuKoQ09o&feature=related たいへんに興味深い。初期の話が自分が考えたこと、疑問に思ったことと重なる。 スピードを出すには根本設計から見直さなければならないようだ。 SECDベースの設計はとてもエレガントで教育的(自分のための)に優れている。が、実用速度を 出そうとするとケント教授の有名な論文を読まないといけないようだ。Simpleはだいぶ進んだので これを最後までR5RS準拠で完成させる。もしも時間がとれるなら、実用重視の処理系にも 取り組んでみたいような気がする。2012/04/05 10:54:52 UTC

バグ

condマクロがなんで動かない時があるのか?調べたら、list-tail関数が間違ってた。 (list-tail ls n)のnがリストの範囲を飛び出していたら'()を返さないといけなかった。

int listtail(int lis, int n){
        while(!(nullp(lis))){
        if(n == 0)
                return(lis);
        else{
                lis = cdr(lis);
            n--;
        }
    }
    return(lis); //ここ
}

ああ、ちがった。length(ls) = n のときに'()だった。直そう。2012/04/04 13:01:02 UTC

GC 地道な努力

C言語のmallocとfree関数はコストが高いと聞き、それではとGCで全部のセルについて freeしていたものをシンボル、文字列として使われていて再利用されるものだけに限定してみた。 少し効果があった。(tarai 12 6 0)で5秒ほど短縮。60秒を切ることができた。 Gaucheに比べたら全然、話にならんけれどね。2012/04/04 08:44:07 UTC

void gbcsweep(void){
        int addr,maxaddr;
    
    addr = 0; 
    while(addr < CELLSIZE){
        if(IS_USE(addr))
                SET_FLAG_FREE(addr);
        else{
                clrcell(addr);
            SET_CDR(addr,H);
            H = addr;
        }
        addr++;
    }
}

void clrcell(int addr){
        if(GET_TAG(addr) == SYM || GET_TAG(addr) == STR){
        free(memory[addr].name);
        memory[addr].name = NULL;
    }
    SET_TAG(addr,EMP);
    SET_CAR(addr,0);
    SET_BIND(addr,0);
}

educational Scheme system Simple Ver0.12 (written by sasagawa888)
Simp> 
Simp> (time (tarai 12 6 0))
12
total 58.112000 second
gc    15.090000 second

bingum実装

下記の検討をもとに実装してみた。案外、あっさり動いた。四則演算が問題。2012/04/03 10:33:01 UTC

Simp> (even? 11111111111111111111111111111111111111111111111111238)
#t
Simp> 

bignumを浮動小数点数に変換するものを追加してsinなどの数学関数は動くようになった。

Simp> (sin 12345678901234567890)
0.7674075223485186
Simp> (exit)
- good bye. -

C:\MinGW\Simple>gosh -i
gosh -i
gosh> (sin 12345678901234567890)
0.7674075223485186
gosh> 
Simp> 0123123
123123
Simp> 000000
00
Simp> 

後者は0にならなければならない。少しずつ直そう。

Gaucheにはbignum?という関数があったのでどこまでで切り分けてるのか試してみた。

gosh> (bignum? 1234567890)
#t
gosh> (bignum? 123456789)
#f
gosh> 

Simpleは単純化のために-9999~9999をintでそれを超えるとbignumにした。これは効率が悪い。 かといってint型の乗算をするのにいちいちオーバーフローを検出するのもめんどうそうで。結局、 効率は悪いけれど今の方法で進めることにした。2012/04/03 23:36:43 UTC

bignum

Shiroさんの助言によりクヌース先生の基本算法、第2巻を読んだ。おそらく、つなぎ配置のところ。その応用例として多項式の加算、乗算アルゴリズムが紹介されている。 下地先生の数式処理にも多項式の四則演算が紹介されていた。巨大整数の場合も要領は同じだと思う。乗算の場合に繰り上がり部分がオーバーフローしないようにc言語で扱える整数の平方根以下の 切りのいい整数を1単位にすれば良いように思う。それを下位の数から順次リンクさせてbignum型とする。加算、減算、乗算は下位の数から計算を始めた方が都合がいいのだけど、除算は上位から 計算を始めた方がよさそう。除算だけはリバースして計算かなと思っている。 下地先生の数式処理の該当部分を読みなおそうと思っている。2012/04/02 08:20:29 UTC

c言語のintは4バイトで -214783648~214783647。 そうすると

gosh> (sqrt 214783647)
14655.498865613548

切りのいい、わかりやすいところで1セルは0~9999までかな。100ケタの整数を表すのに25×2=50セルを消費。そんなもんなのかな。メモリ効率が悪いような気もする。

関係ないが、

Simp> (sqrt 214783647)
0.0000000000008974+14655.4988656135390000i
Simp> (exit)

これは間違ってる。めんどうなので実数も複素数として計算していた。実数は実数として平方根を計算するよう直さないといけない。数学関数もちゃんと見直さないと。

数式処理のアルゴリズムと同じだと思う。 1セルの扱える最大値+1をUと置けば乗算なら

(x0 + x1U^1 + x2U^2 ... xnUn)(y0 + y1U^1 + y2U^2 ... ynUn) を計算するってことだと思う。2012/04/02 23:57:34 UTC

細かなバグとり

あちこち間違ってる。直さないと。2012/04/01 12:12:53 UTC

gosh> (eqv? 1 1.0)
#f

educational Scheme system Simple Ver0.12 (written by sasagawa888)
Simp> (eqv? 1 1.0)
#t
Simp> 

bignum

多桁演算の実装が残ったままだった。ずいぶんな昔、VIC-1001 Basicで多桁演算をするプログラムをI/Oでみたなぁ。筆算の四則演算と同じ要領でいいと思うのだけど。なんか参考書を探してみるかな。2012/04/01 12:02:33 UTC

長くなってきたのでこっちに移動しました。

More ...