secd machine と util.match - cranebirdの日記

gauche の util.match を使えばもっとずっと短く明快に、定義そのままに secd machine を書けることに今さら気づいた。やはりオブジェクトじゃなくリストで十分だった。うーん、パターンマッチは本当に強力だ。全体を見直したところ、完全に資料(http://www.cs.ualberta.ca/~you/courses/325/Mynotes/Fun/SECD-slides.html)どおりの表記になった。例外は LD に渡す要素で、１だけずれている。
(上記資料はとても分かりやすいので secd machine って何だ？という非情報科学系の人にお勧め。情報科学系の人には恐らく常識。)

gosh> (secd 's 'e '(LDC x . c) 'd)
s e (LDC x . c) d
(x . s) e c d
((x . s) e c d)
#f
gosh> (secd 's 'e '(NIL . c) 'd)
s e (NIL . c) d
(NIL . s) e c d
((NIL . s) e c d)
#f
gosh> (secd 's 'e '(LDC 3 LDC 2 LDC 6 + * . c) 'd)
s e (LDC 3 LDC 2 LDC 6 + * . c) d
(3 . s) e (LDC 2 LDC 6 + * . c) d
(2 3 . s) e (LDC 6 + * . c) d
(6 2 3 . s) e (+ * . c) d
(8 3 . s) e (* . c) d
(24 . s) e c d
((24 . s) e c d)
#f

gosh> (secd 's '((1 3) (4 (5 6))) '(LD (1 . 1) CAR LD (0 . 0) + . c) 'd)
s ((1 3) (4 (5 6))) (LD (1 . 1) CAR LD (0 . 0) + . c) d
((5 6) . s) ((1 3) (4 (5 6))) (CAR LD (0 . 0) + . c) d
(5 . s) ((1 3) (4 (5 6))) (LD (0 . 0) + . c) d
(1 5 . s) ((1 3) (4 (5 6))) (+ . c) d
(6 . s) ((1 3) (4 (5 6))) c d
((6 . s) ((1 3) (4 (5 6))) c d)

そして関数適用も。これはとりあえず動いた、という段階。もうすこし吟味して、何が起きているのか正確に把握しなくてはいけない。

gosh> (test* "((lambda (x y) (+ x y)) 2 3)"
       '((5 . s) e c d)
       (secd 's 'e
             '(NIL LDC 3 CONS LDC 2 CONS LDF (LD (0 . 1) LD (0 . 0) + RTN) AP . c)
             'd))
test ((lambda (x y) (+ x y)) 2 3), expects ((5 . s) e c d) ==> s e (NIL LDC 3 CONS LDC 2 CONS LDF (LD (0 . 1) LD (0 . 0) + RTN) AP . c) d
(NIL . s) e (LDC 3 CONS LDC 2 CONS LDF (LD (0 . 1) LD (0 . 0) + RTN) AP . c) d
(3 NIL . s) e (CONS LDC 2 CONS LDF (LD (0 . 1) LD (0 . 0) + RTN) AP . c) d
((3 . NIL) . s) e (LDC 2 CONS LDF (LD (0 . 1) LD (0 . 0) + RTN) AP . c) d
(2 (3 . NIL) . s) e (CONS LDF (LD (0 . 1) LD (0 . 0) + RTN) AP . c) d
((2 3 . NIL) . s) e (LDF (LD (0 . 1) LD (0 . 0) + RTN) AP . c) d
(((LD (0 . 1) LD (0 . 0) + RTN) . e) (2 3 . NIL) . s) e (AP . c) d
NIL ((2 3 . NIL) . e) (LD (0 . 1) LD (0 . 0) + RTN) (s e c . d)
(3 . NIL) ((2 3 . NIL) . e) (LD (0 . 0) + RTN) (s e c . d)
(2 3 . NIL) ((2 3 . NIL) . e) (+ RTN) (s e c . d)
(5 . NIL) ((2 3 . NIL) . e) (RTN) (s e c . d)
(5 . s) e c d
ok
#<undef>

OP	説明	目的	状態
NIL	push a nil	list 用	done
LD	load from the environment	環境から値を取得	done
LDC	load constant	スタックに定数をプッシュ	done
LDF	load function		done
AP	apply function		done
RTN	return	環境を戻す	done
SEL	select in if statement	if	done
JOIN	rejoin main control	if の末尾で	done
RAP	recursive apply
DUM	create a dummy env
CAR	built in unary op.	引数一つの組み込み関数	done
+,-,*,>,<	built in binary op.	引数二つの組み込み関数	done

今のところ secd machine (VM) のみで、コンパイラは作っていない。そんなに難しくはないはず。
このシンプルな secd machine と gauche vm の関係、をこれから考える。

コードは以下。secd machine は４要素のリストで表す。処理ごとに現在の vm の状態を印字。
パターンマッチを行い、定義通りに新しい状態に移る。どのパターンにもマッチしない場合、 (s e c d) をそのまま返して終了する。

;; see http://www.cs.ualberta.ca/~you/courses/325/Mynotes/Fun/SECD-slides.html

(define-module secd
  (use gauche.test)
  (use util.match)
  (use srfi-1))

(select-module secd)
(debug-print-width #f)

(use util.match)
(define (secd s e c d)
  (format #t "~a ~a ~a ~a~%" s e c d)
  (match (list s e c d)
    ((s e ('LDC x . c) d)
     (secd (cons x s) e c d))
    ((s e ('LD (i . j) . c) d)
     (secd (cons (list-ref (list-ref e i) j) s) e c d))
    (((a b . s) e ('+ . c) d)
     (secd (cons (+ a b) s) e c d))
    (((a b . s) e ('- . c) d)
     (secd (cons (- a b) s) e c d))
    (((a b . s) e ('* . c) d)
     (secd (cons (* a b) s) e c d))
    (((a b . s) e ('CONS . c) d)
     (secd (cons (cons a b) s) e c d))
    ((s e ('NIL . c) d)
     (secd (cons 'NIL s) e c d))
    (((a . s) e ('ATOM . c) d)
     (secd (cons (not (pair? a)) s) e c d))
    (((a . s) e ('CAR . c) d)
     (secd (cons (car a) s) e c d))
    (((x . s) e ('SEL ct cf . c) d)
     (secd s e (if x ct cf) (cons c d)))
    ((s e ('JOIN . c) (cr . d))
     (secd s e cr d))
    ((s e ('LDF f . c) d)
     (secd (cons (cons f e) s) e c d))
    ((((f . e2) v . s) e ('AP . c) d)
     (secd 'NIL (cons v e2) f (append (list s e c) d)))
    (((x . z) e2 ('RTN . q) (s e c . d))
     (secd (cons x s) e c d))
    ((s e c d)
     (values (list s e c d) #f))))

(provide "secd")