anon/ati
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

PLati: algo compiles

Browse Source
This commit is contained in:
anon 2023-02-13 13:39:26 +01:00
parent fd57b438be
commit 71e2027ab8
1 changed files with 63 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
PLati/algo.pks
View File

@ -15,73 +15,72 @@ CREATE OR REPLACE PACKAGE algo AS
PROCEDURE do_eval (opr1 ASTRING, oper CHAR, opr2 ASTRING); PROCEDURE do_eval (opr1 ASTRING, oper CHAR, opr2 ASTRING);
PROCEDURE pop (head INT); PROCEDURE pop (head IN OUT INT);
PROCEDURE push (head INT); PROCEDURE push (head IN OUT INT);
FUNCTION jump (head INT, jmp INT, dest ASTRING, push CHAR) RETURN BOOLEAN; FUNCTION jump (head IN OUT INT, jmp INT, dest ASTRING, push CHAR) RETURN BOOLEAN;
PROCEDURE call_ (head INT, jmp INT, dest ASTRING, is_push BOOLEAN); PROCEDURE call_ (head IN OUT INT, dest ASTRING, is_push BOOLEAN);
END; END;
/ /
CREATE OR REPLACE PACKAGE BODY algo AS CREATE OR REPLACE PACKAGE BODY algo AS
PROCEDURE init IS PROCEDURE init IS
BEGIN BEGIN
REPLACE INTO TABLE vars VALUES INSERT INTO vars VALUES ('eval', '');
('eval', ''), INSERT INTO vars VALUES ('ret', '');
('ret', ''), INSERT INTO vars VALUES ('argv-0', '');
('argv-0', ''), INSERT INTO vars VALUES ('argv-1', '');
('argv-1', ''), INSERT INTO vars VALUES ('argv-2', '');
('argv-2', ''), INSERT INTO vars VALUES ('argv-3', '');
('argv-3', ''), INSERT INTO vars VALUES ('argv-4', '');
('argv-4', ''), INSERT INTO vars VALUES ('argv-5', '');
('argv-5', ''), INSERT INTO vars VALUES ('argv-6', '');
('argv-6', ''), INSERT INTO vars VALUES ('argv-7', '');
('argv-7', ''), INSERT INTO vars VALUES ('argv-8', '');
('argv-8', ''), INSERT INTO vars VALUES ('argv-9', '');
('argv-9', '')
;
END; END;
PROCEDURE assign_ ( PROCEDURE assign_ (
name_ VARCHAR(128), name_ ASTRING,
val VARCHAR(128) val ASTRING
) IS ) IS
BEGIN BEGIN
INSERT INTO vars (name_, val); INSERT INTO vars VALUES (name_, val);
END; END;
FUNCTION arref AS ASTRING (s ASTRING) FUNCTION arref (s ASTRING) RETURN ASTRING AS
DECLARE
p INT; p INT;
subs ASTRING; subs ASTRING;
s_ ASTRING := s;
BEGIN BEGIN
WHILE TRUE LOOP WHILE TRUE LOOP
p = INSTR(s, '-', -1); p := INSTR(s_, '-', -1);
IF p THEN IF p != 0 THEN
subs := s.SUBSTR(p); subs := SUBSTR(s_, p);
s := REPLACE(s, subs, deref_(subs)); s_ := REPLACE(s_, subs, deref_(subs));
ELSE ELSE
EXIT; EXIT;
END IF; END IF;
END LOOP; END LOOP;
RETURN s; RETURN s_;
END; END;
FUNCTION deref_ AS ASTRING (s ASTRING) FUNCTION deref_ (s ASTRING) RETURN ASTRING AS
varval ASTRING; varval ASTRING;
s_ ASTRING := s;
BEGIN BEGIN
s := arref(s); s_ := arref(s_);
SELECT value INTO varval FROM vars WHERE name = s; SELECT value INTO varval FROM vars WHERE name = s_;
RETURN varval; RETURN varval;
EXCEPTION EXCEPTION
WHEN OTHERS THEN WHEN OTHERS THEN
RETURN s; RETURN s_;
END; END;
FUNCTION aint AS INT (s ASTRING) FUNCTION aint (s ASTRING) RETURN INT AS
sign_ BOOLEAN := TRUE; sign_ BOOLEAN := TRUE;
i INT := 0; i INT := 0;
buf ASTRING := ''; buf ASTRING := '';
@ -89,30 +88,31 @@ CREATE OR REPLACE PACKAGE BODY algo AS
WHILE TRUE LOOP WHILE TRUE LOOP
CASE SUBSTR(s, i, 1) CASE SUBSTR(s, i, 1)
WHEN '-' THEN WHEN '-' THEN
sign := NOT(XOR(sign, FALSE)); sign_ := NOT(XOR(sign_, FALSE));
WHEN '+' THEN WHEN '+' THEN
sign := NOT(XOR(sign, TRUE)); sign_ := NOT(XOR(sign_, TRUE));
ELSE ELSE
EXIT; EXIT;
END CASE; END CASE;
i := i + 1; i := i + 1;
END LOOP; END LOOP;
s := REPLACE(s, SUBSTR(s, 0, i)); FOR h IN i .. LENGTH(s) LOOP
IF SUBSTR(s, i, 1) IN ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9') THEN
FOR index IN 0 .. LENGTH(s) LOOP buf := buf + SUBSTR(s, h+i, 1);
IF SUBSTR(index, 1) IN ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9') THEN
buf := ret + SUBSTR(index, 1);
END IF; END IF;
END LOOP; END LOOP;
RETURN TO_NUMBER(buf) * (IF sign_ THEN 1 ELSE -1 END IF); IF sign_ THEN
RETURN TO_NUMBER(buf) * 1;
ELSE
RETURN TO_NUMBER(buf) * -1;
END IF;
END; END;
PROCEDURE do_eval (opr1 ASTRING, oper CHAR, opr2 ASTRING) PROCEDURE do_eval (opr1 ASTRING, oper CHAR, opr2 ASTRING) AS
DECLARE
res ASTRING := ''; res ASTRING := '';
BEGIN BEGIN
CASE oper CASE oper
@ -120,66 +120,68 @@ CREATE OR REPLACE PACKAGE BODY algo AS
res := opr1; res := opr1;
WHEN '.' THEN WHEN '.' THEN
res := CONCAT(opr1, opr2); res := CONCAT(opr1, opr2);
WHEN '-' THEN -- #placeholder<oper>
res := aint(opr1) - aint(opr2);
ELSE ELSE
NULL; NULL;
END CASE; END CASE;
UPDATE vars SET (value, res) WHERE name = 'eval'; UPDATE vars SET value = res WHERE name = 'eval';
END; END;
PROCEDURE pop (head INT) PROCEDURE pop (head IN OUT INT) AS
DECLARE
EMPTY_STACK EXCEPTION; EMPTY_STACK EXCEPTION;
cbp INT;
BEGIN BEGIN
IF SELECT COUNT(bp) FROM callstack = 1 THEN SELECT COUNT(bp) INTO cbp FROM callstack;
IF cbp = 1 THEN
RAISE EMPTY_STACK; RAISE EMPTY_STACK;
END IF END IF;
DELETE FROM callstack WHERE rowid = (SELECT MAX(rowid) FROM callstack); DELETE FROM callstack WHERE rowid = (SELECT MAX(rowid) FROM callstack);
SELECT bp INTO HEAD 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; head := head + 1;
END; END;
PROCEDURE push (head INT) PROCEDURE push (head IN OUT INT) AS
BEGIN BEGIN
UPDATE callstack SET (bp, head) WHERE rowid = (SELECT MAX(rowid) FROM callstack); UPDATE callstack SET bp = head WHERE rowid = (SELECT MAX(rowid) FROM callstack);
INSERT INTO callstack VALUES (0); INSERT INTO callstack VALUES (0);
END; END;
FUNCTION jump AS BOOLEAN (head INT, jmp INT, dest ASTRING, push CHAR) FUNCTION jump (head IN OUT INT, jmp INT, dest ASTRING, push CHAR) RETURN BOOLEAN AS
DECLARE ret BOOLEAN := FALSE;
ret BOOLEAN = FALSE; evalval ASTRING;
BEGIN BEGIN
CASE jmp CASE jmp
WHEN 0 THEN WHEN 0 THEN
EXIT; NULL;
WHEN 1 THEN WHEN 1 THEN
call_(head, dest, (push != EMPTY_VAL)); call_(head, dest, (push != EMPTY_VAL));
ret := TRUE; ret := TRUE;
WHEN 2 THEN WHEN 2 THEN
IF SELECT value FROM vars WHERE name = 'eval' = TRUE_ THEN SELECT value INTO evalval FROM vars WHERE name = 'eval';
IF evalval = TRUE_ THEN
call_(head, dest, (push != EMPTY_VAL)); call_(head, dest, (push != EMPTY_VAL));
ret := TRUE; ret := TRUE;
END IF; END IF;
WHEN 3 THEN WHEN 3 THEN
IF SELECT value FROM vars WHERE name = 'eval' = FALSE_ THEN SELECT value INTO evalval FROM vars WHERE name = 'eval';
IF evalval = FALSE_ THEN
call_(head, dest, (push != EMPTY_VAL)); call_(head, dest, (push != EMPTY_VAL));
ret := TRUE; ret := TRUE;
END IF; END IF;
END CASE; END CASE;
RETURN ret; RETURN ret;
END; END;
PROCEDURE call_ (head INT, jmp INT, dest ASTRING, is_push BOOLEAN) PROCEDURE call_ (head IN OUT INT, dest ASTRING, is_push BOOLEAN) AS
BEGIN BEGIN
IF dest = 'return' THEN IF dest = 'return' THEN
pop(head); pop(head);
RETURN; RETURN;
END IF; END IF;
IF is_push THEN push(head) END IF; IF is_push THEN push(head); END IF;
head := TO_NUMBER(deref_(head)); head := TO_NUMBER(deref_(head));
END; END;