ati/PLati/algo.pks

CREATE OR REPLACE PACKAGE algo AS
	SUBTYPE ASTRING IS VARCHAR(128);
	-- ###
	EMPTY_VAL CONSTANT CHAR(1) := '0';
	TRUE_ CONSTANT CHAR(4) := 'true';
	FALSE_ CONSTANT CHAR(5) := 'false';
	-- ###
	PROCEDURE init;

	PROCEDURE assign_ (name_ ASTRING, val ASTRING);

	FUNCTION arref (s ASTRING) RETURN ASTRING;
	FUNCTION deref_ (s ASTRING) RETURN ASTRING;
	FUNCTION aint (s ASTRING) RETURN INT;

	PROCEDURE do_eval (opr1 ASTRING, oper CHAR, opr2 ASTRING);

	PROCEDURE pop (head IN OUT INT);
	PROCEDURE push (head IN OUT INT);

	FUNCTION jump (head IN OUT INT, jmp INT, dest ASTRING, push CHAR) RETURN BOOLEAN;
	PROCEDURE call_ (head IN OUT INT, dest ASTRING, is_push BOOLEAN);
END;
/

CREATE OR REPLACE PACKAGE BODY algo AS
	PROCEDURE init IS
	BEGIN
		INSERT INTO vars VALUES ('eval', '');
		INSERT INTO vars VALUES ('ret', '');
		INSERT INTO vars VALUES ('argv-0', '');
		INSERT INTO vars VALUES ('argv-1', '');
		INSERT INTO vars VALUES ('argv-2', '');
		INSERT INTO vars VALUES ('argv-3', '');
		INSERT INTO vars VALUES ('argv-4', '');
		INSERT INTO vars VALUES ('argv-5', '');
		INSERT INTO vars VALUES ('argv-6', '');
		INSERT INTO vars VALUES ('argv-7', '');
		INSERT INTO vars VALUES ('argv-8', '');
		INSERT INTO vars VALUES ('argv-9', '');
	END;



	PROCEDURE assign_ (
		name_ ASTRING,
		val ASTRING
	) IS
	BEGIN
		INSERT INTO vars VALUES (name_, val);
	END;



	FUNCTION arref (s ASTRING) RETURN ASTRING AS
		p INT;
		subs ASTRING;
		s_ ASTRING := s;
	BEGIN
		WHILE TRUE LOOP
			p := INSTR(s_, '-', -1);
			IF p != 0 THEN
				subs := SUBSTR(s_, p);
				s_ := REPLACE(s_, subs, deref_(subs));
			ELSE
				EXIT;
			END IF;
		END LOOP;

		RETURN s_;
	END;
	FUNCTION deref_ (s ASTRING) RETURN ASTRING AS
		varval ASTRING;
		s_ ASTRING := s;
	BEGIN
		s_ := arref(s_);
		SELECT value INTO varval FROM vars WHERE name = s_;
		RETURN varval;
	EXCEPTION
		WHEN OTHERS THEN
			RETURN s_;
	END;
	FUNCTION aint (s ASTRING) RETURN INT AS
		sign_ BOOLEAN := TRUE;
		i INT := 0;
		buf ASTRING := '';
	BEGIN
		WHILE TRUE LOOP
			CASE SUBSTR(s, i, 1)
				WHEN '-' THEN
					sign_ := NOT(XOR(sign_, FALSE));
				WHEN '+' THEN
					sign_ := NOT(XOR(sign_, TRUE));
				ELSE
					EXIT;
			END CASE;
			i := i + 1;
		END LOOP;

		FOR h IN i .. LENGTH(s) LOOP
			IF SUBSTR(s, i, 1) IN ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9') THEN
				buf := buf + SUBSTR(s, h+i, 1);
			END IF;
		END LOOP;

		IF sign_ THEN
			RETURN TO_NUMBER(buf) * 1;
		ELSE
			RETURN TO_NUMBER(buf) * -1;
		END IF;
	END;



	PROCEDURE do_eval (opr1 ASTRING, oper CHAR, opr2 ASTRING) AS
		res ASTRING := '';
	BEGIN
		CASE oper
			WHEN EMPTY_VAL THEN
				res := opr1;
			WHEN '.' THEN
				res := CONCAT(opr1, opr2);
				WHEN '%' THEN
					res := MOD(aint(opr1), aint(opr2));
				WHEN '|' THEN
					res := CONCAT(opr1, opr2);
			-- #placeholder<oper> BEGIN
				WHEN '-' THEN
					res := aint(opr1) - aint(opr2);
				WHEN '+' THEN
					res := aint(opr1) + aint(opr2);
				WHEN '*' THEN
					res := aint(opr1) * aint(opr2);
				WHEN '/' THEN
					res := aint(opr1) / aint(opr2);
				WHEN '>' THEN
					IF aint(opr1) > aint(opr2) THEN
						res := TRUE_;
					ELSE
						res := FALSE_;
					END IF;
				WHEN '<' THEN
					IF aint(opr1) < aint(opr2) THEN
						res := TRUE_;
					ELSE
						res := FALSE_;
					END IF;
				WHEN '=' THEN
					IF aint(opr1) = aint(opr2) THEN
						res := TRUE_;
					ELSE
						res := FALSE_;
					END IF;
			-- #placeholder<oper> END
			ELSE
				NULL;
		END CASE;
		UPDATE vars SET value = res WHERE name = 'eval';
	END;



	PROCEDURE pop (head IN OUT INT) AS
		EMPTY_STACK EXCEPTION;
		cbp INT;
	BEGIN
		SELECT COUNT(bp) INTO cbp FROM callstack;
		IF cbp = 1 THEN
			RAISE EMPTY_STACK;
		END IF;
		DELETE FROM callstack WHERE rowid = (SELECT MAX(rowid) FROM callstack);
		SELECT bp INTO head FROM callstack WHERE rowid = (SELECT MAX(rowid) FROM callstack);
		head := head + 1;
	END;
	PROCEDURE push (head IN OUT INT) AS
	BEGIN
		UPDATE callstack SET bp = head WHERE rowid = (SELECT MAX(rowid) FROM callstack);
		INSERT INTO callstack VALUES (0);
	END;



	FUNCTION jump (head IN OUT INT, jmp INT, dest ASTRING, push CHAR) RETURN BOOLEAN AS
		ret BOOLEAN := FALSE;
		evalval ASTRING;
	BEGIN
		CASE jmp
			WHEN 0 THEN
				NULL;
			WHEN 1 THEN
				call_(head, dest, (push != EMPTY_VAL));
				ret := TRUE;
			WHEN 2 THEN
				SELECT value INTO evalval FROM vars WHERE name = 'eval';
				IF evalval = TRUE_ THEN
					call_(head, dest, (push != EMPTY_VAL));
					ret := TRUE;
				END IF;
			WHEN 3 THEN
				SELECT value INTO evalval FROM vars WHERE name = 'eval';
				IF evalval = FALSE_ THEN
					call_(head, dest, (push != EMPTY_VAL));
					ret := TRUE;
				END IF;
		END CASE;
		RETURN ret;
	END;
	PROCEDURE call_ (head IN OUT INT, dest ASTRING, is_push BOOLEAN) AS
	BEGIN
		IF dest = 'return' THEN
			pop(head);
			RETURN;
		END IF;

		IF is_push THEN push(head); END IF;

		head := TO_NUMBER(deref_(head));
	END;
END algo;