openhsp-gc を使って簡易インタプリタ (1)

openhsp-gc と後ろで定義されている関数を呼び出せるようにするパッチのテストとしてちょっとしたインタプリタを作ってみたその途中経過です。openhsp-gc を使って再帰下降パーサの拡張です。

まだ変数代入とif文くらいしかないのであまり面白くありません。

通常の HSP や OpenHSP では動かすことのできないプログラムです。バイナリを公開したのでこちらでお試しください: openhsp-gc-bin.zip

#define global null null_@
dimtype null_, vartype("struct")

#enum global node_type_literal = 1
#enum global node_type_binaryop
#enum global node_type_unaryop
#enum global node_type_varref
#enum global node_type_assign
#enum global node_type_list
#enum global node_type_if

#enum global optype_eq = 256
#enum global optype_ne
#enum global optype_lteq
#enum global optype_gteq
#enum global optype_and
#enum global optype_or
#enum global optype_lsh
#enum global optype_rsh

#module mod_node m_type, m_val, m_children
#modcfunc node_get_type
	return m_type
#modcfunc node_get_val
	return m_val
#modcfunc node_get_child int n
	return m_children(n)
#modcfunc node_get_lhs
	return m_children(0)
#modcfunc node_get_rhs
	return m_children(1)
#modfunc node_set_type int type
	m_type = type
	return
#modfunc node_set_val int val
	m_val = val
	return
#modfunc node_set_val_str str val
	m_val = val
	return
#modfunc node_set_child int n, struct node
	m_children(n) = node
	return
#modfunc node_set_lhs struct node
	m_children(0) = node
	return
#modfunc node_set_rhs struct node
	m_children(1) = node
	return
#defcfunc new_node local instance
	newmod instance, mod_node
	return instance
#defcfunc new_literal_node int val, local instance
	instance = new_node()
	node_set_type instance, node_type_literal
	node_set_val instance, val
	return instance
#defcfunc new_binaryop_node int operator, struct lhs, struct rhs, local instance
	instance = new_node()
	node_set_type instance, node_type_binaryop
	node_set_val instance, operator
	node_set_lhs instance, lhs
	node_set_rhs instance, rhs
	return instance
#defcfunc new_unaryop_node int operator, struct lhs, local instance
	instance = new_node()
	node_set_type instance, node_type_unaryop
	node_set_val instance, operator
	node_set_lhs instance, lhs
	return instance
#defcfunc new_varref_node str name, local instance
	instance = new_node()
	node_set_type instance, node_type_varref
	node_set_val_str instance, name
	return instance
#defcfunc new_assign_node str name, struct rhs, local instance
	instance = new_node()
	node_set_type instance, node_type_assign
	node_set_val_str instance, name
	node_set_child instance, 0, rhs
	return instance
#defcfunc new_list_node local instance
	instance = new_node()
	node_set_type instance, node_type_list
	node_set_val instance, 0 // length
	return instance
#defcfunc new_list_node_1 struct child, local instance
	instance = new_list_node()
	append_list_node instance, child
	return instance
#modfunc append_list_node struct child
	node_set_child thismod, node_get_val(thismod), child
	node_set_val thismod, node_get_val(thismod) + 1
	return
#modcfunc get_list_node_len
	return node_get_val(thismod)
#defcfunc new_if_node struct cond, struct then_part, struct else_part, local instance
	instance = new_node()
	node_set_type instance, node_type_if
	node_set_child instance, 0, cond
	node_set_child instance, 1, then_part
	node_set_child instance, 2, else_part
	return instance
#modcfunc get_if_node_cond
	return node_get_child(thismod, 0)
#modcfunc get_if_node_then
	return node_get_child(thismod, 1)
#modcfunc get_if_node_else
	return node_get_child(thismod, 2)
#modcfunc inspect_node local lhs, local rhs
	if thismod == null {
		return "null"
	}
	switch m_type
	case node_type_literal
		return str(m_val)
	case node_type_binaryop
		lhs = inspect_node(node_get_lhs(thismod))
		rhs = inspect_node(node_get_rhs(thismod))
		return strf("(%s %s %s)", optype_to_str(m_val), lhs, rhs)
	case node_type_unaryop
		lhs = inspect_node(node_get_lhs(thismod))
		return strf("(%s %s)", optype_to_str(m_val), lhs)
	case node_type_varref
		return m_val
	case node_type_assign
		return strf("(= %s %s)", m_val, inspect_node(node_get_child(thismod, 0)))
	case node_type_list
		return inspect_node_list(thismod)
	case node_type_if
		return inspect_if_node(thismod)
	default
		assert 0
	swend
#modcfunc inspect_node_list local result
	result = "["
	repeat get_list_node_len(thismod)
		if cnt != 0 : result += ", "
		result += inspect_node(node_get_child(thismod, cnt))
	loop
	result += "]"
	return result
#modcfunc inspect_if_node local cond, local then_part, local else_part
	cond = inspect_node(get_if_node_cond(thismod))
	then_part = inspect_node(get_if_node_then(thismod))
	else_part = inspect_node(get_if_node_else(thismod))
	return strf("(if %s %s %s)", cond, then_part, else_part)
#defcfunc optype_to_str int optype
	if optype < 256 : return strf("%c", optype)
	switch optype
#define ctype CT(%1,%2) case optype_%1: return %2 
	CT(eq, "==")
	CT(ne, "!=")
	CT(lteq, "<=")
	CT(gteq, ">=")
	CT(and, "&&")
	CT(or, "||")
	CT(lsh, "<<")
	CT(rsh, "<<")
#undef CT
	swend
	assert 0
#global

#module mod_dict m_dc
#modinit
	newcom m_dc, "Scripting.Dictionary"
	m_dc("compareMode") = 0
	return
#modfunc dict_put str key, int val
	m_dc("Item", key) = val
	return
#modfunc dict_putv str key, var val
	m_dc("Item", key) = val
	return
#modcfunc dict_get str key
	return m_dc("Item", key)
#modfunc dict_remove str key
	m_dc->"Remove" key
	return
#modcfunc dict_has str key
	return m_dc("Exists", key)
#modcfunc dict_size
	return m_dc("Count")
#modfunc dict_clear
	m_dc->"RemoveAll"
	return
#defcfunc new_dict local instance
	newmod instance, mod_dict
	return instance
#global

#module mod_parser m_src, m_pos, m_type, m_val, m_reserved
#enum token_type_num = 256
#enum token_type_ident
#enum token_type_eq
#enum token_type_ne
#enum token_type_lteq
#enum token_type_gteq
#enum token_type_and
#enum token_type_or
#enum token_type_lsh
#enum token_type_rsh
#enum token_type_if
#enum token_type_else
#enum token_type_end
#enum token_type_error
#modinit str src
	m_src = src
	m_pos = 0
	m_reserved = new_dict()
	dict_put m_reserved, "if", token_type_if
	dict_put m_reserved, "else", token_type_else
	return
#define gettoken parser_gettoken thismod
#modfunc parser_gettoken
	while isspace(peek(m_src, m_pos))
		m_pos ++
	wend
	c = peek(m_src, m_pos)
	if isdigit(c) {
		m_type = token_type_num
		m_val = 0
		repeat
			c = peek(m_src, m_pos)
			if isdigit(c) == 0 : break
			m_val = m_val * 10 + (c - '0')
			m_pos ++
		loop
		return
	}
	if ('A' <= c and c <= 'Z') or c == '_' or ('a' <= c and c <= 'z') {
		len = 0
		while ('0' <= c and c <= '9') or ('A' <= c and c <= 'Z') or c == '_' or ('a' <= c and c <= 'z')
			len ++
			c = peek(m_src, m_pos + len)
		wend
		m_type = token_type_ident
		m_val = strmid(m_src, m_pos, len)
		if (dict_has(m_reserved, m_val)) {
			m_type = dict_get(m_reserved, m_val)
			m_val = 0
		}
		m_pos += len
		return
	}
	if c == 0 {
		m_type = token_type_end
		m_val = 0
		return
	}
	m_val = 0
	m_pos ++
	m_type = c
	
	if c == '<' {
		switch peek(m_src, m_pos)
		case '<'
			m_type = token_type_lsh
			m_pos ++
			swbreak
		case '='
			m_type = token_type_lteq
			m_pos ++
		swend
	} else : if c == '>' {
		switch peek(m_src, m_pos)
		case '>'
			m_type = token_type_rsh
			m_pos ++
			swbreak
		case '='
			m_type = token_type_gteq
			m_pos ++
		swend
	} else : if c == '=' {
		if peek(m_src, m_pos) == '=' {
			m_type = token_type_eq
			m_pos ++
		}
	} else : if c == '!' {
		if peek(m_src, m_pos) == '=' {
			m_type = token_type_ne
			m_pos ++
		}
	} else : if c == '&' {
		if peek(m_src, m_pos) == '&' {
			m_type = token_type_and
			m_pos ++
		}
	} else : if c == '|' {
		if peek(m_src, m_pos) == '|' {
			m_type = token_type_or
			m_pos ++
		}
	}
	return
#define ctype accept(%1) parser_accept(thismod, %1)
#modcfunc parser_accept int type
	if m_type == type {
		gettoken
		return 1
	}
	return 0
#define expect(%1) parser_expect thismod, %1
#modfunc parser_expect int type
	if m_type == type {
		gettoken
	} else {
		m_type = token_type_error
	}
	return
#defcfunc token_type_to_op_type int token_type
	if token_type < 256 : return token_type
	switch token_type
#define ctype CT(%1) case token_type_%1: return optype_%1
	CT(eq)
	CT(ne)
	CT(lteq)
	CT(gteq)
	CT(and)
	CT(or)
	CT(lsh)
	CT(rsh)
#undef CT
	swend
	assert 0
#modcfunc parse_factor local val, local result
	if m_type == token_type_num {
		val = m_val
		gettoken
		return new_literal_node(val)
	}
	if m_type == token_type_ident {
		val = m_val
		gettoken
		if m_type == '=' {
			gettoken
			result = parse_expr(thismod)
			return new_assign_node(val, result)
		}
		return new_varref_node(val)
	}
	if accept('(') {
		result = parse_expr(thismod)
		expect ')'
		return result
	}
	m_type = token_type_error
	return null
#modcfunc parse_unary local op
	if m_type == '+' or m_type == '-' or m_type == '!' or m_type == '~' {
		op = token_type_to_op_type(m_type)
		gettoken
		return new_unaryop_node(op, parse_unary(thismod))
	} else {
		return parse_factor(thismod)
	}

#define lvars_parse_binop local op, local result
#define body_parse_binop(%1, %2) \
	result = %1(thismod) : \
	while %2 : \
		op = token_type_to_op_type(m_type) : \
		gettoken : \
		result = new_binaryop_node(op, result, %1(thismod)) : \
	wend : \
	return result

#modcfunc parse_muldiv lvars_parse_binop
	body_parse_binop parse_unary, m_type == '*' or m_type == '/' or m_type == '%'

#modcfunc parse_addsub lvars_parse_binop
	body_parse_binop parse_muldiv, m_type == '+' or m_type == '-'

#modcfunc parse_shift lvars_parse_binop
	body_parse_binop parse_addsub, m_type == token_type_lsh or m_type == token_type_rsh

#modcfunc parse_bitand lvars_parse_binop
	body_parse_binop parse_shift, m_type == '&'

#modcfunc parse_bitor lvars_parse_binop
	body_parse_binop parse_bitand, m_type == '|' or m_type == '^'

#defcfunc is_compare_op int token_type
	if token_type == token_type_eq : return 1
	if token_type == token_type_ne : return 1
	if token_type == '<' : return 1
	if token_type == '>' : return 1
	if token_type == token_type_lteq : return 1
	if token_type == token_type_gteq : return 1
	return 0
#modcfunc parse_compare lvars_parse_binop
	body_parse_binop parse_bitor, is_compare_op(m_type)

#modcfunc parse_and lvars_parse_binop
	body_parse_binop parse_compare, m_type == token_type_and

#modcfunc parse_or lvars_parse_binop
	body_parse_binop parse_and, m_type == token_type_or

#modcfunc parse_condop local result, local then_part, local else_part
	result = parse_or(thismod)
	if accept('?') {
		then_part = new_list_node_1(parse_expr(thismod))
		expect ':'
		else_part = new_list_node_1(parse_condop(thismod))
		result = new_if_node(result, then_part, else_part)
	}
	return result
#modcfunc parse_expr
	return parse_condop(thismod)
#modcfunc parse_if_stmt local cond, local then_part, local else_part
	expect '('
	cond = parse_expr(thismod)
	expect ')'
	then_part = parse_stmt(thismod)
	if accept(token_type_else) {
		else_part = parse_stmt(thismod)
	} else {
		else_part = new_list_node()
	}
	return new_if_node(cond, then_part, else_part)
#modcfunc parse_stmt local result
	if accept(';') {
		return null
	}
	if accept('{') {
		result = parse_stmt_list(thismod)
		expect '}'
		return result
	}
	if accept(token_type_if) {
		return parse_if_stmt(thismod)
	}
	result = parse_expr(thismod)
	expect ';'
	return result
#modcfunc parse_stmt_list local result, local stmt, local pos_bak, local type_bak
	result = new_list_node()
	repeat
		pos_bak = m_pos
		type_bak = m_type
		stmt = parse_stmt(thismod)
		if m_type == token_type_error and m_pos == pos_bak {
			m_type = type_bak
			break
		}
		if stmt != null : append_list_node result, stmt
	loop
	return result
#modcfunc parser_parse local result
	gettoken
	result = parse_stmt_list(thismod)
	if m_type != token_type_end {
		return null
	}
	return result
#defcfunc parse str src, local parser
	newmod parser, mod_parser, src
	return parser_parse(parser)
#global

#module mod_evaluator m_root, m_varmap
#modinit struct root
	m_root = root
	m_varmap = new_dict()
	return
#modcfunc eval_node struct node, local type, local result
	type = node_get_type(node)
	switch type
	case node_type_literal
		return node_get_val(node)
	case node_type_binaryop
		return eval_binaryop_node(thismod, node)
	case node_type_unaryop
		return eval_unaryop_node(thismod, node)
	case node_type_varref
		if dict_has(m_varmap, node_get_val(node)) == 0 {
			error "undefined variable: "+node_get_val(node)
		}
		return dict_get(m_varmap, node_get_val(node))
	case node_type_assign
		result = eval_node(thismod, node_get_child(node, 0))
		dict_put m_varmap, node_get_val(node), result
		return result
	case node_type_list
		result = 0
		repeat get_list_node_len(node)
			result = eval_node(thismod, node_get_child(node, cnt))
		loop
		return result
	case node_type_if
		return eval_if_node(thismod, node)
	default
		assert 0
	swend
#modcfunc eval_binaryop_node struct node, local op, local lhs, local rhs, local result
	op = node_get_val(node)
	lhs = node_get_lhs(node)
	rhs = node_get_rhs(node)
	switch op
#define CT(%1,%2) case %1: return eval_node(thismod, lhs) %2 eval_node(thismod, rhs)
	CT '+', +
	CT '-', -
	CT '*', *
	CT '/', /
	CT '%', \
	CT optype_lsh, <<
	CT optype_rsh, >>
	CT '&', &
	CT '|', |
	CT '^', ^
	CT optype_eq, ==
	CT optype_ne, !=
	CT '<', <
	CT '>', >
	CT optype_lteq, <=
	CT optype_gteq, >=
#undef CT
	case optype_and
		result = eval_node(thismod, lhs)
		if result == 0 : return result
		return eval_node(thismod, rhs)
	case optype_or
		result = eval_node(thismod, lhs)
		if result : return result
		return eval_node(thismod, rhs)
	swend
	assert 0
#modcfunc eval_unaryop_node struct node, local op, local lhs
	op = node_get_val(node)
	lhs = node_get_lhs(node)
	switch op
	case '+'
		return eval_node(thismod, lhs)
	case '-'
		return - eval_node(thismod, lhs)
	case '!'
		return eval_node(thismod, lhs) != 0
	case '~'
		return eval_node(thismod, lhs) ^ -1
	default
		assert 0
	swend
#modcfunc eval_if_node struct node
	cond = eval_node(thismod, get_if_node_cond(node))
	if cond {
		return eval_node(thismod, get_if_node_then(node))
	} else {
		return eval_node(thismod, get_if_node_else(node))
	}
#defcfunc evaluate struct root, local evaluator
	newmod evaluator, mod_evaluator, root
	return eval_node(evaluator, root)
#global

#module
#defcfunc isdigit int c
	return '0' <= c and c <= '9'
#defcfunc isspace int c
	if c == '\t' : return 1
	if c == 0x0a : return 1 // '\n'
	if c == 0x0b : return 1 // '\v'
	if c == 0x0c : return 1 // '\f'
	if c == '\r' : return 1
	if c == ' '  : return 1
	return 0
#deffunc error str msg
	dialog msg
	end
#global

	program = {"
		a = 42;
		if (a >= 100) {
			b = 1;
		} else if (a >= 0) {
			b = 2;
		} else {
			b = 3;
		}
	"}
	node = parse(program)
	if node == null {
		mes "syntax error"
	} else {
		mes inspect_node(node)
		mes "=> "+evaluate(node)
	}