UWSCでBrainf*ck

UWSCでBrainf*ckのインタープリターを書いてみた。

Brainf_ck.uws

OPTION EXPLICIT

IFB GET_UWSC_NAME = "Brainf_ck.uws" THEN
	IFB LENGTH(PARAM_STR) THEN
		// ジョジョ言語用 http://d.hatena.ne.jp/toyoshi/20100208/1265587511
		Brainf_ck.Dictionary["スターフィンガ"] = ">"
		Brainf_ck.Dictionary["ロードローラ"] = "<"
		Brainf_ck.Dictionary["オラ"] = "+"
		Brainf_ck.Dictionary["無駄"] = "-"
		Brainf_ck.Dictionary["ハーミットパープル"] = "."
		Brainf_ck.Dictionary["新手のスタンド使いか"] = ","
		Brainf_ck.Dictionary["あ・・・ありのまま今起こったことを話すぜ"] = "["
		Brainf_ck.Dictionary["ザ・ワールド"] = "]"
		Brainf_ck.Dictionary["やれやれだぜ"] = ">"
		Brainf_ck.Dictionary["貧弱"] = "<"

		DIM ret = Brainf_ck.Main(PARAM_STR)
		Brainf_ck.Log(ret)
		INPUT("Result:", ret)
	ELSE
		// とりあえず、Hello, world!
		DIM src[] =	"+++++++++[>++++++++>+++++++++++>+++++<<<-]", _
					">.>++.+++++++..+++.>-.------------.<++++++", _
					"++.--------.+++.------.--------.>+."
		Brainf_ck.Log(Brainf_ck.Main(src))
	ENDIF
ENDIF

MODULE Brainf_ck

	const WHILE = "["
	const LOOP = "]"
	const DATA_MAX = 65536

	HASHTBL _mem
	DIM _index
	HASHTBL _while
	DIM _do
	DIM _regex

	PUBLIC HASHTBL Dictionary

	PROCEDURE Brainf_ck
		_regex = CreateOleObj("VBScript.RegExp")
		_regex.Global = TRUE
		_regex.Pattern = "[^-+<>.,[\]]"
		Clear()
	FEND

	PROCEDURE Clear()
		_mem = HASH_REMOVEALL
		_mem[0] = 0
		_index = 0
		_while = HASH_REMOVEALL
		_do = 0
	FEND

	PROCEDURE Log(msg,n=0)
		DIM t = GETTIME()
		msg = G_TIME_HH2+":"+G_TIME_NN2+":"+G_TIME_SS2+"."+G_TIME_ZZ2+" "+msg
		IF n > 0 THEN msg = msg + " (" + (t - n) + ")"
		PRINT msg
	FEND

	PROCEDURE PrivateMove(d)
		IFB _do = 0 THEN
			DIM index = _index + d
			IFB index < 0 THEN
				Log("Error(decrement) " + index)
				index = 0
			ENDIF
			WHILE index >= LENGTH(_mem)
				_mem[LENGTH(_mem)] = 0
			WEND
			_index = index
		ENDIF
	FEND
	PROCEDURE PrivateAdd(d)
		IFB _do = 0 THEN
			d = d + _mem[_index]
			d = d MOD DATA_MAX
			IF d < 0 THEN d = d + DATA_MAX
			_mem[_index] = d
		ENDIF
	FEND
	FUNCTION PrivatePut()
		IFB _do = 0 THEN
			RESULT = CHR(_mem[_index])
		ELSE
			RESULT = ""
		ENDIF
	FEND
	PROCEDURE PrivateGet()
		IFB _do = 0 THEN
			_mem[_index] = VAL(INPUT("0-" + (DATA_MAX - 1)))
		ENDIF
	FEND
	PROCEDURE PrivateWhile()
		IFB _do = 0 AND _mem[_index] > 0 THEN
			_while[LENGTH(_while)] = ""
		ELSE
			_do = _do + 1
		ENDIF
	FEND
	FUNCTION PrivateLoop(code)
		RESULT = code
		IFB _do = 0 THEN
			DIM i = LENGTH(_while) - 1, part
			part = _while[i]
			IFB _mem[_index] > 0 THEN
				RESULT = part + LOOP + code
				_while[i] = ""
			ELSE
				IF i > 0 THEN _while[i - 1] = _while[i - 1] + WHILE + part + LOOP
				part = _while[i, HASH_REMOVE]
			ENDIF
		ELSE
			_do = _do - 1
			IFB _do < 0 THEN
				Log("Error(While - Loop)")
				_do = 0;
			ENDIF
		ENDIF
	FEND

	FUNCTION PrivateTrans(code)
		DIM i
		FOR i = 0 TO LENGTH(Dictionary) - 1
			code = REPLACE(code, Dictionary[i, HASH_KEY], Dictionary[i, HASH_VAL])
		NEXT
		RESULT = _regex.Replace(code, "")
	FEND

	FUNCTION Run(code)
		DIM ret = "", part = PrivateTrans("" + code)
		WHILE LENGTH(part)
			DIM c = COPY(part, 1, 1)
			part = COPY(part, 2)
			SELECT c
				CASE ">"
					PrivateMove(1)
				CASE "<"
					PrivateMove(-1)
				CASE "+"
					PrivateAdd(1)
				CASE "-"
					PrivateAdd(-1)
				CASE "."
					ret = ret + PrivatePut()
				CASE ","
					PrivateGet()
				CASE WHILE
					PrivateWhile()
					c = 0
				CASE LOOP
					part = PrivateLoop(part)
					c = 0
				DEFAULT
					// nop
					c = 0
			SELEND
			IFB LENGTH(_while) AND c <> 0 THEN
				_while[LENGTH(_while)-1] = _while[LENGTH(_while)-1] + c
			ENDIF
		WEND
		RESULT = ret
	FEND

	FUNCTION Main(args[])
		DIM ret = "", i
		FOR i = 0 TO LENGTH(args) - 1
			IFB FOPEN(args[i], F_EXISTS) THEN
				DIM f = FOPEN(args[i], F_READ OR F_TAB), j
				FOR j = 1 TO FGET(f, F_LINECOUNT)
					ret = ret + Run(FGET(f, j))
				NEXT
				FCLOSE(f)
			ELSE
				ret = ret + Run(args[i])
			ENDIF
		NEXT
		RESULT = ret
	FEND

ENDMODULE