kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-11-13 01:43:50 +03:00
Code Issues Projects Releases Wiki Activity

plsql: step2,3 basics.

Browse Source
This commit is contained in:
Joel Martin 2016-04-04 23:37:52 -05:00
parent 97df14cdaf
commit 7836cfa36b
9 changed files with 641 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

123
plsql/env.sql Normal file
View File

@ -0,0 +1,123 @@
-- ---------------------------------------------------------
-- env.sql
PROMPT "env.sql start";
CREATE OR REPLACE TYPE env_item FORCE AS OBJECT (
key varchar2(100),
val mal_type
) FINAL;
/
CREATE OR REPLACE TYPE env_data FORCE IS TABLE OF env_item;
/
CREATE OR REPLACE TYPE env_type FORCE AS OBJECT (
idx integer,
outer_idx integer,
data env_data
);
/
CREATE OR REPLACE TYPE env_mem_type FORCE IS TABLE OF env_type;
/
CREATE OR REPLACE PACKAGE env_pkg IS
FUNCTION env_new(mem IN OUT NOCOPY env_mem_type,
outer_idx integer DEFAULT NULL) RETURN integer;
FUNCTION env_set(mem IN OUT NOCOPY env_mem_type,
eidx integer,
key mal_type, val mal_type) RETURN mal_type;
FUNCTION env_find(mem env_mem_type,
eidx integer,
key mal_type) RETURN integer;
FUNCTION env_get(mem env_mem_type,
eidx integer,
key mal_type) RETURN mal_type;
END env_pkg;
/
CREATE OR REPLACE PACKAGE BODY env_pkg IS
FUNCTION env_new(mem IN OUT NOCOPY env_mem_type,
outer_idx integer DEFAULT NULL) RETURN integer IS
eidx integer;
BEGIN
mem.EXTEND();
eidx := mem.COUNT;
mem(eidx) := env_type(eidx, outer_idx, env_data());
RETURN eidx;
END;
FUNCTION env_set(mem IN OUT NOCOPY env_mem_type,
eidx integer,
key mal_type, val mal_type) RETURN mal_type IS
k varchar2(100);
i integer;
cnt integer;
ed env_data;
BEGIN
k := TREAT(key AS mal_str_type).val_str;
SELECT count(*) INTO cnt FROM TABLE(mem(eidx).data) t
WHERE key = k;
IF cnt > 0 THEN
-- TODO: a more efficient way to do this
ed := mem(eidx).data;
FOR i IN ed.FIRST..ed.LAST LOOP
IF ed(i).key = k THEN
mem(eidx).data(i).val := val;
EXIT;
END IF;
END LOOP;
ELSE
mem(eidx).data.EXTEND();
mem(eidx).data(mem(eidx).data.COUNT) := env_item(k, val);
END IF;
RETURN val;
END;
FUNCTION env_find(mem env_mem_type,
eidx integer,
key mal_type) RETURN integer IS
e env_type;
k varchar2(100);
cnt integer;
BEGIN
e := mem(eidx);
k := TREAT(key AS mal_str_type).val_str;
SELECT COUNT(*) INTO cnt FROM TABLE(e.data) t WHERE key = k;
IF cnt > 0 THEN
RETURN e.idx;
ELSIF e.outer_idx IS NOT NULL THEN
e := mem(e.outer_idx);
RETURN env_find(mem, e.idx, key);
ELSE
RETURN NULL;
END IF;
END;
FUNCTION env_get(mem env_mem_type,
eidx integer,
key mal_type) RETURN mal_type IS
idx integer;
e env_type;
k varchar2(100);
v mal_type;
BEGIN
idx := env_find(mem, eidx, key);
k := TREAT(key AS mal_str_type).val_str;
IF idx IS NOT NULL THEN
e := mem(idx);
SELECT t.val INTO v FROM TABLE(e.data) t
WHERE key = k;
RETURN v;
ELSE
raise_application_error(-20005,
'''' || k || ''' not found', TRUE);
END IF;
END;
END env_pkg;
/
show errors;
PROMPT "env.sql finished";

8
plsql/printer.sql
View File

@ -74,10 +74,10 @@ BEGIN
-- FROM each(hash)), ' ') ||
-- '}';
-- END;
-- WHEN type_id = 11 THEN -- native function
-- RETURN '#<function ' ||
-- (SELECT val_string FROM value WHERE value_id = ast) ||
-- '>';
WHEN type_id = 11 THEN -- native function
RETURN '#<function ' ||
TREAT(ast AS mal_str_type).val_str ||
'>';
-- WHEN type_id = 12 THEN -- mal function
-- BEGIN
-- SELECT ast_id, params_id

12
plsql/reader.sql
View File

@ -137,34 +137,34 @@ BEGIN
CASE
WHEN token = '''' THEN
token := rdr.next();
RETURN types_pkg.mal_list(
RETURN types_pkg.list(
mal_str_type(7, 'quote'),
read_form(rdr));
WHEN token = '`' THEN
token := rdr.next();
RETURN types_pkg.mal_list(
RETURN types_pkg.list(
mal_str_type(7, 'quasiquote'),
read_form(rdr));
WHEN token = '~' THEN
token := rdr.next();
RETURN types_pkg.mal_list(
RETURN types_pkg.list(
mal_str_type(7, 'unquote'),
read_form(rdr));
WHEN token = '~@' THEN
token := rdr.next();
RETURN types_pkg.mal_list(
RETURN types_pkg.list(
mal_str_type(7, 'splice-unquote'),
read_form(rdr));
WHEN token = '^' THEN
token := rdr.next();
meta := read_form(rdr);
RETURN types_pkg.mal_list(
RETURN types_pkg.list(
mal_str_type(7, 'with-meta'),
read_form(rdr),
meta);
WHEN token = '@' THEN
token := rdr.next();
RETURN types_pkg.mal_list(
RETURN types_pkg.list(
mal_str_type(7, 'deref'),
read_form(rdr));

77
plsql/step0_repl.sql
View File

@ -4,53 +4,48 @@
-- ---------------------------------------------------------
-- step0_repl.sql
-- read
CREATE OR REPLACE FUNCTION READ(line varchar)
RETURN varchar IS
BEGIN
RETURN line;
END;
CREATE OR REPLACE PACKAGE mal_pkg IS
FUNCTION MAIN(pwd varchar) RETURN integer;
END mal_pkg;
/
-- eval
CREATE OR REPLACE FUNCTION EVAL(ast varchar, env varchar)
RETURN varchar IS
BEGIN
RETURN ast;
END;
/
CREATE OR REPLACE PACKAGE BODY mal_pkg IS
-- print
CREATE OR REPLACE FUNCTION PRINT(exp varchar)
RETURN varchar IS
BEGIN
RETURN exp;
END;
/
FUNCTION MAIN(pwd varchar) RETURN integer IS
line varchar2(4000);
-- read
FUNCTION READ(line varchar) RETURN varchar IS
BEGIN
RETURN line;
END;
-- repl
-- eval
FUNCTION EVAL(ast varchar, env varchar) RETURN varchar IS
BEGIN
RETURN ast;
END;
-- stub to support wrap.sh
CREATE OR REPLACE PROCEDURE env_vset(env integer, name varchar, val varchar)
IS
BEGIN
RETURN;
END;
/
-- print
FUNCTION PRINT(exp varchar) RETURN varchar IS
BEGIN
RETURN exp;
END;
-- stub to support wrap.sh
PROCEDURE env_vset(env integer, name varchar, val varchar) IS
BEGIN
RETURN;
END;
CREATE OR REPLACE FUNCTION REP(line varchar)
RETURN varchar IS
BEGIN
RETURN PRINT(EVAL(READ(line), ''));
END;
/
-- repl
FUNCTION REP(line varchar) RETURN varchar IS
BEGIN
RETURN PRINT(EVAL(READ(line), ''));
END;
CREATE OR REPLACE FUNCTION MAIN_LOOP(pwd varchar)
RETURN integer IS
line varchar2(4000);
output varchar2(4000);
BEGIN
WHILE true
LOOP
@ -59,8 +54,7 @@ BEGIN
-- stream_writeline('line: [' || line || ']', 1);
IF line IS NULL THEN RETURN 0; END IF;
IF line IS NOT NULL THEN
output := REP(line);
stream_writeline(output);
stream_writeline(REP(line));
END IF;
EXCEPTION WHEN OTHERS THEN
@ -71,6 +65,9 @@ BEGIN
END;
END LOOP;
END;
END mal_pkg;
/
show errors;
quit;

77
plsql/step1_read_print.sql
View File

@ -6,53 +6,48 @@
-- ---------------------------------------------------------
-- step1_read_print.sql
-- read
CREATE OR REPLACE FUNCTION READ(line varchar)
RETURN mal_type IS
BEGIN
RETURN reader_pkg.read_str(line);
END;
CREATE OR REPLACE PACKAGE mal_pkg IS
FUNCTION MAIN(pwd varchar) RETURN integer;
END mal_pkg;
/
-- eval
CREATE OR REPLACE FUNCTION EVAL(ast mal_type, env varchar)
RETURN mal_type IS
BEGIN
RETURN ast;
END;
/
CREATE OR REPLACE PACKAGE BODY mal_pkg IS
-- print
CREATE OR REPLACE FUNCTION PRINT(exp mal_type)
RETURN varchar IS
BEGIN
RETURN printer_pkg.pr_str(exp);
END;
/
FUNCTION MAIN(pwd varchar) RETURN integer IS
line varchar2(4000);
-- read
FUNCTION READ(line varchar) RETURN mal_type IS
BEGIN
RETURN reader_pkg.read_str(line);
END;
-- repl
-- eval
FUNCTION EVAL(ast mal_type, env varchar) RETURN mal_type IS
BEGIN
RETURN ast;
END;
-- stub to support wrap.sh
CREATE OR REPLACE PROCEDURE env_vset(env integer, name varchar, val varchar)
IS
BEGIN
RETURN;
END;
/
-- print
FUNCTION PRINT(exp mal_type) RETURN varchar IS
BEGIN
RETURN printer_pkg.pr_str(exp);
END;
-- stub to support wrap.sh
PROCEDURE env_vset(env integer, name varchar, val varchar) IS
BEGIN
RETURN;
END;
CREATE OR REPLACE FUNCTION REP(line varchar)
RETURN varchar IS
BEGIN
RETURN PRINT(EVAL(READ(line), ''));
END;
/
-- repl
FUNCTION REP(line varchar) RETURN varchar IS
BEGIN
RETURN PRINT(EVAL(READ(line), ''));
END;
CREATE OR REPLACE FUNCTION MAIN_LOOP(pwd varchar)
RETURN integer IS
line varchar2(4000);
output varchar2(4000);
BEGIN
WHILE true
LOOP
@ -61,8 +56,7 @@ BEGIN
-- stream_writeline('line: [' || line || ']', 1);
IF line IS NULL THEN RETURN 0; END IF;
IF line IS NOT NULL THEN
output := REP(line);
stream_writeline(output);
stream_writeline(REP(line));
END IF;
EXCEPTION WHEN OTHERS THEN
@ -73,6 +67,9 @@ BEGIN
END;
END LOOP;
END;
END mal_pkg;
/
show errors;
quit;

163
plsql/step2_eval.sql Normal file
View File

@ -0,0 +1,163 @@
@io.sql
@types.sql
@reader.sql
@printer.sql
-- ---------------------------------------------------------
-- step1_read_print.sql
CREATE OR REPLACE PACKAGE mal_pkg IS
FUNCTION MAIN(pwd varchar) RETURN integer;
END mal_pkg;
/
CREATE OR REPLACE PACKAGE BODY mal_pkg IS
FUNCTION MAIN(pwd varchar) RETURN integer IS
TYPE env_type IS TABLE OF mal_type INDEX BY varchar2(100);
repl_env env_type;
line varchar2(4000);
-- read
FUNCTION READ(line varchar) RETURN mal_type IS
BEGIN
RETURN reader_pkg.read_str(line);
END;
-- eval
-- forward declarations
FUNCTION EVAL(ast mal_type, env env_type) RETURN mal_type;
FUNCTION do_core_func(fn mal_type, args mal_seq_items_type) RETURN mal_type;
FUNCTION eval_ast(ast mal_type, env env_type) RETURN mal_type IS
i integer;
old_seq mal_seq_items_type;
new_seq mal_seq_items_type;
f mal_type;
BEGIN
IF ast.type_id = 7 THEN
RETURN env(TREAT(ast AS mal_str_type).val_str);
ELSIF ast.type_id IN (8,9) THEN
old_seq := TREAT(ast AS mal_seq_type).val_seq;
new_seq := mal_seq_items_type();
new_seq.EXTEND(old_seq.COUNT);
FOR i IN 1..old_seq.COUNT LOOP
new_seq(i) := EVAL(old_seq(i), env);
END LOOP;
RETURN mal_seq_type(ast.type_id, new_seq);
ELSE
RETURN ast;
END IF;
END;
FUNCTION EVAL(ast mal_type, env env_type) RETURN mal_type IS
el mal_type;
f mal_type;
args mal_seq_type;
BEGIN
IF ast.type_id <> 8 THEN
RETURN eval_ast(ast, env);
END IF;
-- apply
el := eval_ast(ast, env);
f := types_pkg.first(el);
args := TREAT(types_pkg.slice(el, 1) AS mal_seq_type);
RETURN do_core_func(f, args.val_seq);
END;
-- print
FUNCTION PRINT(exp mal_type) RETURN varchar IS
BEGIN
RETURN printer_pkg.pr_str(exp);
END;
-- stub to support wrap.sh
PROCEDURE env_vset(env integer, name varchar, val varchar) IS
BEGIN
RETURN;
END;
-- repl
FUNCTION mal_add(args mal_seq_items_type) RETURN mal_type IS
BEGIN
RETURN mal_int_type(3, TREAT(args(1) AS mal_int_type).val_int +
TREAT(args(2) AS mal_int_type).val_int);
END;
FUNCTION mal_subtract(args mal_seq_items_type) RETURN mal_type IS
BEGIN
RETURN mal_int_type(3, TREAT(args(1) AS mal_int_type).val_int -
TREAT(args(2) AS mal_int_type).val_int);
END;
FUNCTION mal_multiply(args mal_seq_items_type) RETURN mal_type IS
BEGIN
RETURN mal_int_type(3, TREAT(args(1) AS mal_int_type).val_int *
TREAT(args(2) AS mal_int_type).val_int);
END;
FUNCTION mal_divide(args mal_seq_items_type) RETURN mal_type IS
BEGIN
RETURN mal_int_type(3, TREAT(args(1) AS mal_int_type).val_int /
TREAT(args(2) AS mal_int_type).val_int);
END;
FUNCTION do_core_func(fn mal_type, args mal_seq_items_type) RETURN mal_type IS
fname varchar(100);
BEGIN
IF fn.type_id <> 11 THEN
raise_application_error(-20004,
'Invalid function call', TRUE);
END IF;
fname := TREAT(fn AS mal_str_type).val_str;
CASE
WHEN fname = '+' THEN RETURN mal_add(args);
WHEN fname = '-' THEN RETURN mal_subtract(args);
WHEN fname = '*' THEN RETURN mal_multiply(args);
WHEN fname = '/' THEN RETURN mal_divide(args);
ELSE raise_application_error(-20004,
'Invalid function call', TRUE);
END CASE;
END;
FUNCTION REP(line varchar) RETURN varchar IS
BEGIN
RETURN PRINT(EVAL(READ(line), repl_env));
END;
BEGIN
repl_env('+') := mal_str_type(11, '+');
repl_env('-') := mal_str_type(11, '-');
repl_env('*') := mal_str_type(11, '*');
repl_env('/') := mal_str_type(11, '/');
WHILE true
LOOP
BEGIN
line := stream_readline('user> ', 0);
-- stream_writeline('line: [' || line || ']', 1);
IF line IS NULL THEN RETURN 0; END IF;
IF line IS NOT NULL THEN
stream_writeline(REP(line));
END IF;
EXCEPTION WHEN OTHERS THEN
IF SQLCODE = -20000 THEN
RETURN 0;
END IF;
stream_writeline('Error: ' || SQLERRM);
END;
END LOOP;
END;
END mal_pkg;
/
show errors;
quit;

200
plsql/step3_env.sql Normal file
View File

@ -0,0 +1,200 @@
@io.sql
@types.sql
@reader.sql
@printer.sql
@env.sql
-- ---------------------------------------------------------
-- step1_read_print.sql
CREATE OR REPLACE PACKAGE mal_pkg IS
FUNCTION MAIN(pwd varchar) RETURN integer;
END mal_pkg;
/
CREATE OR REPLACE PACKAGE BODY mal_pkg IS
FUNCTION MAIN(pwd varchar) RETURN integer IS
env_mem env_mem_type;
repl_env integer;
line varchar2(4000);
x mal_type;
-- read
FUNCTION READ(line varchar) RETURN mal_type IS
BEGIN
RETURN reader_pkg.read_str(line);
END;
-- eval
-- forward declarations
FUNCTION EVAL(ast mal_type, env integer) RETURN mal_type;
FUNCTION do_core_func(fn mal_type, args mal_seq_items_type) RETURN mal_type;
FUNCTION eval_ast(ast mal_type, env integer) RETURN mal_type IS
i integer;
old_seq mal_seq_items_type;
new_seq mal_seq_items_type;
f mal_type;
BEGIN
IF ast.type_id = 7 THEN
RETURN env_pkg.env_get(env_mem, env, ast);
ELSIF ast.type_id IN (8,9) THEN
old_seq := TREAT(ast AS mal_seq_type).val_seq;
new_seq := mal_seq_items_type();
new_seq.EXTEND(old_seq.COUNT);
FOR i IN 1..old_seq.COUNT LOOP
new_seq(i) := EVAL(old_seq(i), env);
END LOOP;
RETURN mal_seq_type(ast.type_id, new_seq);
ELSE
RETURN ast;
END IF;
END;
FUNCTION EVAL(ast mal_type, env integer) RETURN mal_type IS
el mal_type;
a0 mal_type;
a0sym varchar2(4000);
seq mal_seq_items_type;
let_env integer;
i integer;
f mal_type;
args mal_seq_type;
BEGIN
IF ast.type_id <> 8 THEN
RETURN eval_ast(ast, env);
END IF;
-- apply
a0 := types_pkg.first(ast);
if a0.type_id = 7 THEN -- symbol
a0sym := TREAT(a0 AS mal_str_type).val_str;
ELSE
a0sym := '__<*fn*>__';
END IF;
CASE
WHEN a0sym = 'def!' THEN
RETURN env_pkg.env_set(env_mem, env,
types_pkg.nth(ast, 1), EVAL(types_pkg.nth(ast, 2), env));
WHEN a0sym = 'let*' THEN
let_env := env_pkg.env_new(env_mem, env);
seq := TREAT(types_pkg.nth(ast, 1) AS mal_seq_type).val_seq;
i := 1;
WHILE i <= seq.COUNT LOOP
x := env_pkg.env_set(env_mem, let_env,
seq(i), EVAL(seq(i+1), let_env));
i := i + 2;
END LOOP;
RETURN EVAL(types_pkg.nth(ast, 2), let_env);
ELSE
el := eval_ast(ast, env);
f := types_pkg.first(el);
args := TREAT(types_pkg.slice(el, 1) AS mal_seq_type);
RETURN do_core_func(f, args.val_seq);
END CASE;
END;
-- print
FUNCTION PRINT(exp mal_type) RETURN varchar IS
BEGIN
RETURN printer_pkg.pr_str(exp);
END;
-- stub to support wrap.sh
PROCEDURE env_vset(env integer, name varchar, val varchar) IS
BEGIN
RETURN;
END;
-- repl
FUNCTION mal_add(args mal_seq_items_type) RETURN mal_type IS
BEGIN
RETURN mal_int_type(3, TREAT(args(1) AS mal_int_type).val_int +
TREAT(args(2) AS mal_int_type).val_int);
END;
FUNCTION mal_subtract(args mal_seq_items_type) RETURN mal_type IS
BEGIN
RETURN mal_int_type(3, TREAT(args(1) AS mal_int_type).val_int -
TREAT(args(2) AS mal_int_type).val_int);
END;
FUNCTION mal_multiply(args mal_seq_items_type) RETURN mal_type IS
BEGIN
RETURN mal_int_type(3, TREAT(args(1) AS mal_int_type).val_int *
TREAT(args(2) AS mal_int_type).val_int);
END;
FUNCTION mal_divide(args mal_seq_items_type) RETURN mal_type IS
BEGIN
RETURN mal_int_type(3, TREAT(args(1) AS mal_int_type).val_int /
TREAT(args(2) AS mal_int_type).val_int);
END;
FUNCTION do_core_func(fn mal_type, args mal_seq_items_type) RETURN mal_type IS
fname varchar(100);
BEGIN
IF fn.type_id <> 11 THEN
raise_application_error(-20004,
'Invalid function call', TRUE);
END IF;
fname := TREAT(fn AS mal_str_type).val_str;
CASE
WHEN fname = '+' THEN RETURN mal_add(args);
WHEN fname = '-' THEN RETURN mal_subtract(args);
WHEN fname = '*' THEN RETURN mal_multiply(args);
WHEN fname = '/' THEN RETURN mal_divide(args);
ELSE raise_application_error(-20004,
'Invalid function call', TRUE);
END CASE;
END;
FUNCTION REP(line varchar) RETURN varchar IS
BEGIN
RETURN PRINT(EVAL(READ(line), repl_env));
END;
BEGIN
env_mem := env_mem_type();
repl_env := env_pkg.env_new(env_mem, NULL);
x := env_pkg.env_set(env_mem, repl_env, types_pkg.symbol('+'),
mal_str_type(11, '+'));
x := env_pkg.env_set(env_mem, repl_env, types_pkg.symbol('-'),
mal_str_type(11, '-'));
x := env_pkg.env_set(env_mem, repl_env, types_pkg.symbol('*'),
mal_str_type(11, '*'));
x := env_pkg.env_set(env_mem, repl_env, types_pkg.symbol('/'),
mal_str_type(11, '/'));
WHILE true
LOOP
BEGIN
line := stream_readline('user> ', 0);
-- stream_writeline('line: [' || line || ']', 1);
IF line IS NULL THEN RETURN 0; END IF;
IF line IS NOT NULL THEN
stream_writeline(REP(line));
END IF;
EXCEPTION WHEN OTHERS THEN
IF SQLCODE = -20000 THEN
RETURN 0;
END IF;
stream_writeline('Error: ' || SQLERRM);
stream_writeline(dbms_utility.format_error_backtrace);
END;
END LOOP;
END;
END mal_pkg;
/
show errors;
quit;

159
plsql/types.sql
View File

@ -50,77 +50,30 @@ CREATE OR REPLACE TYPE mal_seq_type FORCE UNDER mal_type (
/
-- CREATE OR REPLACE TYPE mal_seq_items AS TABLE OF mal_type;
-- /
-- CREATE OR REPLACE TYPE mal_seq_type AS OBJECT (
-- items mal_seq_items
-- );
-- /
-- BEGIN
-- EXECUTE IMMEDIATE 'DROP TABLE sequence';
-- EXCEPTION
-- WHEN OTHERS THEN IF SQLCODE != -942 THEN RAISE; END IF;
-- END;
-- /
--
-- CREATE TABLE sequence (
-- seq mal_seq_items
-- )
-- NESTED TABLE seq STORE AS seq_table;
--
-- PROMPT "types.sql 3";
-- -- skip nil, false, true
-- CREATE SEQUENCE value_id_seq START WITH 3;
-- CREATE TABLE value (
-- value_id integer NOT NULL,
-- value REF mal_type
-- -- type_id integer NOT NULL,
-- -- val_int bigint, -- set for integers
-- -- val_string varchar, -- set for strings, keywords, symbols,
-- -- -- and native functions (function name)
-- -- val_seq integer[], -- set for lists and vectors
-- -- val_hash hstore, -- set for hash-maps
-- -- ast_id integer, -- set for malfunc
-- -- params_id integer, -- set for malfunc
-- -- env_id integer, -- set for malfunc
-- -- macro boolean, -- set for malfunc
-- -- meta_id integer -- can be set for any collection
-- );
--NESTED TABLE val STORE AS val_table
--( NESTED TABLE val_seq STORE AS val_seq_table );
-- CREATE OR REPLACE TRIGGER pk_value_trigger BEFORE INSERT ON value
-- FOR EACH ROW
-- DECLARE
-- BEGIN
-- select value_id_seq.nextval into :new.value_id from dual;
-- END;
-- /
PROMPT "types.sql 5";
-- ALTER TABLE value ADD CONSTRAINT pk_value_id
-- PRIMARY KEY (value_id);
-- PL/pgSQL:-- drop sequence when table dropped
-- PL/pgSQL:ALTER SEQUENCE value_id_seq OWNED BY value.value_id;
-- ALTER TABLE value ADD CONSTRAINT fk_meta_id
-- FOREIGN KEY (meta_id) REFERENCES value(value_id);
-- ALTER TABLE value ADD CONSTRAINT fk_params_id
-- FOREIGN KEY (params_id) REFERENCES value(value_id);
--
-- CREATE INDEX ON value (value_id, type_id);
--
-- INSERT INTO value (value_id, type_id) VALUES (0, 0); -- nil
-- INSERT INTO value (value_id, type_id) VALUES (1, 1); -- false
-- INSERT INTO value (value_id, type_id) VALUES (2, 2); -- true
-- ---------------------------------------------------------
-- general functions
CREATE OR REPLACE PACKAGE types_pkg IS
-- general functions
-- scalar functions
FUNCTION symbol(name varchar) RETURN mal_type;
-- sequence functions
FUNCTION list RETURN mal_type;
FUNCTION list(a mal_type) RETURN mal_type;
FUNCTION list(a mal_type, b mal_type) RETURN mal_type;
FUNCTION list(a mal_type, b mal_type, c mal_type) RETURN mal_type;
FUNCTION first(seq mal_type) RETURN mal_type;
FUNCTION slice(seq mal_type, idx integer) RETURN mal_type;
FUNCTION nth(seq mal_type, idx integer) RETURN mal_type;
END types_pkg;
/
CREATE OR REPLACE PACKAGE BODY types_pkg IS
-- CREATE OR REPLACE FUNCTION _wraptf(val boolean) RETURNS integer AS $$
-- BEGIN
@ -232,12 +185,18 @@ PROMPT "types.sql 5";
-- RETURNING value_id INTO result;
-- RETURN result;
-- END; $$ LANGUAGE plpgsql;
--
--
-- -- ---------------------------------------------------------
-- -- scalar functions
--
--
-- ---------------------------------------------------------
-- scalar functions
FUNCTION symbol(name varchar) RETURN mal_type IS
BEGIN
RETURN mal_str_type(7, name);
END;
-- -- _nil_Q:
-- -- takes a value_id
-- -- returns the whether value_id is nil
@ -403,41 +362,57 @@ PROMPT "types.sql 5";
-- END; $$ LANGUAGE plpgsql;
--
CREATE OR REPLACE PACKAGE types_pkg IS
FUNCTION mal_list RETURN mal_type;
FUNCTION mal_list(a mal_type) RETURN mal_type;
FUNCTION mal_list(a mal_type, b mal_type) RETURN mal_type;
FUNCTION mal_list(a mal_type, b mal_type, c mal_type) RETURN mal_type;
END types_pkg;
/
-- ---------------------------------------------------------
-- general functions
CREATE OR REPLACE PACKAGE BODY types_pkg IS
-- ---------------------------------------------------------
-- sequence functions
-- mal_list:
-- list:
-- return a mal list
FUNCTION mal_list RETURN mal_type IS
FUNCTION list RETURN mal_type IS
BEGIN
RETURN mal_seq_type(8, mal_seq_items_type());
END;
FUNCTION mal_list(a mal_type) RETURN mal_type IS
FUNCTION list(a mal_type) RETURN mal_type IS
BEGIN
RETURN mal_seq_type(8, mal_seq_items_type(a));
END;
FUNCTION mal_list(a mal_type, b mal_type) RETURN mal_type IS
FUNCTION list(a mal_type, b mal_type) RETURN mal_type IS
BEGIN
RETURN mal_seq_type(8, mal_seq_items_type(a, b));
END;
FUNCTION mal_list(a mal_type, b mal_type, c mal_type) RETURN mal_type IS
FUNCTION list(a mal_type, b mal_type, c mal_type) RETURN mal_type IS
BEGIN
RETURN mal_seq_type(8, mal_seq_items_type(a, b, c));
END;
END types_pkg;
/
show errors;
FUNCTION first(seq mal_type) RETURN mal_type IS
BEGIN
RETURN TREAT(seq AS mal_seq_type).val_seq(1);
END;
FUNCTION slice(seq mal_type, idx integer) RETURN mal_type IS
old_items mal_seq_items_type;
new_items mal_seq_items_type;
i integer;
BEGIN
old_items := TREAT(seq AS mal_seq_type).val_seq;
new_items := mal_seq_items_type();
new_items.EXTEND(old_items.COUNT - idx);
FOR i IN idx+1..old_items.COUNT LOOP
new_items(i-idx) := old_items(i);
END LOOP;
RETURN mal_seq_type(8, new_items);
END;
FUNCTION nth(seq mal_type, idx integer) RETURN mal_type IS
BEGIN
RETURN TREAT(seq AS mal_seq_type).val_seq(idx+1);
END;
-- -- _vector:
-- -- takes a array of value_id integers
@ -759,4 +734,8 @@ show errors;
-- RETURN newval;
-- END; $$ LANGUAGE plpgsql;
END types_pkg;
/
show errors;
PROMPT "types.sql finished";

4
plsql/wrap.sh
View File

@ -64,12 +64,12 @@ shift
if [ $# -gt 0 ]; then
# If there are command line arguments then run a command and exit
args=$(for a in "$@"; do echo -n "\"$a\" "; done)
echo -e "BEGIN RUN('$(pwd)', :'args'); END;\n/" \
echo -e "BEGIN MAIN('$(pwd)', :'args'); END;\n/" \
| ${SQLPLUS} "(${args})" > /dev/null
res=$?
else
# Start main loop in the background
echo "SELECT MAIN_LOOP('$(pwd)') FROM dual;" \
echo "SELECT mal_pkg.MAIN('$(pwd)') FROM dual;" \
| ${SQLPLUS} > /dev/null
res=$?
fi