Created by VadimD last modified 2018-03-11
txr.gml
      #define txr_init
#macro txr_error global.txr_error_val

// parser:
#macro txr_parse_tokens global.txr_parse_tokens_val
txr_parse_tokens = ds_list_create();
enum txr_token {
	eof = 0, // <end of file>
    op = 1, // + - * / % div
    par_open = 2, // (
    par_close = 3, // )
    number = 4, // 37
    ident = 5, // some
}
enum txr_op {
    mul  = 0x01, // *
    fdiv = 0x02, // /
    fmod = 0x03, // %
    idiv = 0x04, // div
    add  = 0x10, // +
    sub  = 0x11, // -
	maxp = 0x20 // maximum priority
}

// builder:
#macro txr_build_list global.txr_build_list_val
#macro txr_build_node global.txr_build_node_val
#macro txr_build_pos  global.txr_build_pos_val
#macro txr_build_len  global.txr_build_len_val
enum txr_node {
	number = 1, // (number)
	ident = 2, // (name)
	unop = 3, // (unop, node)
	binop = 4, // (binop, a, b)
}
enum txr_unop {
	negate = 1, // -value
}
enum txr_build_flag {
	no_ops = 1
}

// compiler:
#macro txr_compile_list global.txr_compile_list_val
txr_compile_list = ds_list_create();
enum txr_action {
	number = 1, // (value): push(value)
	ident = 2, // (name): push(self[name])
	unop = 3, // (unop): push(-pop())
	binop = 4, // (op): a = pop(); b = pop(); push(binop(op, a, b))
}

#define txr_parse
var str = argument0;
var len = string_length(str);
var out = txr_parse_tokens;
ds_list_clear(out);
var pos = 1;
while (pos <= len) {
    var start = pos;
    var char = string_ord_at(str, pos);
    pos += 1;
    switch (char) {
		case ord(" "): case ord("\t"): case ord("\r"): case ord("\n"): break;
		case ord("("): ds_list_add(out, [txr_token.par_open, start]); break;
		case ord(")"): ds_list_add(out, [txr_token.par_close, start]); break;
        case ord("+"): ds_list_add(out, [txr_token.op, start, txr_op.add]); break;
		case ord("-"): ds_list_add(out, [txr_token.op, start, txr_op.sub]); break;
		case ord("*"): ds_list_add(out, [txr_token.op, start, txr_op.mul]); break;
		case ord("/"): ds_list_add(out, [txr_token.op, start, txr_op.fdiv]); break;
		case ord("%"): ds_list_add(out, [txr_token.op, start, txr_op.fmod]); break;
		default:
			if (char >= ord("0") && char <= ord("9")) {
				while (pos <= len) {
					char = string_ord_at(str, pos);
					if (char >= ord("0") && char <= ord("9")) {
						pos += 1;
					} else break;
				}
				var val = real(string_copy(str, start, pos - start));
				ds_list_add(out, [txr_token.number, start, val]);
			}
			else if (char == ord("_")
				|| (char >= ord("a") && char <= ord("z"))
				|| (char >= ord("A") && char <= ord("Z"))
			) {
				while (pos <= len) {
					char = string_ord_at(str, pos);
					if (char == ord("_")
						|| (char >= ord("0") && char <= ord("9"))
						|| (char >= ord("a") && char <= ord("z"))
						|| (char >= ord("A") && char <= ord("Z"))
					) {
						pos += 1;
					} else break;
				}
				var name = string_copy(str, start, pos - start);
				switch (name) {
					case "mod": ds_list_add(out, [txr_token.op, start, txr_op.fmod]); break;
					case "div": ds_list_add(out, [txr_token.op, start, txr_op.idiv]); break;
					default: ds_list_add(out, [txr_token.ident, start, name]); break;
				}
			}
			else {
				ds_list_clear(out);
				return txr_throw("Unexpected character `" + chr(char) + "`", start);
			}
    }
}
ds_list_add(out, [txr_token.eof, len + 1]);
return false;

#define txr_throw
/// @desc txr_throw(error_text, position)
/// @param error_text
/// @param position
txr_error = argument0 + " at position " + string(argument1);
return true;

#define txr_build
txr_build_list = txr_parse_tokens;
txr_build_pos = 0;
txr_build_len = ds_list_size(txr_build_list);
if (txr_build_expr(0)) return true;
if (txr_build_pos < txr_build_len - 1) {
	return txr_throw_at("Trailing data", txr_parse_tokens[|txr_build_pos]);
} else return false;

#define txr_build_expr
/// @param flags
var flags = argument0;
var tk = txr_build_list[|txr_build_pos++];
switch (tk[0]) {
	case txr_token.number: txr_build_node = [txr_node.number, tk[1], tk[2]]; break;
	case txr_token.ident: txr_build_node = [txr_node.ident, tk[1], tk[2]]; break;
	case txr_token.par_open: // (value)
		if (txr_build_expr(0)) return true;
		tk = txr_build_list[|txr_build_pos++];
		if (tk[0] != txr_token.par_close) return txr_throw_at("Expected a `)`", tk);
		break;
	case txr_token.op: // -value, +value
		switch (tk[2]) {
			case txr_op.add:
				if (txr_build_expr(txr_build_flag.no_ops)) return true;
				break;
			case txr_op.sub:
				if (txr_build_expr(txr_build_flag.no_ops)) return true;
				txr_build_node = [txr_node.unop, tk[1], txr_unop.negate, txr_build_node];
				break;
			default: return txr_throw_at("Unexpected token", tk);
		}
		break;
	default: return txr_throw_at("Unexpected token", tk);
}
if ((flags & txr_build_flag.no_ops) == 0) {
	tk = txr_build_list[|txr_build_pos];
	if (tk[0] == txr_token.op) {
		txr_build_pos += 1;
		if (txr_build_ops(tk)) return true;
	}
}
return false;

#define txr_build_ops
/// @param first
var nodes = ds_list_create();
ds_list_add(nodes, txr_build_node);
var ops = ds_list_create();
ds_list_add(ops, argument0);
//
var tk;
while (1) {
	// try to read the next expression and add it to list:
	if (txr_build_expr(txr_build_flag.no_ops)) {
		ds_list_destroy(nodes);
		ds_list_destroy(ops);
		return true;
	}
	ds_list_add(nodes, txr_build_node);
	// if followed by an operator, add that too, stop otherwise:
	tk = txr_build_list[|txr_build_pos];
	if (tk[0] == txr_token.op) {
		txr_build_pos++;
		ds_list_add(ops, tk);
	} else break;
}
// Nest operators from top to bottom priority:
var n = ds_list_size(ops);
var pmax = (txr_op.maxp >> 4);
var pri = 0;
while (pri < pmax) {
	for (var i = 0; i < n; i++) {
		tk = ops[|i];
		if ((tk[2] >> 4) != pri) continue;
		nodes[|i] = [txr_node.binop, tk[1], tk[2], nodes[|i], nodes[|i + 1]];
		ds_list_delete(nodes, i + 1);
		ds_list_delete(ops, i);
		n -= 1; i -= 1;
	}
	pri += 1;
}
// Cleanup and return:
txr_build_node = nodes[|0];
ds_list_destroy(nodes);
ds_list_destroy(ops);
return false;

#define txr_throw_at
/// @param error_text
/// @param token
var tk = argument1;
if (tk[0] == txr_token.eof) {
	return txr_throw(argument0, "<EOF>");
} else return txr_throw(argument0, tk[1]);

#define txr_compile_expr
/// @param node
var q = argument0;
var out = txr_compile_list;
switch (q[0]) {
	case txr_node.number: ds_list_add(out, [txr_action.number, q[1], q[2]]); break;
	case txr_node.ident: ds_list_add(out, [txr_action.ident, q[1], q[2]]); break;
	case txr_node.unop:
		if (txr_compile_expr(q[3])) return true;
		ds_list_add(out, [txr_action.unop, q[1], q[2]]);
		break;
	case txr_node.binop:
		if (txr_compile_expr(q[3])) return true;
		if (txr_compile_expr(q[4])) return true;
		ds_list_add(out, [txr_action.binop, q[1], q[2]]);
		break;
	default: return txr_throw_at("Cannot compile node type " + string(q[0]), q);
}
return false;

#define txr_compile
if (txr_parse(argument0)) return undefined;
if (txr_build()) return undefined;
var out = txr_compile_list;
ds_list_clear(out);
if (txr_compile_expr(txr_build_node)) return undefined;
var n = ds_list_size(out);
var arr = array_create(n);
for (var i = 0; i < n; i++) arr[i] = out[|i];
ds_list_clear(out);
return arr;

#define txr_exec
/// @param actions
var arr = argument0;
var len = array_length_1d(arr);
var pos = 0;
var stack = ds_stack_create();
while (pos < len) {
	var q = arr[pos++];
	switch (q[0]) {
		case txr_action.number: ds_stack_push(stack, q[2]); break;
		case txr_action.unop: ds_stack_push(stack, -ds_stack_pop(stack)); break;
		case txr_action.binop:
			var b = ds_stack_pop(stack);
			var a = ds_stack_pop(stack);
			switch (q[2]) {
				case txr_op.add: a += b; break;
				case txr_op.sub: a -= b; break;
				case txr_op.mul: a *= b; break;
				case txr_op.fdiv: a /= b; break;
				case txr_op.fmod: if (b != 0) a %= b; else a = 0; break;
				case txr_op.idiv: if (b != 0) a = a div b; else a = 0; break;
				default: return txr_exec_exit("Can't apply operator " + string(q[2]), q, stack);
			}
			ds_stack_push(stack, a);
			break;
		case txr_action.ident:
			var v = variable_instance_get(id, q[2]);
			if (is_real(v) || is_int64(v) || is_bool(v)) {
				ds_stack_push(stack, v);
			} else return txr_exec_exit("Variable `" + q[2] + "` is not a number", q, stack);
			break;
		default: return txr_exec_exit("Can't run action " + string(q[0]), q, stack);
	}
}
var r = ds_stack_pop(stack);
ds_stack_destroy(stack);
txr_error = "";
return r;

#define txr_exec_exit
/// @param error_text
/// @param action
/// @param stack
ds_stack_destroy(argument2);
return txr_throw(argument0, argument1[1]);

    
Comments (27)

HTTPS
SSH
You can clone a snippet to your computer for local editing. Learn more.
Snippets

YellowAfterlife Tiny Expression Runtime from "A small guide on writing interpreters" post

Comments (27)
