call/ccの練習でgenerator作ってみる

call/ccを使って値とnextが多値で帰ってくるようなgeneratorを作ってみようとしたら予想以上に難しかった。

はじめはset!なしで書こうとしたんだけど出来なさそうだった。思いつかないだけでなにか方法があるかもしれないけど。

(define (generator func)
  (define *receive* #f)
  
  (define (start-iteration)
    (func (lambda (val)
      (call/cc (lambda (cont)
        (*receive* val cont)))))
    
    ; iteration reached at end
    (*receive* #f #f))
  
  (define (step cont return)
    (set! *receive* (lambda (val cont)
      (return val (make-next cont))))
    (cont))
  
  (define (make-next cont)
    (and cont
         (lambda ()
           (call/cc (lambda (return) (step cont return))))))
  
  (make-next start-iteration))

ついでにテスト

(use gauche.test)
(use srfi-1)
(use srfi-11)

(test-start "generator")

(define (infinite-loop fn)
  (let loop ((i 0))
    (fn i)
    (loop (+ i 1))))

(let*-values ([(g) (generator infinite-loop)]
              [(val0 next0) (g)]
              [(val1 next1) (next0)]
              [(val2 next2) (next1)]
              [(val3 next3) (next2)]
              [(val1b next1b) (next0)]
              [(val2b next2b) (next1b)]
              [(val2c next2c) (next1)]
              [(val3c next3c) (next2c)])

  (test* "#0" 0 val0)
  (test* "#1" 1 val1)
  (test* "#2" 2 val2)
  (test* "#3" 3 val3)

  (test* "#1b" 1 val1b)
  (test* "#2b" 2 val2b)

  (test* "#2c" 2 val2c)
  (test* "#3c" 3 val3c)
)

(let*-values ([(g) (generator (cut for-each <> (iota 2)))]
              [(val0 next0) (g)]
              [(val1 next1) (next0)]
              [(val2 next2) (next1)])
  (test* "reached at end" #f next2))

(test-end)
  • はじめは以下のように書いてたんだけどシンタックスエラーになった。定義は好きなところに書けないのかー
  • テストのアサーション一つ一つに名前つけるのが面倒くさい
(let ()
  (define g (generator infinite-loop))
  (define-values (val0 next0) (g))
  (define-values (val1 next1) (next0))
  (define-values (val2 next2) (next1))
  (define-values (val3 next3) (next2))

  (test* "#0" 0 val0)
  (test* "#1" 1 val1)
  (test* "#2" 2 val2)
  (test* "#3" 3 val3)

  (define-values (val1b next1b) (next0))
  (define-values (val2b next2b) (next1b))
  (test* "#1b" 1 val1b)
  (test* "#2b" 2 val2b)

  (define-values (val2c next2c) (next1))
  (define-values (val3c next3c) (next2c))
  (test* "#2c" 2 val2c)
  (test* "#3c" 3 val3c)
)

Lazy K触り中

とりあえず

What's your name? >Hoge
Hello, Hoge.

的なプログラムを書いた。
面白いね

(load "../lazier.scm")
(load "../prelude.scm")
(load "../prelude-numbers.scm")

(define (string->expr str)
  (case (string-length str)
    ((0) 'i)
    ((1) (last-char->expr str))
    (else `(o ,(string->expr
                 (substring str 0 (- (string-length str) 1)))
              ,(last-char->expr str)))))

(define (last-char->expr str)
  `(cons ,(char->integer (string-ref str (- (string-length str) 1)))))

(lazy-def '(main input)
 `(,(string->expr "What's your name? >") 
   ((lambda (name)
     ((force-list name i)
      (,(string->expr "Hello, ")
       (name (,(string->expr ".") end-of-output)))))
    (gets input))))

; listをあらかじめ評価
(lazy-def '(force-list list retval)
 '(if (null? (list ())) retval retval))

(lazy-def '(gets list)
 '((lambda (x) (x x i list))
   (lambda (self cont src)
     (if (or (if>= (car src) 256 #t #f) (= (car src) 10))
       (cont i)
       (self self (lambda (x) (cont (o (cons (car src)) x))) (cdr src))))))

(print-as-cc (laze 'main))

force-listのあたりがちょっと汚い

Lazy Kではrest部分を渡したらリストが返ってくるような関数で部分リストを表すことが多いようだ。 (部分リストって言葉は今勝手につけた)
たとえば

  • 空の部分リスト: i
  • X一個の部分リスト: (cons X)
  • XとYの2個の部分リスト: (o (cons X) (cons Y))
  • Xをnum回繰り返した部分リスト: (num (cons X))

みたいに

lazier.scm, prelude.scm, lazy.cppは一通り読んだのでその雑感

  • if<=の定義を見て: なんだこりゃーーすげーーどうやったらこんなの思いつくんだーー
  • partial_eval, partial_eval_primitive_applicationあたりをみて: トリッキーな評価方法だなー。Schemeはまだ式を見てそれが評価される様子がなんとなく頭の中である程度想像がつくけどLazy Kは想像できそうにない

追記 (2010-11-12T18:55:51+09:00)

getsはCPSしか道はないと思ってたけどtail引数をとるという道があった。こっちのが断然シンプル
(cons X)をoで合成していくという一つの発想にとらわれていた

(lazy-def '(gets list)
 '((lambda (x) (x x list))
   (lambda (self src tail)
     (if (or (if>= (car src) 256 #t #f) (= (car src) 10))
       tail
       (cons (car src) (self self (cdr src) tail))

JavaScriptのジェネレータについて思うこと


JavaScriptにジェネレータってあるじゃないですか。それを使えば非同期の処理を同期みたいに書けるっていうのがあるじゃないですか。

function myroutine() {
	なんかする1;
	yield 1000;
	なんかする2;
	yield 2000;
	なんかする3;
	yield 1000;
	なんかする4;
}

function run_routine() {
	var g = myroutine();
	(function() {
		try {
			var msec = g.next();
		} catch (e if (e instanceof StopIteration)) {
			return;
		}
		setTimeout(arguments.callee, msec);
	})();
}

でもねーこれmyroutineを複数の関数に分割とかしたらそのままじゃ動かないじゃないですか

function myroutine() {
	myroutine_inner_A();
	yield 2000;
	myroutine_inner_B();
}

function myroutine_inner_A() {
	なんかする1;
	yield 1000;
	なんかする2;
}

function myroutine_inner_B() {
	なんかする3;
	yield 1000;
	なんかする4;
}

これをどうにかするためにはmyroutine_inner_A, myroutine_inner_Bを呼ぶときにforを使わないといけない

function myroutine() {
	for (var v in myroutine_inner_A()) yield v;
	yield 2000;
	for (var v in myroutine_inner_B()) yield v;
}

Luaのコルーチンだと普通に複数の関数に分割できるんだけどなー

function myroutine()
	myroutine_inner_A()
	coroutine.yield(2000)
	myroutine_inner_B()
end

function myroutine_inner_A()
	なんかする1
	coroutine.yield(1000)
	なんかする2
end

function myroutine_inner_B()
	なんかする3
	coroutine.yield(1000)
	なんかする4
end

でcoroutine.yieldってのはJSのyieldと違って単なる関数にすぎないのでコールバックとして渡すこともできる
だから以下のようなことも出来るはず! (LuaにはsetTimeoutなんてないので実際には動かないですけど)

function myroutine(wait_func)
	(wait_funcを指定ミリ秒待つ関数として使ってなにか実装)
end

function run_routine()
	local co = coroutine.create(function() myroutine(coroutine.yield) end)
	
	local function loop()
		local _, val = coroutine.resume(co)
		local status = coroutine.status(co)
		if status == "dead" then
			return
		end
		setTimeout(loop, val)
	end
	
	loop()
end

JavaScriptもこれぐらいできれば非同期処理を同期っぽく書けるって言われて納得できるんだけど、今のジェネレーターの機能だけじゃあ納得できない。
ずっともやもやしていたので記事にしてみました。

ツッコミ歓迎。

JavaScriptで関数のソースから外部イテレータのソースに変換してくれるツールほしい!

たとえば

function () {
	for (var i = 0; i < 3; i ++) {
		yield i;
	}
}

って入力すると

function () {
	for (;;) {
		switch(this.pc) {
		case 0:
			this.i = 0;
			this.pc = 1;
			break;
		case 1:
			if (this.i < 3) {
				this.pc = 2;
			} else {
				this.pc = 4;
			}
			break;
		case 2:
			this.pc = 3;
			return this.i;
		case 3:
			this.i ++;
			this.pc = 1;
			break;
		case 4:
			throw StopIteration;
		}
	}
}

が返ってくる。こんなのが欲しいなー。

JavaScript で 32bit int を扱う


追記 (2014/3/21)
最近ではMath.imulというものがあります。

signed int への変換: x | 0
unsigned int への変換: x >>> 0
これで大抵の場合はうまくいく。

IEEE64bit浮動小数点数では整数は2の53乗までしか正確に表現できない。(http://www.tokumaru.org/d/20070531.html)
そのため掛け算の結果がそれを超える場合は結果が合わないことがある

ruby -e 'puts 123456789 * 123456789 & 0xffffffff'
2537071545 # 正しい結果
js -e 'print(123456789 * 123456789 >>> 0)'
2537071544 # 間違った結果

そういう場合は掛け算を自分で実装してしまえばいい。

function mul(a, b) {
	var result = 0;
	a >>>= 0;
	b >>>= 0;
	while (b) {
		if (b & 1) result = (result + a) >>> 0;
		a <<= 1;
		b >>>= 1;
	}
	return result;
}

mul(123456789,123456789); // => 2537071545

あと、FirefoxGoogle ChromeではRubyのFIXNUMのように絶対値が2^30-1以下の整数なら即値として最適化され、それより大きい場合はheapをとる模様。
結果が2^30-1より大きくなる場合は遅くなるので速度が要求される場面では二つの数値型変数に分けるなどの工夫をするとよい。
論理演算2 (mitsunari@cybozu labs)
分割してみる (mitsunari@cybozu labs)

追記 (2009-11-09T19:35:58+09:00)

http://homepage2.nifty.com/magicant/sjavascript/mt.htmlのソースを読んで掛け算は以下でいいことを知った。

function mul(a, b) {
	var a1 = a >>> 16, a2 = a & 0xffff;
	var b1 = b >>> 16, b2 = b & 0xffff;
	return (((a1 * b2 + a2 * b1) << 16) + a2 * b2) >>> 0;
}

なぜこれでうまくいくのかは掛け算の筆算を思い出してみればよく分かる。

後ろで定義されている関数を呼び出せるようにするパッチ その2

後ろで定義されている関数を呼び出せるようにするパッチ - fujidigの雑記 の改良。
前のパッチは codegen で識別子の @ がどうこうしているのが心残りでした(SearchSymbolOrRegisterVarまわり)。 識別子の @ の処理とかはプリプロセスで済ますべきだったと思います。

その代わりの実装方法:
問題のモジュール内で@をつけていない識別子はその位置を記録しておきます。そしてプリプロセスの終了時にその識別子から @modname を除いた名前の関数が定義されているか探し、あれば @modname を削除します。

また前回のパッチでは以下のスクリプトコンパイルエラーになっていたのですが、それも修正されています。

#cmpopt optcode 0
#module m
*l
#global

a = *l@m

追記 (2009-06-29T16:54:47+09:00)

このパッチを ML に投稿してみたところ、取り込まれました。やったー。
http://dev.onionsoft.net/trac/changeset/323

Index: hsc3.cpp
===================================================================
--- hsc3.cpp	(リビジョン 305)
+++ hsc3.cpp	(作業コピー)
@@ -161,6 +161,7 @@ int CHsc3::PreProcess( char *fname, char
 	if ( res<-1 ) return -1;
 	res = tk.ExpandFile( outbuf, fname, rname );
 	if ( res<0 ) return -1;
+	tk.FinishPreprocess( outbuf );
 
 	cmpopt = tk.GetCmpOption();
 	if ( cmpopt & CMPMODE_PPOUT	 ) {
Index: membuf.cpp
===================================================================
--- membuf.cpp	(リビジョン 305)
+++ membuf.cpp	(作業コピー)
@@ -7,6 +7,7 @@
 #include <stdlib.h>
 #include <string.h>
 #include <stdarg.h>
+#include <assert.h>
 #include "membuf.h"
 
 //-------------------------------------------------------------
@@ -276,6 +277,13 @@ int CMemBuf::PutFile( char *fname )
 }
 
 
+void CMemBuf::ReduceSize( int new_cur )
+{
+	assert( new_cur >= 0 && new_cur <= cur );
+	cur = new_cur;
+}
+
+
 //-------------------------------------------------------------
 //		Interfaces
 //-------------------------------------------------------------
Index: token.cpp
===================================================================
--- token.cpp	(リビジョン 317)
+++ token.cpp	(作業コピー)
@@ -1345,6 +1345,15 @@ char *CToken::ExpandToken( char *str, in
 	//
 	if (wrtbuf!=NULL) {
 //		AddModuleName( (char *)s2 );
+		if ( strcmp( (char *)s2, fixname ) ) {
+			//	後ろで定義されている関数の呼び出しのために
+			//	モジュール内で@をつけていない識別子の位置を記録する
+			undefined_symbol_t sym;
+			sym.pos = wrtbuf->GetSize();
+			sym.len_include_modname = (int)strlen( fixname );
+			sym.len = (int)strlen( (char *)s2 );
+			undefined_symbols.push_back( sym );
+		}
 		wrtbuf->PutStr( fixname );
 //		wrtbuf->Put( '?' );
 	}
@@ -3338,6 +3347,41 @@ void CToken::SetCommonPath( char *path )
 }
 
 
+void CToken::FinishPreprocess( CMemBuf *buf )
+{
+	//	後ろで定義された関数がある場合、それに書き換える
+	//
+	//	この関数では foo@modname を foo に書き換えるなどバッファサイズが小さくなる変更しか行わない
+	//
+	int read_pos = 0;
+	int write_pos = 0;
+	size_t i;
+	size_t len = undefined_symbols.size();
+	char *p = buf->GetBuffer();
+	for ( i = 0; i < len; i ++ ) {
+		undefined_symbol_t sym = undefined_symbols[i];
+		int pos = sym.pos;
+		int len_include_modname = sym.len_include_modname;
+		int len = sym.len;
+		int id;
+		memmove( p + write_pos, p + read_pos, pos - read_pos );
+		write_pos += pos - read_pos;
+		read_pos = pos;
+		// @modname を消した名前の関数が存在したらそれに書き換え
+		p[pos+len] = '\0';
+		id = lb->Search( p + pos );
+		if ( id >= 0 && lb->GetType(id) == LAB_TYPE_PPMODFUNC ) {
+			memmove( p + write_pos, p + pos, len );
+			write_pos += len;
+			read_pos += len_include_modname;
+		}
+		p[pos+len] = '@';
+	}
+	memmove( p + write_pos, p + read_pos, buf->GetSize() - read_pos );
+	buf->ReduceSize( buf->GetSize() - (read_pos - write_pos) );
+}
+
+
 int CToken::LabelRegist( char **list, int mode )
 {
 	//		ラベル情報を登録
Index: codegen.cpp
===================================================================
--- codegen.cpp	(リビジョン 307)
+++ codegen.cpp	(作業コピー)
@@ -889,7 +889,7 @@ void CToken::GenerateCodePRMF2( void )
 
 			t = lb->GetType(id);
 			if (( t == TYPE_XLABEL )||( t == TYPE_LABEL )) throw CGERROR_LABELNAME;
-			PutCS( t, lb->GetOpt(id), ex );
+			PutCSSymbol( id, ex );
 			GetTokenCG( GETTOKEN_DEFAULT );
 
 			if ( ttype == TK_NONE ) {
@@ -1148,7 +1148,7 @@ void CToken::GenerateCodeVAR( int id, in
 	t = lb->GetType(id);
 	if (( t == TYPE_XLABEL )||( t == TYPE_LABEL )) throw CGERROR_LABELNAME;
 	//
-	PutCS( t, lb->GetOpt(id), ex );
+	PutCSSymbol( id, ex );
 	GetTokenCG( GETTOKEN_DEFAULT );
 
 	if ( t == TYPE_SYSVAR ) return;
@@ -1313,7 +1313,7 @@ void CToken::GenerateCodeCMD( int id )
 	t = lb->GetType(id);
 	opt = lb->GetOpt(id);
 	orgcs = GetCS();
-	PutCS( t, opt & 0xffff, EXFLG_1 );
+	PutCSSymbol( id, EXFLG_1 );
 	if ( t == TYPE_PROGCMD ) CheckInternalProgCMD( opt, orgcs );
 	if ( t == TYPE_CMPCMD ) CheckInternalIF( opt );
 	GetTokenCG( GETTOKEN_DEFAULT );
@@ -1771,12 +1771,18 @@ int CToken::GetParameterResTypeCG( char 
 }
 
 
-void CToken::GenerateCodePP_deffunc( void )
+#define GET_FI_SIZE() ((int)(fi_buf->GetSize() / sizeof(STRUCTDAT)))
+#define GET_FI(n) (((STRUCTDAT *)fi_buf->GetBuffer()) + (n))
+#define STRUCTDAT_INDEX_DUMMY ((short)0x8000)
+
+
+void CToken::GenerateCodePP_deffunc0( int is_command )
 {
-	//		HSP3Codeを展開する(deffunc)
+	//		HSP3Codeを展開する(deffunc / defcfunc)
 	//
 	int i,t,ot,prmid,subid;
-	int clean;
+	int index;
+	int funcflag;
 	int regflag;
 	int prep;
 	char funcname[1024];
@@ -1787,7 +1793,7 @@ void CToken::GenerateCodePP_deffunc( voi
 	GetTokenCG( GETTOKEN_DEFAULT );
 	if ( ttype != TK_OBJ ) throw CGERROR_PP_NAMEREQUIRED;
 
-	if ( !strcmp( cg_str,"prep" ) ) {				// プロトタイプ宣言
+	if ( is_command && !strcmp( cg_str,"prep" ) ) {				// プロトタイプ宣言
 		prep = 1;
 		GetTokenCG( GETTOKEN_DEFAULT );
 		if ( ttype != TK_OBJ ) throw CGERROR_PP_NAMEREQUIRED;
@@ -1799,12 +1805,17 @@ void CToken::GenerateCodePP_deffunc( voi
 		lb->SetFlag( cg_localstruct[i], -1 );		// 以前に指定されたパラメーター名を削除する
 	}
 	cg_localcur = 0;
-	clean = 0;
+	funcflag = 0;
 	regflag = 1;
 
-	i = lb->Search( funcname );
-	if ( i >= 0 ) {
-		throw CGERROR_PP_ALREADY_USE_FUNC;
+	index = -1;
+	int label_id = lb->Search( funcname );
+	if ( label_id >= 0 ) {
+		if ( lb->GetType(label_id) != TYPE_MODCMD ) throw CGERROR_PP_ALREADY_USE_FUNC;
+		index = lb->GetOpt(label_id);
+		if ( index >= 0 && GET_FI(index)->index != STRUCTDAT_INDEX_DUMMY ) {
+			throw CGERROR_PP_ALREADY_USE_FUNC;
+		}
 	}
 
 	PutStructStart();
@@ -1813,8 +1824,8 @@ void CToken::GenerateCodePP_deffunc( voi
 		if ( ttype >= TK_EOL ) break;
 		if ( ttype != TK_OBJ ) throw CGERROR_PP_WRONG_PARAM_NAME;
 
-		if ( !strcmp( cg_str,"onexit" ) ) {
-			clean |= STRUCTDAT_FUNCFLAG_CLEANUP;
+		if ( is_command && !strcmp( cg_str,"onexit" ) ) {
+			funcflag |= STRUCTDAT_FUNCFLAG_CLEANUP;
 			break;
 		}
 
@@ -1832,13 +1843,13 @@ void CToken::GenerateCodePP_deffunc( voi
 			//Mesf( "%s:struct%d",cg_str,subid );
 			if ( t == MPTYPE_IMODULEVAR ) {
 				if ( prm[ lb->GetOpt(i) ].offset != -1 ) throw CGERROR_PP_MODINIT_USED;
-				prm[ lb->GetOpt(i) ].offset = fi_buf->GetSize() / sizeof(STRUCTDAT);
+				prm[ lb->GetOpt(i) ].offset = GET_FI_SIZE();
 				regflag = 0;
 			}
 			if ( t == MPTYPE_TMODULEVAR ) {
 				st = (STRUCTDAT *)fi_buf->GetBuffer();
 				if ( st[ subid ].otindex != 0 ) throw CGERROR_PP_MODTERM_USED;
-				st[ subid ].otindex = fi_buf->GetSize() / sizeof(STRUCTDAT);
+				st[ subid ].otindex = GET_FI_SIZE();
 				regflag = 0;
 			}
 			prmid = PutStructParam( t, subid );
@@ -1867,91 +1878,30 @@ void CToken::GenerateCodePP_deffunc( voi
 	}
 
 	ot = PutOT( GetCS() );
-	i = PutStructEnd( funcname, STRUCTDAT_INDEX_FUNC, ot, clean );
-	if ( regflag ) {
-		lb->Regist( funcname, TYPE_MODCMD, i );
+	if ( index == -1 ) {
+		index = GET_FI_SIZE();
+		fi_buf->PreparePtr( sizeof(STRUCTDAT) );
+		if ( regflag ) {
+			lb->Regist( funcname, TYPE_MODCMD, index );
+		}
+	}
+	if ( label_id >= 0 ) {
+		lb->SetOpt( label_id, index );
 	}
+	int dat_index = is_command ? STRUCTDAT_INDEX_FUNC : STRUCTDAT_INDEX_CFUNC;
+	PutStructEnd( index, funcname, dat_index, ot, funcflag );
 }
 
 
-void CToken::GenerateCodePP_defcfunc( void )
+void CToken::GenerateCodePP_deffunc( void )
 {
-	//		HSP3Codeを展開する(defcfunc)
-	//
-	int i,t,ot,prmid,subid;
-	int funcflag;
-	char funcname[1024];
-	STRUCTPRM *prm;
-
-	/*
-	GetTokenCG( GETTOKEN_DEFAULT );
-	t = GetParameterResTypeCG( cg_str );
-	if ( t <= MPTYPE_NONE ) {
-		throw CGERROR_PP_WRONG_PARAM_NAME;
-	}
-	funcflag = t;
-	*/
-	funcflag = 0;
-
-	GetTokenCG( GETTOKEN_DEFAULT );
-	if ( ttype != TK_OBJ ) throw CGERROR_PP_NAMEREQUIRED;
-	strncpy( funcname, cg_str, 1023 );
-
-	for(i=0;i<cg_localcur;i++) {
-		lb->SetFlag( cg_localstruct[i], -1 );		// 以前に指定されたパラメーター名を削除する
-	}
-	cg_localcur = 0;
-
-
-	PutStructStart();
-	while(1) {
-		GetTokenCG( GETTOKEN_DEFAULT );
-		if ( ttype >= TK_EOL ) break;
-		if ( ttype != TK_OBJ ) throw CGERROR_PP_WRONG_PARAM_NAME;
-		t = GetParameterTypeCG( cg_str );
-		if ( t == MPTYPE_NONE ) throw CGERROR_PP_WRONG_PARAM_NAME;
-		if ( t == MPTYPE_MODULEVAR ) {
-			//	モジュール名指定
-			GetTokenCG( GETTOKEN_DEFAULT );
-			if ( ttype != TK_OBJ ) throw CGERROR_PP_WRONG_PARAM_NAME;
-			i = lb->Search( cg_str );
-			if ( i < 0 ) throw CGERROR_PP_BAD_STRUCT;
-			if ( lb->GetType(i) != TYPE_STRUCT ) throw CGERROR_PP_BAD_STRUCT;
-			prm = (STRUCTPRM *)mi_buf->GetBuffer();
-			subid = prm[ lb->GetOpt(i) ].subid;
-			//Mesf( "%s:struct%d",cg_str,subid );
-			prmid = PutStructParam( t, subid );
-			GetTokenCG( GETTOKEN_DEFAULT );
-
-		} else {
-			prmid = PutStructParam( t, STRUCTPRM_SUBID_STACK );
-			//Mesf( "%d:type%d",prmid,t );
-
-			GetTokenCG( GETTOKEN_DEFAULT );
-			if ( ttype == TK_OBJ ) {
-				//	引数のエイリアス
-				i = lb->Search( cg_str );
-				if ( i >= 0 ) {
-					throw CGERROR_PP_ALREADY_USE_PARAM;
-				}
-				i = lb->Regist( cg_str, TYPE_STRUCT, prmid );
-				cg_localstruct[ cg_localcur++ ] = i;
-				GetTokenCG( GETTOKEN_DEFAULT );
-			}
-		}
+	GenerateCodePP_deffunc0( 1 );
+}
 
-		if ( ttype >= TK_EOL ) break;
-		if ( ttype != TK_NONE ) throw CGERROR_PP_WRONG_PARAM_NAME;
-		if ( val != ',' ) throw CGERROR_PP_WRONG_PARAM_NAME;
-	}
 
-	i = lb->Search( funcname );
-	if ( i >= 0 ) {
-		throw CGERROR_PP_ALREADY_USE_FUNC;
-	}
-	ot = PutOT( GetCS() );
-	i = PutStructEnd( funcname, STRUCTDAT_INDEX_CFUNC, ot, funcflag );
-	lb->Regist( funcname, TYPE_MODCMD, i );
+void CToken::GenerateCodePP_defcfunc( void )
+{
+	GenerateCodePP_deffunc0( 0 );
 }
 
 
@@ -2270,6 +2220,25 @@ int CToken::GenerateCodeBlock( void )
 }
 
 
+void CToken::RegisterFuncLabels( void )
+{
+	//		プリプロセス時のラベル情報から関数を定義
+	//
+	if ( tmp_lb == NULL ) return;
+	int len = tmp_lb->GetCount();
+	for( int i = 0; i < len; i ++ ) {
+		if ( tmp_lb->GetType(i) == LAB_TYPE_PPMODFUNC && tmp_lb->GetFlag(i) >= 0 ) {
+			char *name = tmp_lb->GetName(i);
+			if ( lb->Search(name) >= 0 ) {
+				throw CGERROR_PP_ALREADY_USE_FUNC;
+			}
+			int id = lb->Regist( name, TYPE_MODCMD, -1 );
+			lb->SetData2( id, (char *)&i, sizeof i );
+		}
+	}
+}
+
+
 int CToken::GenerateCodeMain( CMemBuf *buf )
 {
 	//		ソースをHSP3Codeに展開する
@@ -2298,6 +2267,8 @@ int CToken::GenerateCodeMain( CMemBuf *b
 	for( a=0; a<CG_REPLEV_MAX; a++) { repend[a] = -1; }
 
 	try {
+		RegisterFuncLabels();
+
 		while(1) {
 			if ( GenerateCodeBlock() == TK_EOF ) break;
 		}
@@ -2316,6 +2287,15 @@ int CToken::GenerateCodeMain( CMemBuf *b
 				errend++;
 			}
 		}
+		
+		//		関数未処理チェック
+		for( a=0; a<GET_FI_SIZE(); a++ ) {
+			if ( GET_FI(a)->index == STRUCTDAT_INDEX_DUMMY ) {
+				Mesf( "#関数が存在しません [%s]", lb->GetName(GET_FI(a)->otindex) );
+				errend++;
+			}
+		}
+		
 		if ( errend ) throw CGERROR_FATAL;
 	}
 	catch ( CGERROR code ) {
@@ -2360,6 +2340,29 @@ void CToken::PutCS( int type, double val
 }
 
 
+void CToken::PutCSSymbol( int label_id, int exflag )
+{
+	//		まだ定義されていない関数の呼び出しがあったら仮登録する
+	//
+	int type = lb->GetType(label_id);
+	int value = lb->GetOpt(label_id);
+	if ( type == TYPE_MODCMD && value == -1 ) {
+		int id = *(int *)lb->GetData2(label_id);
+		tmp_lb->AddReference( id );
+		
+		STRUCTDAT st = { STRUCTDAT_INDEX_DUMMY };
+		st.otindex = label_id;
+		value = GET_FI_SIZE();
+		fi_buf->PutData( &st, sizeof(STRUCTDAT) );
+		lb->SetOpt( label_id, value );
+	}
+	if ( exflag & EXFLG_1 && type != TYPE_VAR && type != TYPE_STRUCT ) {
+		value &= 0xffff;
+	}
+	PutCS( type, value, exflag );
+}
+
+
 int CToken::GetCS( void )
 {
 	//		Get current CS index
@@ -2553,7 +2556,7 @@ int CToken::PutStructParam( short mptype
 
 	prm.mptype = mptype;
 	if ( extype == STRUCTPRM_SUBID_STID ) {
-		prm.subid  = fi_buf->GetSize() / sizeof(STRUCTDAT);
+		prm.subid  = (short)GET_FI_SIZE();
 	} else {
 		prm.subid = extype;
 	}
@@ -2617,7 +2620,7 @@ int CToken::PutStructParamTag( void )
 	i = mi_buf->GetSize() / sizeof(STRUCTPRM);
 
 	prm.mptype = MPTYPE_STRUCTTAG;
-	prm.subid  = fi_buf->GetSize() / sizeof(STRUCTDAT);
+	prm.subid  = (short)GET_FI_SIZE();
 	prm.offset = -1;
 
 	cg_stnum++;
@@ -2634,13 +2637,11 @@ void CToken::PutStructStart( void )
 }
 
 
-int CToken::PutStructEnd( char *name, int libindex, int otindex, int funcflag )
+int CToken::PutStructEnd( int i, char *name, int libindex, int otindex, int funcflag )
 {
 	//		STRUCTDATを登録する(モジュール用)
 	//
-	int i;
 	STRUCTDAT st;
-	i = fi_buf->GetSize() / sizeof(STRUCTDAT);
 	st.index = libindex;
 	st.nameidx = PutDS( name );
 	st.subid = i;
@@ -2654,19 +2655,26 @@ int CToken::PutStructEnd( char *name, in
 	} else {
 		st.otindex = otindex;
 	}
-	fi_buf->PutData( &st, sizeof(STRUCTDAT) );
+	*GET_FI(i) = st;
 	//Mesf( "#%d : %s(LIB%d) prm%d size%d ot%d", i, name, libindex, cg_stnum, cg_stsize, otindex );
 	return i;
 }
 
 
+int CToken::PutStructEnd( char *name, int libindex, int otindex, int funcflag )
+{
+	int i = GET_FI_SIZE();
+	fi_buf->PreparePtr( sizeof(STRUCTDAT) );
+	return PutStructEnd( i, name, libindex, otindex, funcflag );
+}
+
 int CToken::PutStructEndDll( char *name, int libindex, int subid, int otindex )
 {
 	//		STRUCTDATを登録する(DLL用)
 	//
 	int i;
 	STRUCTDAT st;
-	i = fi_buf->GetSize() / sizeof(STRUCTDAT);
+	i = GET_FI_SIZE();
 	st.index = libindex;
 	if ( name[0] == '*' ) {
 		st.nameidx = -1;
Index: membuf.h
===================================================================
--- membuf.h	(リビジョン 305)
+++ membuf.h	(作業コピー)
@@ -47,6 +47,7 @@ public:
 	int SaveFile( char *fname );
 	char *GetFileName( void );
 	int GetSize( void ) { return cur; }
+	void ReduceSize( int new_cur );
 	char *PreparePtr( int sz );
 
 private:
Index: token.h
===================================================================
--- token.h	(リビジョン 305)
+++ token.h	(作業コピー)
@@ -5,6 +5,8 @@
 #ifndef __token_h
 #define __token_h
 
+#include <vector>
+
 // token type
 #define TK_NONE 0
 #define TK_OBJ 1
@@ -134,6 +136,7 @@ public:
 
 	int ExpandLine( CMemBuf *buf, CMemBuf *src, char *refname );
 	int ExpandFile( CMemBuf *buf, char *fname, char *refname );
+	void FinishPreprocess( CMemBuf *buf );
 	void SetCommonPath( char *path );
 	int SetAdditionMode( int mode );
 
@@ -159,6 +162,7 @@ public:
 	int GenerateCode( CMemBuf *srcbuf, char *oname, int mode );
 
 	void PutCS( int type, int value, int exflg );
+	void PutCSSymbol( int label_id, int exflag );
 	int GetCS( void );
 	void PutCS( int type, double value, int exflg );
 	int PutOT( int value );
@@ -176,6 +180,7 @@ public:
 	int PutStructParamTag( void );
 	void PutStructStart( void );
 	int PutStructEnd( char *name, int libindex, int otindex, int funcflag );
+	int PutStructEnd( int i, char *name, int libindex, int otindex, int funcflag );
 	int PutStructEndDll( char *name, int libindex, int subid, int otindex );
 
 	void CalcCG( int ex );
@@ -249,6 +254,7 @@ private:
 	//		For Code Generate
 	//
 	int GenerateCodeMain( CMemBuf *src );
+	void RegisterFuncLabels( void );
 	int GenerateCodeBlock( void );
 	int GenerateCodeSub( void );
 	void GenerateCodePP( char *buf );
@@ -266,6 +272,7 @@ private:
 
 	void GenerateCodePP_regcmd( void );
 	void GenerateCodePP_cmd( void );
+	void GenerateCodePP_deffunc0( int is_command );
 	void GenerateCodePP_deffunc( void );
 	void GenerateCodePP_defcfunc( void );
 	void GenerateCodePP_uselib( void );
@@ -352,6 +359,12 @@ private:
 	char modname[MODNAME_MAX+2];	// Module Name Prefix
 	int	modgc;						// Global counter for Module
 	int enumgc;						// Global counter for Enum
+	typedef struct undefined_symbol_t {
+		int pos;
+		int len_include_modname;
+		int len;
+	} undefined_symbol_t;
+	std::vector<undefined_symbol_t> undefined_symbols;
 
 	//		for CodeGenerator
 	//

ラベル型変数を使って無理やり動的メソッド呼び出しを実現してみる

※ 黒魔術注意。この記事には実用的なスクリプトはありません。
dog_cry_impl, doc_cry と二段構成になっていて、 animal_cry を #modfunc でなく #deffunc なのは、メンバの参照時に違うモジュール内の #modfunc からジャンプしているかチェックしてそのときエラーになるから。(code_get の TYPE_STRUCT でちゃんとチェックしてない - fujidigの雑記を参照)

#module mod_animal vtbl
#modfunc get_vtbl var r, int n
	r = vtbl.n
	return
#deffunc animal_cry var this, local lab
	get_vtbl this, lab, 0
	goto lab
#global

#module mod_dog vtbl, m_name
#modinit str name
	vtbl = *dog_cry_label
	m_name = name
	return
#modfunc dog_cry_impl
	mes m_name + "「わんわん!」"
	return
#deffunc dog_cry var this
*dog_cry_label
	dog_cry_impl this
	return
#global

#module mod_cat vtbl, m_name
#modinit str name
	vtbl = *cat_cry_label
	m_name = name
	return
#modfunc cat_cry_impl
	mes m_name + "「にゃ〜」"
	return
#deffunc cat_cry var this
*cat_cry_label
	cat_cry_impl this
	return
#global

newmod pochi, mod_dog, "ポチ"
newmod tama, mod_cat, "タマ"

animal_cry pochi
animal_cry tama