[jackhill/mal.git] / plsql / step8_macros.sql

@io.sql
@types.sql
@reader.sql
@printer.sql
@env.sql
@core.sql

CREATE OR REPLACE PACKAGE mal IS

FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer;

END mal;
/

CREATE OR REPLACE PACKAGE BODY mal IS

FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS
    M         mem_type;
    E         env_pkg.env_entry_table;
    repl_env  integer;
    x         integer;
    line      varchar2(4000);
    core_ns   core_ns_type;
    cidx      integer;
    argv      mal_seq_items_type;

    -- read
    FUNCTION READ(line varchar) RETURN integer IS
    BEGIN
        RETURN reader.read_str(M, line);
    END;

    -- eval

    -- forward declarations
    FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer;
    FUNCTION do_builtin(fn integer, args mal_seq_items_type) RETURN integer;

    FUNCTION is_pair(ast integer) RETURN BOOLEAN IS
    BEGIN
        RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0;
    END;

    FUNCTION quasiquote(ast integer) RETURN integer IS
        a0   integer;
        a00  integer;
    BEGIN
        IF NOT is_pair(ast) THEN
            RETURN types.list(M, types.symbol(M, 'quote'), ast);
        ELSE
            a0 := types.nth(M, ast, 0);
            IF M(a0).type_id = 7 AND
               TREAT(m(a0) AS mal_str_type).val_str = 'unquote' THEN
                RETURN types.nth(M, ast, 1);
            ELSIF is_pair(a0) THEN
                a00 := types.nth(M, a0, 0);
                IF M(a00).type_id = 7 AND
                   TREAT(M(a00) AS mal_str_type).val_str = 'splice-unquote' THEN
                    RETURN types.list(M, types.symbol(M, 'concat'),
                                         types.nth(M, a0, 1),
                                         quasiquote(types.slice(M, ast, 1)));
                END IF;
            END IF;
            RETURN types.list(M, types.symbol(M, 'cons'),
                                 quasiquote(a0),
                                 quasiquote(types.slice(M, ast, 1)));
        END IF;
    END;


    FUNCTION is_macro_call(ast integer, env integer) RETURN BOOLEAN IS
        a0   integer;
        mac  integer;
    BEGIN
        IF M(ast).type_id = 8 THEN
            a0 := types.nth(M, ast, 0);
            IF M(a0).type_id = 7 AND
               env_pkg.env_find(M, E, env, a0) IS NOT NULL THEN
                mac := env_pkg.env_get(M, E, env, a0);
                IF M(mac).type_id = 12 THEN
                    RETURN TREAT(M(mac) AS malfunc_type).is_macro > 0;
                END IF;
            END IF;
        END IF;
        RETURN FALSE;
    END;

    FUNCTION macroexpand(orig_ast integer, env integer) RETURN integer IS
        ast     integer;
        mac     integer;
        malfn   malfunc_type;
        fargs   mal_seq_items_type;
        fn_env  integer;
    BEGIN
        ast := orig_ast;
        WHILE is_macro_call(ast, env) LOOP
            mac := env_pkg.env_get(M, E, env, types.nth(M, ast, 0));
            fargs := TREAT(M(types.slice(M, ast, 1)) as mal_seq_type).val_seq;
            if M(mac).type_id = 12 THEN
                malfn := TREAT(M(mac) AS malfunc_type);
                fn_env := env_pkg.env_new(M, E, malfn.env,
                                          malfn.params,
                                          fargs);
                ast := EVAL(malfn.ast, fn_env);
            ELSE
                ast := do_builtin(mac, fargs);
            END IF;
        END LOOP;
        RETURN ast;
    END;

    FUNCTION eval_ast(ast integer, env integer) RETURN integer IS
        i        integer;
        old_seq  mal_seq_items_type;
        new_seq  mal_seq_items_type;
    BEGIN
        IF M(ast).type_id = 7 THEN
            RETURN env_pkg.env_get(M, E, env, ast);
        ELSIF M(ast).type_id IN (8,9) THEN
            old_seq := TREAT(M(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 types.seq(M, M(ast).type_id, new_seq);
        ELSE
            RETURN ast;
        END IF;
    END;

    FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS
        ast      integer := orig_ast;
        env      integer := orig_env;
        el       integer;
        a0       integer;
        a0sym    varchar2(100);
        seq      mal_seq_items_type;
        let_env  integer;
        i        integer;
        f        integer;
        cond     integer;
        malfn    malfunc_type;
        args     mal_seq_items_type;
    BEGIN
      WHILE TRUE LOOP
        IF M(ast).type_id <> 8 THEN
            RETURN eval_ast(ast, env);
        END IF;

        -- apply
        ast := macroexpand(ast, env);
        IF M(ast).type_id <> 8 THEN
            RETURN eval_ast(ast, env);
        END IF;
        IF types.count(M, ast) = 0 THEN
            RETURN ast;
        END IF;

        a0 := types.first(M, ast);
        if M(a0).type_id = 7 THEN -- symbol
            a0sym := TREAT(M(a0) AS mal_str_type).val_str;
        ELSE
            a0sym := '__<*fn*>__';
        END IF;

        CASE
        WHEN a0sym = 'def!' THEN
            RETURN env_pkg.env_set(M, E, env,
                types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env));
        WHEN a0sym = 'let*' THEN
            let_env := env_pkg.env_new(M, E, env);
            seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_type).val_seq;
            i := 1;
            WHILE i <= seq.COUNT LOOP
                x := env_pkg.env_set(M, E, let_env,
                    seq(i), EVAL(seq(i+1), let_env));
                i := i + 2;
            END LOOP;
            env := let_env;
            ast := types.nth(M, ast, 2); -- TCO
        WHEN a0sym = 'quote' THEN
            RETURN types.nth(M, ast, 1);
        WHEN a0sym = 'quasiquote' THEN
            RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env);
        WHEN a0sym = 'defmacro!' THEN
            x := EVAL(types.nth(M, ast, 2), env);
            malfn := TREAT(M(x) as malfunc_type);
            malfn.is_macro := 1;
            M(x) := malfn;
            RETURN env_pkg.env_set(M, E, env,
                types.nth(M, ast, 1), x);
        WHEN a0sym = 'macroexpand' THEN
            RETURN macroexpand(types.nth(M, ast, 1), env);
        WHEN a0sym = 'do' THEN
            x := types.slice(M, ast, 1, types.count(M, ast)-2);
            x := eval_ast(x, env);
            ast := types.nth(M, ast, types.count(M, ast)-1);  -- TCO
        WHEN a0sym = 'if' THEN
            cond := EVAL(types.nth(M, ast, 1), env);
            IF cond = 1 OR cond = 2 THEN  -- nil or false
                IF types.count(M, ast) > 3 THEN
                    ast := EVAL(types.nth(M, ast, 3), env);  -- TCO
                ELSE
                    RETURN 1;  -- nil
                END IF;
            ELSE
                ast := EVAL(types.nth(M, ast, 2), env);  -- TCO
            END IF;
        WHEN a0sym = 'fn*' THEN
            RETURN types.malfunc(M, types.nth(M, ast, 2),
                                    types.nth(M, ast, 1),
                                    env);
        ELSE
            el := eval_ast(ast, env);
            f := types.first(M, el);
            args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_type).val_seq;
            IF M(f).type_id = 12 THEN
                malfn := TREAT(M(f) AS malfunc_type);
                env := env_pkg.env_new(M, E, malfn.env,
                                          malfn.params, args);
                ast := malfn.ast;  -- TCO
            ELSE
                RETURN do_builtin(f, args);
            END IF;
        END CASE;

      END LOOP;

    END;

    -- hack to get around lack of function references
    -- functions that require special access to repl_env or EVAL
    -- are implemented directly here, otherwise, core.do_core_fn
    -- is called.
    FUNCTION do_builtin(fn integer, args mal_seq_items_type) RETURN integer IS
        fname   varchar2(100);
        val     integer;
        f       integer;
        malfn   malfunc_type;
        fargs   mal_seq_items_type;
        fn_env  integer;
    BEGIN
        fname := TREAT(M(fn) AS mal_str_type).val_str;
        CASE
        WHEN fname = 'do_eval' THEN
            RETURN EVAL(args(1), repl_env);
        WHEN fname = 'swap!' THEN
            val := TREAT(M(args(1)) AS mal_atom_type).val;
            f := args(2);
            -- slice one extra at the beginning that will be changed
            -- to the value of the atom
            fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_type).val_seq;
            fargs(1) := val;
            IF M(f).type_id = 12 THEN
                malfn := TREAT(M(f) AS malfunc_type);
                fn_env := env_pkg.env_new(M, E, malfn.env,
                                          malfn.params, fargs);
                val := EVAL(malfn.ast, fn_env);
            ELSE
                val := do_builtin(f, fargs);
            END IF;
            M(args(1)) := mal_atom_type(13, val);
            RETURN val;
        ELSE
            RETURN core.do_core_func(M, fn, args);
        END CASE;
    END;


    -- print
    FUNCTION PRINT(exp integer) RETURN varchar IS
    BEGIN
        RETURN printer.pr_str(M, exp);
    END;

    -- repl
    FUNCTION REP(line varchar) RETURN varchar IS
    BEGIN
        RETURN PRINT(EVAL(READ(line), repl_env));
    END;

BEGIN
    M := types.mem_new();
    E := env_pkg.env_entry_table();

    repl_env := env_pkg.env_new(M, E, NULL);

    argv := TREAT(M(reader.read_str(M, args)) AS mal_seq_type).val_seq;

    -- core.EXT: defined using PL/SQL
    core_ns := core.get_core_ns();
    FOR cidx IN 1..core_ns.COUNT LOOP
        x := env_pkg.env_set(M, E, repl_env,
            types.symbol(M, core_ns(cidx)),
            types.func(M, core_ns(cidx)));
    END LOOP;
    x := env_pkg.env_set(M, E, repl_env,
        types.symbol(M, 'eval'),
        types.func(M, 'do_eval'));
    x := env_pkg.env_set(M, E, repl_env,
        types.symbol(M, '*ARGV*'),
        types.slice(M, argv, 1));

    -- core.mal: defined using the language itself
    line := REP('(def! not (fn* (a) (if a false true)))');
    line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))');
    line := REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))');
    line := REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))');

    IF argv.COUNT() > 0 THEN
        line := REP('(load-file "' ||
                TREAT(M(argv(1)) AS mal_str_type).val_str ||
                '")');
        RETURN 0;
    END IF;

    WHILE true LOOP
        BEGIN
            line := stream_readline('user> ', 0);
            IF line IS NULL THEN CONTINUE; END IF;
            IF line IS NOT NULL THEN
                stream_writeline(REP(line));
            END IF;

            EXCEPTION WHEN OTHERS THEN
                IF SQLCODE = -20001 THEN  -- io streams closed
                    RETURN 0;
                END IF;
                stream_writeline('Error: ' || SQLERRM);
                stream_writeline(dbms_utility.format_error_backtrace);
        END;
    END LOOP;
END;

END mal;
/
show errors;

quit;
Commit	Line	Data
0fc03918 JM	1	@io.sql
	2	@types.sql
	3	@reader.sql
	4	@printer.sql
	5	@env.sql
	6	@core.sql
	7
	8	CREATE OR REPLACE PACKAGE mal IS
	9
10cc781f	10	FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer;
0fc03918 JM	11
	12	END mal;
	13	/
	14
	15	CREATE OR REPLACE PACKAGE BODY mal IS
	16
10cc781f	17	FUNCTION MAIN(args varchar DEFAULT '()') RETURN integer IS
0fc03918	18	M mem_type;
10cc781f	19	E env_pkg.env_entry_table;
0fc03918 JM	20	repl_env integer;
	21	x integer;
	22	line varchar2(4000);
	23	core_ns core_ns_type;
	24	cidx integer;
10cc781f	25	argv mal_seq_items_type;
0fc03918 JM	26
	27	-- read
	28	FUNCTION READ(line varchar) RETURN integer IS
	29	BEGIN
	30	RETURN reader.read_str(M, line);
	31	END;
	32
	33	-- eval
	34
	35	-- forward declarations
	36	FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer;
150011e4	37	FUNCTION do_builtin(fn integer, args mal_seq_items_type) RETURN integer;
0fc03918 JM	38
	39	FUNCTION is_pair(ast integer) RETURN BOOLEAN IS
	40	BEGIN
	41	RETURN M(ast).type_id IN (8,9) AND types.count(M, ast) > 0;
	42	END;
	43
	44	FUNCTION quasiquote(ast integer) RETURN integer IS
	45	a0 integer;
	46	a00 integer;
	47	BEGIN
	48	IF NOT is_pair(ast) THEN
	49	RETURN types.list(M, types.symbol(M, 'quote'), ast);
	50	ELSE
	51	a0 := types.nth(M, ast, 0);
	52	IF M(a0).type_id = 7 AND
	53	TREAT(m(a0) AS mal_str_type).val_str = 'unquote' THEN
	54	RETURN types.nth(M, ast, 1);
	55	ELSIF is_pair(a0) THEN
	56	a00 := types.nth(M, a0, 0);
	57	IF M(a00).type_id = 7 AND
	58	TREAT(M(a00) AS mal_str_type).val_str = 'splice-unquote' THEN
	59	RETURN types.list(M, types.symbol(M, 'concat'),
	60	types.nth(M, a0, 1),
	61	quasiquote(types.slice(M, ast, 1)));
	62	END IF;
	63	END IF;
	64	RETURN types.list(M, types.symbol(M, 'cons'),
	65	quasiquote(a0),
	66	quasiquote(types.slice(M, ast, 1)));
	67	END IF;
	68	END;
	69
	70
	71	FUNCTION is_macro_call(ast integer, env integer) RETURN BOOLEAN IS
	72	a0 integer;
	73	mac integer;
	74	BEGIN
	75	IF M(ast).type_id = 8 THEN
	76	a0 := types.nth(M, ast, 0);
	77	IF M(a0).type_id = 7 AND
10cc781f JM	78	env_pkg.env_find(M, E, env, a0) IS NOT NULL THEN
10cc781f JM	79	mac := env_pkg.env_get(M, E, env, a0);
0fc03918 JM	80	IF M(mac).type_id = 12 THEN
	81	RETURN TREAT(M(mac) AS malfunc_type).is_macro > 0;
	82	END IF;
	83	END IF;
	84	END IF;
	85	RETURN FALSE;
	86	END;
	87
	88	FUNCTION macroexpand(orig_ast integer, env integer) RETURN integer IS
	89	ast integer;
	90	mac integer;
	91	malfn malfunc_type;
150011e4	92	fargs mal_seq_items_type;
0fc03918 JM	93	fn_env integer;
	94	BEGIN
	95	ast := orig_ast;
	96	WHILE is_macro_call(ast, env) LOOP
10cc781f	97	mac := env_pkg.env_get(M, E, env, types.nth(M, ast, 0));
150011e4	98	fargs := TREAT(M(types.slice(M, ast, 1)) as mal_seq_type).val_seq;
0fc03918 JM	99	if M(mac).type_id = 12 THEN
0fc03918 JM	100	malfn := TREAT(M(mac) AS malfunc_type);
10cc781f	101	fn_env := env_pkg.env_new(M, E, malfn.env,
0fc03918 JM	102	malfn.params,
	103	fargs);
	104	ast := EVAL(malfn.ast, fn_env);
	105	ELSE
	106	ast := do_builtin(mac, fargs);
	107	END IF;
	108	END LOOP;
	109	RETURN ast;
	110	END;
	111
	112	FUNCTION eval_ast(ast integer, env integer) RETURN integer IS
	113	i integer;
	114	old_seq mal_seq_items_type;
	115	new_seq mal_seq_items_type;
	116	BEGIN
	117	IF M(ast).type_id = 7 THEN
10cc781f	118	RETURN env_pkg.env_get(M, E, env, ast);
0fc03918 JM	119	ELSIF M(ast).type_id IN (8,9) THEN
	120	old_seq := TREAT(M(ast) AS mal_seq_type).val_seq;
	121	new_seq := mal_seq_items_type();
	122	new_seq.EXTEND(old_seq.COUNT);
	123	FOR i IN 1..old_seq.COUNT LOOP
	124	new_seq(i) := EVAL(old_seq(i), env);
	125	END LOOP;
	126	RETURN types.seq(M, M(ast).type_id, new_seq);
	127	ELSE
	128	RETURN ast;
	129	END IF;
	130	END;
	131
	132	FUNCTION EVAL(orig_ast integer, orig_env integer) RETURN integer IS
	133	ast integer := orig_ast;
	134	env integer := orig_env;
	135	el integer;
	136	a0 integer;
150011e4	137	a0sym varchar2(100);
0fc03918 JM	138	seq mal_seq_items_type;
	139	let_env integer;
	140	i integer;
	141	f integer;
	142	cond integer;
	143	malfn malfunc_type;
150011e4	144	args mal_seq_items_type;
0fc03918 JM	145	BEGIN
	146	WHILE TRUE LOOP
	147	IF M(ast).type_id <> 8 THEN
	148	RETURN eval_ast(ast, env);
	149	END IF;
	150
	151	-- apply
	152	ast := macroexpand(ast, env);
	153	IF M(ast).type_id <> 8 THEN
	154	RETURN eval_ast(ast, env);
	155	END IF;
	156	IF types.count(M, ast) = 0 THEN
	157	RETURN ast;
	158	END IF;
	159
	160	a0 := types.first(M, ast);
	161	if M(a0).type_id = 7 THEN -- symbol
	162	a0sym := TREAT(M(a0) AS mal_str_type).val_str;
	163	ELSE
	164	a0sym := '__<fn>__';
	165	END IF;
	166
	167	CASE
	168	WHEN a0sym = 'def!' THEN
10cc781f	169	RETURN env_pkg.env_set(M, E, env,
0fc03918 JM	170	types.nth(M, ast, 1), EVAL(types.nth(M, ast, 2), env));
0fc03918 JM	171	WHEN a0sym = 'let*' THEN
10cc781f	172	let_env := env_pkg.env_new(M, E, env);
0fc03918 JM	173	seq := TREAT(M(types.nth(M, ast, 1)) AS mal_seq_type).val_seq;
	174	i := 1;
	175	WHILE i <= seq.COUNT LOOP
10cc781f	176	x := env_pkg.env_set(M, E, let_env,
0fc03918 JM	177	seq(i), EVAL(seq(i+1), let_env));
	178	i := i + 2;
	179	END LOOP;
	180	env := let_env;
	181	ast := types.nth(M, ast, 2); -- TCO
	182	WHEN a0sym = 'quote' THEN
	183	RETURN types.nth(M, ast, 1);
	184	WHEN a0sym = 'quasiquote' THEN
	185	RETURN EVAL(quasiquote(types.nth(M, ast, 1)), env);
	186	WHEN a0sym = 'defmacro!' THEN
	187	x := EVAL(types.nth(M, ast, 2), env);
	188	malfn := TREAT(M(x) as malfunc_type);
	189	malfn.is_macro := 1;
	190	M(x) := malfn;
10cc781f	191	RETURN env_pkg.env_set(M, E, env,
0fc03918 JM	192	types.nth(M, ast, 1), x);
	193	WHEN a0sym = 'macroexpand' THEN
	194	RETURN macroexpand(types.nth(M, ast, 1), env);
	195	WHEN a0sym = 'do' THEN
	196	x := types.slice(M, ast, 1, types.count(M, ast)-2);
	197	x := eval_ast(x, env);
	198	ast := types.nth(M, ast, types.count(M, ast)-1); -- TCO
	199	WHEN a0sym = 'if' THEN
	200	cond := EVAL(types.nth(M, ast, 1), env);
	201	IF cond = 1 OR cond = 2 THEN -- nil or false
	202	IF types.count(M, ast) > 3 THEN
	203	ast := EVAL(types.nth(M, ast, 3), env); -- TCO
	204	ELSE
	205	RETURN 1; -- nil
	206	END IF;
	207	ELSE
	208	ast := EVAL(types.nth(M, ast, 2), env); -- TCO
	209	END IF;
	210	WHEN a0sym = 'fn*' THEN
	211	RETURN types.malfunc(M, types.nth(M, ast, 2),
	212	types.nth(M, ast, 1),
	213	env);
	214	ELSE
	215	el := eval_ast(ast, env);
	216	f := types.first(M, el);
150011e4	217	args := TREAT(M(types.slice(M, el, 1)) AS mal_seq_type).val_seq;
0fc03918 JM	218	IF M(f).type_id = 12 THEN
0fc03918 JM	219	malfn := TREAT(M(f) AS malfunc_type);
10cc781f	220	env := env_pkg.env_new(M, E, malfn.env,
0fc03918 JM	221	malfn.params, args);
	222	ast := malfn.ast; -- TCO
	223	ELSE
	224	RETURN do_builtin(f, args);
	225	END IF;
	226	END CASE;
	227
	228	END LOOP;
	229
	230	END;
	231
	232	-- hack to get around lack of function references
	233	-- functions that require special access to repl_env or EVAL
	234	-- are implemented directly here, otherwise, core.do_core_fn
	235	-- is called.
150011e4	236	FUNCTION do_builtin(fn integer, args mal_seq_items_type) RETURN integer IS
0fc03918	237	fname varchar2(100);
150011e4	238	val integer;
0fc03918 JM	239	f integer;
	240	malfn malfunc_type;
	241	fargs mal_seq_items_type;
	242	fn_env integer;
	243	BEGIN
	244	fname := TREAT(M(fn) AS mal_str_type).val_str;
	245	CASE
	246	WHEN fname = 'do_eval' THEN
150011e4	247	RETURN EVAL(args(1), repl_env);
0fc03918	248	WHEN fname = 'swap!' THEN
150011e4 JM	249	val := TREAT(M(args(1)) AS mal_atom_type).val;
150011e4 JM	250	f := args(2);
0fc03918 JM	251	-- slice one extra at the beginning that will be changed
0fc03918 JM	252	-- to the value of the atom
150011e4 JM	253	fargs := TREAT(M(types.slice(M, args, 1)) AS mal_seq_type).val_seq;
150011e4 JM	254	fargs(1) := val;
0fc03918 JM	255	IF M(f).type_id = 12 THEN
0fc03918 JM	256	malfn := TREAT(M(f) AS malfunc_type);
10cc781f	257	fn_env := env_pkg.env_new(M, E, malfn.env,
150011e4 JM	258	malfn.params, fargs);
150011e4 JM	259	val := EVAL(malfn.ast, fn_env);
0fc03918	260	ELSE
150011e4	261	val := do_builtin(f, fargs);
0fc03918	262	END IF;
150011e4 JM	263	M(args(1)) := mal_atom_type(13, val);
150011e4 JM	264	RETURN val;
0fc03918	265	ELSE
150011e4	266	RETURN core.do_core_func(M, fn, args);
0fc03918 JM	267	END CASE;
	268	END;
	269
	270
	271	-- print
	272	FUNCTION PRINT(exp integer) RETURN varchar IS
	273	BEGIN
	274	RETURN printer.pr_str(M, exp);
	275	END;
	276
	277	-- repl
	278	FUNCTION REP(line varchar) RETURN varchar IS
	279	BEGIN
	280	RETURN PRINT(EVAL(READ(line), repl_env));
	281	END;
	282
	283	BEGIN
	284	M := types.mem_new();
10cc781f	285	E := env_pkg.env_entry_table();
0fc03918	286
10cc781f JM	287	repl_env := env_pkg.env_new(M, E, NULL);
	288
	289	argv := TREAT(M(reader.read_str(M, args)) AS mal_seq_type).val_seq;
0fc03918 JM	290
	291	-- core.EXT: defined using PL/SQL
	292	core_ns := core.get_core_ns();
	293	FOR cidx IN 1..core_ns.COUNT LOOP
10cc781f	294	x := env_pkg.env_set(M, E, repl_env,
0fc03918 JM	295	types.symbol(M, core_ns(cidx)),
	296	types.func(M, core_ns(cidx)));
	297	END LOOP;
10cc781f	298	x := env_pkg.env_set(M, E, repl_env,
0fc03918 JM	299	types.symbol(M, 'eval'),
0fc03918 JM	300	types.func(M, 'do_eval'));
10cc781f	301	x := env_pkg.env_set(M, E, repl_env,
0fc03918	302	types.symbol(M, 'ARGV'),
10cc781f	303	types.slice(M, argv, 1));
0fc03918 JM	304
	305	-- core.mal: defined using the language itself
	306	line := REP('(def! not (fn* (a) (if a false true)))');
	307	line := REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))');
	308	line := REP('(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list ''if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number of forms to cond")) (cons ''cond (rest (rest xs)))))))');
	309	line := REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))');
	310
10cc781f JM	311	IF argv.COUNT() > 0 THEN
	312	line := REP('(load-file "' \|\|
	313	TREAT(M(argv(1)) AS mal_str_type).val_str \|\|
	314	'")');
	315	RETURN 0;
	316	END IF;
	317
0fc03918 JM	318	WHILE true LOOP
	319	BEGIN
	320	line := stream_readline('user> ', 0);
	321	IF line IS NULL THEN CONTINUE; END IF;
	322	IF line IS NOT NULL THEN
	323	stream_writeline(REP(line));
	324	END IF;
	325
	326	EXCEPTION WHEN OTHERS THEN
150011e4	327	IF SQLCODE = -20001 THEN -- io streams closed
0fc03918 JM	328	RETURN 0;
	329	END IF;
	330	stream_writeline('Error: ' \|\| SQLERRM);
	331	stream_writeline(dbms_utility.format_error_backtrace);
	332	END;
	333	END LOOP;
	334	END;
	335
	336	END mal;
	337	/
	338	show errors;
	339
	340	quit;